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.20';
3 18     18   227 use v5.10;
  18         67  
4 18     18   114 use strict;
  18         51  
  18         415  
5 18     18   91 use warnings;
  18         47  
  18         492  
6              
7 18     18   106 use Form::Tiny::Error;
  18         51  
  18         563  
8              
9 18     18   125 use parent 'Form::Tiny::Plugin';
  18         44  
  18         107  
10              
11             sub plugin
12             {
13 29     29 1 104 my ($self, $caller, $context) = @_;
14              
15             return {
16 29         177 meta_roles => [__PACKAGE__],
17             };
18             }
19              
20 18     18   2097 use Moo::Role;
  18         80  
  18         138  
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 376     376   684 my ($self, $data, $blueprint) = @_;
32 376 100       766 return 0 unless defined $blueprint;
33              
34 358         614 my $ref = ref $blueprint;
35              
36 358 100       810 if ($ref eq 'ARRAY') {
    100          
37 51 100       115 return 0 unless ref $data eq 'ARRAY';
38              
39 45         74 foreach my $value (@$data) {
40 83 100       146 return 0
41             unless $self->_check_recursive($value, $blueprint->[0]);
42             }
43             }
44             elsif ($ref eq 'HASH') {
45 178 100       420 return 0 unless ref $data eq 'HASH';
46              
47 169         461 for my $key (keys %$data) {
48             return 0
49 182 100       487 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 289         648 return 1;
57             }
58              
59             sub _check_strict
60             {
61 111     111   246 my ($self, $obj, $input) = @_;
62              
63 111         335 my $blueprint = $self->_strict_blueprint;
64 111 100       255 if (!$blueprint) {
65 17         134 $blueprint = $self->blueprint($obj, recurse => 0);
66 17 100       164 $self->_strict_blueprint($blueprint)
67             unless $self->is_dynamic;
68             }
69              
70 111         352 my $strict = $self->_check_recursive($input, $blueprint);
71 111 100       299 if (!$strict) {
72 33         148 $obj->add_error($self->build_error(IsntStrict =>));
73             }
74              
75 111         289 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