| 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 |  |  |  |  |  |  |  |