File Coverage

blib/lib/Data/Annotation/Rule.pm
Criterion Covered Total %
statement 32 45 71.1
branch 5 12 41.6
condition 1 2 50.0
subroutine 9 10 90.0
pod 1 1 100.0
total 48 70 68.5


line stmt bran cond sub pod time code
1             package Data::Annotation::Rule;
2 2     2   21 use v5.24;
  2         5  
3 2     2   1061 use utf8;
  2         603  
  2         11  
4 2     2   52 use Moo;
  2         3  
  2         9  
5 2     2   638 use warnings;
  2         4  
  2         132  
6 2     2   12 use experimental qw< signatures >;
  2         8  
  2         13  
7             { our $VERSION = '0.006' }
8              
9 2     2   1345 use Data::Annotation::Expression qw< evaluator_factory >;
  2         22  
  2         169  
10 2     2   1079 use namespace::clean;
  2         33345  
  2         15  
11              
12             has name => (is => 'ro', predicate => 1);
13             has description => (is => 'ro', default => '');
14             has record => (is => 'ro', predicate => 1);
15             has retval => (is => 'ro', init_arg => 'return', predicate => 1);
16             has parse_context => (is => 'ro', default => undef,
17             init_arg => 'condition-parse-context');
18             has condition => (is => 'ro', default => 1);
19             has _condition => (is => 'lazy');
20              
21 4     4   39 sub _build__condition ($self) {
  4         6  
  4         9  
22 4         10 my $condition = $self->condition;
23 4 50 50     34 return evaluator_factory($condition, $self->parse_context // {})
24             if ref($condition) eq 'HASH';
25 0     0   0 return sub { $condition };
  0         0  
26             }
27              
28 5     5 1 8 sub evaluate ($self, $overlay) {
  5         9  
  5         9  
  5         8  
29 5 100       137 return unless $self->_condition->($overlay);
30 3 50       15 if ($self->has_record) {
31 0         0 my $record = $self->record;
32 0 0       0 if (exists($record->{delete})) {
33 0         0 for my $skey ($record->{delete}->@*) {
34 0         0 my $key = $skey =~ s{\A \.?}{}rmxs;
35 0         0 $overlay->delete($key);
36             }
37             }
38 0 0       0 if (exists($record->{set})) {
39 0         0 my $set = $record->{set};
40 0         0 for my $skey (keys($set->%*)) {
41 0         0 my $key = $skey =~ s{\A \.?}{}rmxs;
42 0         0 $overlay->set($key, $set->{$skey});
43             }
44             }
45             }
46 3 50       23 return $self->retval if $self->has_retval;
47 0           return;
48             }
49              
50             1;