File Coverage

blib/lib/Form/Tiny/Plugin/Strict.pm
Criterion Covered Total %
statement 39 39 100.0
branch 20 20 100.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 69 69 100.0


line stmt bran cond sub pod time code
1             package Form::Tiny::Plugin::Strict;
2             $Form::Tiny::Plugin::Strict::VERSION = '2.19';
3 18     18   234 use v5.10;
  18         64  
4 18     18   107 use strict;
  18         35  
  18         393  
5 18     18   101 use warnings;
  18         38  
  18         510  
6              
7 18     18   113 use Form::Tiny::Error;
  18         48  
  18         495  
8              
9 18     18   132 use parent 'Form::Tiny::Plugin';
  18         42  
  18         133  
10              
11             sub plugin
12             {
13 29     29 1 100 my ($self, $caller, $context) = @_;
14              
15             return {
16 29         185 meta_roles => [__PACKAGE__],
17             };
18             }
19              
20 18     18   2050 use Moo::Role;
  18         42  
  18         156  
21              
22             requires qw(setup);
23              
24             # cache for the blueprint (if non-dynamic)
25             has '_strict_blueprint' => (
26             is => 'rw',
27             );
28              
29             sub _check_recursive
30             {
31 378     378   670 my ($self, $data, $blueprint) = @_;
32 378 100       760 return 0 unless defined $blueprint;
33              
34 360         604 my $ref = ref $blueprint;
35              
36 360 100       857 if ($ref eq 'ARRAY') {
    100          
37 51 100       124 return 0 unless ref $data eq 'ARRAY';
38              
39 45         105 foreach my $value (@$data) {
40 83 100       158 return 0
41             unless $self->_check_recursive($value, $blueprint->[0]);
42             }
43             }
44             elsif ($ref eq 'HASH') {
45 178 100       450 return 0 unless ref $data eq 'HASH';
46              
47 169         454 for my $key (keys %$data) {
48             return 0
49 184 100       525 unless $self->_check_recursive($data->{$key}, $blueprint->{$key});
50             }
51             }
52             else {
53             # we're at leaf and no error occured - we're good.
54             }
55              
56 291         662 return 1;
57             }
58              
59             sub _check_strict
60             {
61 111     111   258 my ($self, $obj, $input) = @_;
62              
63 111         334 my $blueprint = $self->_strict_blueprint;
64 111 100       257 if (!$blueprint) {
65 17         121 $blueprint = $self->blueprint($obj, recurse => 0);
66 17 100       141 $self->_strict_blueprint($blueprint)
67             unless $self->is_dynamic;
68             }
69              
70 111         384 my $strict = $self->_check_recursive($input, $blueprint);
71 111 100       290 if (!$strict) {
72 33         136 $obj->add_error($self->build_error(IsntStrict =>));
73             }
74              
75 111         296 return $input;
76             }
77              
78             after 'setup' => sub {
79             my ($self) = @_;
80              
81             $self->add_hook(
82             Form::Tiny::Hook->new(
83             hook => 'before_validate',
84             code => sub { $self->_check_strict(@_) },
85             inherited => 0,
86             )
87             );
88             };
89              
90             1;
91