File Coverage

lib/Data/Validation/Filters.pm
Criterion Covered Total %
statement 50 50 100.0
branch 6 8 75.0
condition 2 3 66.6
subroutine 16 16 100.0
pod 11 11 100.0
total 85 88 96.5


line stmt bran cond sub pod time code
1             package Data::Validation::Filters;
2              
3 1     1   4 use namespace::autoclean;
  1         1  
  1         8  
4              
5 1     1   65 use Data::Validation::Constants qw( EXCEPTION_CLASS HASH TRUE );
  1         2  
  1         7  
6 1     1   279 use Data::Validation::Utils qw( load_class );
  1         2  
  1         6  
7 1     1   130 use Unexpected::Types qw( Str );
  1         2  
  1         7  
8 1     1   353 use Moo;
  1         2  
  1         6  
9              
10             has 'method' => is => 'ro', isa => Str, required => TRUE;
11              
12             has 'pattern' => is => 'ro', isa => Str;
13              
14             has 'replace' => is => 'ro', isa => Str;
15              
16             sub new_from_method {
17 15     15 1 20 my ($class, $attr) = @_;
18              
19 15 100       266 $class->can( $attr->{method} ) and return $class->new( $attr );
20              
21 1         5 return (load_class $class, 'filter', $attr->{method})->new( $attr );
22             }
23              
24             sub filter {
25             my ($self, $v) = @_; my $method = $self->method; return $self->$method( $v );
26             }
27              
28             around 'filter' => sub {
29             my ($orig, $self, $v) = @_; return defined $v ? $orig->( $self, $v ) : undef;
30             };
31              
32             # Builtin filter methods
33             sub filterEscapeHTML {
34 1     1 1 2 my ($self, $v) = @_;
35              
36 1         6 $v =~ s{ &(?!(amp|lt|gt|quot);) }{&}gmx;
37 1         3 $v =~ s{ < }{<}gmx;
38 1         3 $v =~ s{ > }{>}gmx;
39 1         2 $v =~ s{ \" }{"}gmx;
40 1         11 return $v;
41             }
42              
43             sub filterLowerCase {
44 1     1 1 2 my ($self, $v) = @_; return lc $v;
  1         5  
45             }
46              
47             sub filterNonNumeric {
48 2     2 1 3 my ($self, $v) = @_; $v =~ s{ \D+ }{}gmx; return $v;
  2         10  
  2         8  
49             }
50              
51             sub filterReplaceRegex {
52 1     1 1 1 my ($self, $v) = @_;
53              
54 1 50       7 my $pattern = $self->pattern or return $v;
55 1 50       5 my $replace = defined $self->replace ? $self->replace : q();
56              
57 1         13 $v =~ s{ $pattern }{$replace}gmx;
58 1         6 return $v;
59             }
60              
61             sub filterTitleCase {
62 1     1 1 2 my ($self, $v) = @_; my @words = split ' ', $v, -1;
  1         3  
63              
64 1         2 return join ' ', map { ucfirst $_ } @words;
  2         57  
65             }
66              
67             sub filterTrimBoth {
68 2     2 1 3 my ($self, $v) = @_;
69              
70 2         4 $v =~ s{ \A \s+ }{}mx; $v =~ s{ \s+ \z }{}mx;
  2         6  
71 2         8 return $v;
72             }
73              
74             sub filterUpperCase {
75 2     2 1 2 my ($self, $v) = @_; return uc $v;
  2         10  
76             }
77              
78             sub filterUCFirst {
79 1     1 1 2 my ($self, $v) = @_; return ucfirst $v;
  1         6  
80             }
81              
82             sub filterWhiteSpace {
83 1     1 1 62 my ($self, $v) = @_; $v =~ s{ \s+ }{}gmx; return $v;
  1         5  
  1         6  
84             }
85              
86             sub filterZeroLength {
87 2 100 66 2 1 17 return defined $_[ 1 ] && length $_[ 1 ] ? $_[ 1 ] : undef;
88             }
89              
90             1;
91              
92             __END__