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             # ABSTRACT: Class responds for filtering data paths
3             $Data::DynamicValidator::Filter::VERSION = '0.05';
4 9     9   49494 use strict;
  9         17  
  9         204  
5 9     9   39 use warnings;
  9         13  
  9         187  
6              
7 9     9   2171 use Eval::Closure;
  9         11304  
  9         353  
8 9     9   2443 use Try::Tiny;
  9         12348  
  9         442  
9              
10 9   50 9   53 use constant DEBUG => $ENV{DATA_DYNAMICVALIDATOR_DEBUG} || 0;
  9         15  
  9         733  
11              
12             use overload
13             fallback => 1,
14             '&{}' => sub {
15 94     94   191 my $self = shift;
16 94     94   218 return sub { $self->filter(@_) }
17 9     9   51 };
  9         13  
  9         64  
  94         319  
18              
19             sub new {
20 25     25 0 8538 my ($class, $condition) = @_;
21 25         69 my $self = {
22             _condition => $condition
23             };
24 25         68 bless $self => $class;
25             }
26              
27             sub _prepare {
28 94     94   158 my ($self, $data, $context) = @_;
29 94         115 my %environment;
30 94         170 my $c = $self->{_condition};
31 94         145 my $type = ref($data);
32 94 100       302 if ($c =~ /\bsize\b/) {
33 20         30 my $value;
34 20 100       52 if ($type eq 'HASH') {
    100          
35 3     3   6 $value = sub { scalar keys %$data };
  3         8  
36             } elsif ($type eq 'ARRAY') {
37 9     9   27 $value = sub { scalar @$data };
  9         16  
38             }
39 20 100       41 if ($value) {
40 12         19 my $val = $value->();
41 12         40 $environment{'$size'} = \$val;
42             }
43             }
44 94 100       246 if ($c =~ /\bvalue\b/) {
45 30 100       78 $environment{'$value'} = \$data if(defined($data));
46             }
47 94 100 100     298 if ($c =~ /\bindex\b/ && ref($context) eq 'HASH'
      100        
48             && defined($context->{index}) ) {
49 9         22 $environment{'$index'} = \$context->{index};
50             }
51 94 100 100     370 if ($c =~ /\bkey\b/ && ref($context) eq 'HASH'
      100        
52             && defined($context->{key}) ) {
53 31         68 $environment{'$key'} = \$context->{key};
54             }
55             # substitute to environment values in condition
56 94         259 for (keys %environment) {
57 80         253 s/^\$//;
58 80         724 $c =~ s/\b($_)\b/\$$1/;
59             }
60 94         328 return ($c, \%environment);
61             }
62              
63             sub filter {
64 94     94 0 178 my ($self, $data, $context) = @_;
65              
66 94         177 my ($c, $environment) = $self->_prepare($data, $context);
67 94         200 my $source = "sub { $c }";
68 94         113 warn "-- evaluating condition as source: $source \n" if(DEBUG);
69              
70             # evaluation phase
71 94         118 my $result = 0;
72             try {
73 94     94   3512 my $code = eval_closure(
74             source => $source,
75             environment => $environment,
76             );
77 80         15166 $result = $code->();
78             } catch {
79 14     14   3104 warn "-- exection has been thrown, considering false: $_ \n" if(DEBUG);
80 94         485 };
81 94         1736 warn "-- result: $result: \n" if(DEBUG);
82 94         373 return $result;
83             }
84              
85              
86             1;
87              
88             __END__
89              
90             =pod
91              
92             =encoding UTF-8
93              
94             =head1 NAME
95              
96             Data::DynamicValidator::Filter - Class responds for filtering data paths
97              
98             =head1 VERSION
99              
100             version 0.05
101              
102             =head1 AUTHOR
103              
104             Ivan Baidakou <dmol@gmx.com>
105              
106             =head1 COPYRIGHT AND LICENSE
107              
108             This software is copyright (c) 2017 by Ivan Baidakou.
109              
110             This is free software; you can redistribute it and/or modify it under
111             the same terms as the Perl 5 programming language system itself.
112              
113             =cut