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.04';
4 9     9   48530 use strict;
  9         16  
  9         210  
5 9     9   40 use warnings;
  9         15  
  9         182  
6              
7 9     9   2140 use Eval::Closure;
  9         11204  
  9         324  
8 9     9   2294 use Try::Tiny;
  9         12315  
  9         437  
9              
10 9   50 9   52 use constant DEBUG => $ENV{DATA_DYNAMICVALIDATOR_DEBUG} || 0;
  9         15  
  9         717  
11              
12             use overload
13             fallback => 1,
14             '&{}' => sub {
15 94     94   193 my $self = shift;
16 94     94   250 return sub { $self->filter(@_) }
17 9     9   48 };
  9         18  
  9         56  
  94         303  
18              
19             sub new {
20 25     25 0 8520 my ($class, $condition) = @_;
21 25         55 my $self = {
22             _condition => $condition
23             };
24 25         63 bless $self => $class;
25             }
26              
27             sub _prepare {
28 94     94   168 my ($self, $data, $context) = @_;
29 94         124 my %environment;
30 94         156 my $c = $self->{_condition};
31 94         146 my $type = ref($data);
32 94 100       276 if ($c =~ /\bsize\b/) {
33 20         28 my $value;
34 20 100       51 if ($type eq 'HASH') {
    100          
35 3     3   7 $value = sub { scalar keys %$data };
  3         8  
36             } elsif ($type eq 'ARRAY') {
37 9     9   24 $value = sub { scalar @$data };
  9         16  
38             }
39 20 100       38 if ($value) {
40 12         17 my $val = $value->();
41 12         50 $environment{'$size'} = \$val;
42             }
43             }
44 94 100       267 if ($c =~ /\bvalue\b/) {
45 30 100       359 $environment{'$value'} = \$data if(defined($data));
46             }
47 94 100 100     269 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     355 if ($c =~ /\bkey\b/ && ref($context) eq 'HASH'
      100        
52             && defined($context->{key}) ) {
53 31         70 $environment{'$key'} = \$context->{key};
54             }
55             # substitute to environment values in condition
56 94         258 for (keys %environment) {
57 80         245 s/^\$//;
58 80         726 $c =~ s/\b($_)\b/\$$1/;
59             }
60 94         321 return ($c, \%environment);
61             }
62              
63             sub filter {
64 94     94 0 165 my ($self, $data, $context) = @_;
65              
66 94         182 my ($c, $environment) = $self->_prepare($data, $context);
67 94         201 my $source = "sub { $c }";
68 94         113 warn "-- evaluating condition as source: $source \n" if(DEBUG);
69              
70             # evaluation phase
71 94         127 my $result = 0;
72             try {
73 94     94   3420 my $code = eval_closure(
74             source => $source,
75             environment => $environment,
76             );
77 80         14743 $result = $code->();
78             } catch {
79 14     14   3087 warn "-- exection has been thrown, considering false: $_ \n" if(DEBUG);
80 94         440 };
81 94         1769 warn "-- result: $result: \n" if(DEBUG);
82 94         377 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.04
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