File Coverage

blib/lib/Data/DynamicValidator/Filter.pm
Criterion Covered Total %
statement 59 59 100.0
branch 16 16 100.0
condition 13 14 92.8
subroutine 15 15 100.0
pod 0 2 0.0
total 103 106 97.1


line stmt bran cond sub pod time code
1             package Data::DynamicValidator::Filter;
2             {
3             $Data::DynamicValidator::Filter::VERSION = '0.03';
4             }
5             # ABSTRACT: Class responds for filtering data paths
6              
7 8     8   35704 use strict;
  8         17  
  8         311  
8 8     8   42 use warnings;
  8         26  
  8         242  
9              
10 8     8   7561 use Eval::Closure;
  8         79710  
  8         479  
11 8     8   79 use Try::Tiny;
  8         18  
  8         442  
12              
13 8   50 8   48 use constant DEBUG => $ENV{DATA_DYNAMICVALIDATOR_DEBUG} || 0;
  8         15  
  8         843  
14              
15             use overload
16             fallback => 1,
17             '&{}' => sub {
18 88     88   229 my $self = shift;
19 88     88   247 return sub { $self->filter(@_) }
20 8     8   48 };
  8         17  
  8         91  
  88         356  
21              
22             sub new {
23 23     23 0 18584 my ($class, $condition) = @_;
24 23         80 my $self = {
25             _condition => $condition
26             };
27 23         109 bless $self => $class;
28             }
29              
30             sub _prepare {
31 88     88   131 my ($self, $data, $context) = @_;
32 88         144 my %environment;
33 88         193 my $c = $self->{_condition};
34 88         139 my $type = ref($data);
35 88 100       305 if ($c =~ /\bsize\b/) {
36 20         26 my $value;
37 20 100       74 if ($type eq 'HASH') {
    100          
38 3     3   9 $value = sub { scalar keys %$data };
  3         9  
39             } elsif ($type eq 'ARRAY') {
40 9     9   1849 $value = sub { scalar @$data };
  9         21  
41             }
42 20 100       64 if ($value) {
43 12         25 my $val = $value->();
44 12         55 $environment{'$size'} = \$val;
45             }
46             }
47 88 100       301 if ($c =~ /\bvalue\b/) {
48 30 100       102 $environment{'$value'} = \$data if(defined($data));
49             }
50 88 100 100     353 if ($c =~ /\bindex\b/ && ref($context) eq 'HASH'
      100        
51             && defined($context->{index}) ) {
52 9         26 $environment{'$index'} = \$context->{index};
53             }
54 88 100 100     1717 if ($c =~ /\bkey\b/ && ref($context) eq 'HASH'
      100        
55             && defined($context->{key}) ) {
56 25         66 $environment{'$key'} = \$context->{key};
57             }
58             # substitute to environment values in condition
59 88         284 for (keys %environment) {
60 74         2596 s/^\$//;
61 74         3550 $c =~ s/\b($_)\b/\$$1/;
62             }
63 88         355 return ($c, \%environment);
64             }
65              
66             sub filter {
67 88     88 0 155 my ($self, $data, $context) = @_;
68              
69 88         192 my ($c, $environment) = $self->_prepare($data, $context);
70 88         197 my $source = "sub { $c }";
71 88         95 warn "-- evaluating condition as source: $source \n" if(DEBUG);
72              
73             # evaluation phase
74 88         122 my $result = 0;
75             try {
76 88     88   3446 my $code = eval_closure(
77             source => $source,
78             environment => $environment,
79             );
80 74         21458 $result = $code->();
81             } catch {
82 14     14   5018 warn "-- exection has been thrown, considering false: $_ \n" if(DEBUG);
83 88         719 };
84 88         3062 warn "-- result: $result: \n" if(DEBUG);
85 88         471 return $result;
86             }
87              
88              
89             1;
90              
91             __END__
92              
93             =pod
94              
95             =encoding UTF-8
96              
97             =head1 NAME
98              
99             Data::DynamicValidator::Filter - Class responds for filtering data paths
100              
101             =head1 VERSION
102              
103             version 0.03
104              
105             =head1 AUTHOR
106              
107             Ivan Baidakou <dmol@gmx.com>
108              
109             =head1 COPYRIGHT AND LICENSE
110              
111             This software is copyright (c) 2014 by Ivan Baidakou.
112              
113             This is free software; you can redistribute it and/or modify it under
114             the same terms as the Perl 5 programming language system itself.
115              
116             =cut