| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Valiemon::Context; | 
| 2 | 25 |  |  | 25 |  | 99 | use strict; | 
|  | 25 |  |  |  |  | 24 |  | 
|  | 25 |  |  |  |  | 575 |  | 
| 3 | 25 |  |  | 25 |  | 67 | use warnings; | 
|  | 25 |  |  |  |  | 23 |  | 
|  | 25 |  |  |  |  | 431 |  | 
| 4 | 25 |  |  | 25 |  | 66 | use utf8; | 
|  | 25 |  |  |  |  | 21 |  | 
|  | 25 |  |  |  |  | 77 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 25 |  |  | 25 |  | 7292 | use Valiemon::ValidationError; | 
|  | 25 |  |  |  |  | 41 |  | 
|  | 25 |  |  |  |  | 658 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 25 |  |  | 25 |  | 103 | use constant ACCESSORS => [qw(root_validator root_schema errors positions)]; | 
|  | 25 |  |  |  |  | 24 |  | 
|  | 25 |  |  |  |  | 1641 |  | 
| 9 |  |  |  |  |  |  | use Class::Accessor::Lite ( | 
| 10 | 25 |  |  |  |  | 65 | ro => ACCESSORS(), | 
| 11 | 25 |  |  | 25 |  | 91 | ); | 
|  | 25 |  |  |  |  | 24 |  | 
| 12 | 25 |  |  | 25 |  | 10084 | use Clone qw(clone); | 
|  | 25 |  |  |  |  | 45514 |  | 
|  | 25 |  |  |  |  | 11045 |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | sub new { | 
| 15 | 691 |  |  | 691 | 0 | 1013 | my ($class, $validator, $schema) = @_; | 
| 16 | 691 |  |  |  |  | 3441 | return bless { | 
| 17 |  |  |  |  |  |  | root_validator => $validator, | 
| 18 |  |  |  |  |  |  | root_schema    => $schema, | 
| 19 |  |  |  |  |  |  | errors         => [], | 
| 20 |  |  |  |  |  |  | positions      => [], | 
| 21 |  |  |  |  |  |  | }, $class; | 
| 22 |  |  |  |  |  |  | } | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | sub clone_from { | 
| 25 | 44 |  |  | 44 | 0 | 45 | my ($class, $instance) = @_; | 
| 26 |  |  |  |  |  |  | return bless { | 
| 27 | 44 |  |  |  |  | 32 | map { $_ => clone($instance->$_) } @{ACCESSORS()} | 
|  | 176 |  |  |  |  | 1759 |  | 
|  | 44 |  |  |  |  | 60 |  | 
| 28 |  |  |  |  |  |  | }, $class; | 
| 29 |  |  |  |  |  |  | } | 
| 30 |  |  |  |  |  |  |  | 
| 31 | 405 |  |  | 405 | 0 | 719 | sub rv { $_[0]->root_validator } | 
| 32 | 0 |  |  | 0 | 0 | 0 | sub rs { $_[0]->root_schema } | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 896 |  |  | 896 | 0 | 1438 | sub prims { $_[0]->root_validator->prims } # TODO refactor | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  | sub push_error { | 
| 37 | 381 |  |  | 381 | 0 | 11195 | my ($self, $error) = @_; | 
| 38 | 381 |  |  |  |  | 314 | push @{$self->errors}, $error; | 
|  | 381 |  |  |  |  | 530 |  | 
| 39 |  |  |  |  |  |  | } | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | sub push_pos { | 
| 42 | 1372 |  |  | 1372 | 0 | 1074 | my ($self, $pos) = @_; | 
| 43 | 1372 |  |  |  |  | 967 | push @{$self->positions}, $pos; | 
|  | 1372 |  |  |  |  | 1999 |  | 
| 44 |  |  |  |  |  |  | } | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | sub pop_pos { | 
| 47 | 1327 |  |  | 1327 | 0 | 1005 | my ($self) = @_; | 
| 48 | 1327 |  |  |  |  | 840 | pop @{$self->positions}; | 
|  | 1327 |  |  |  |  | 1717 |  | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | sub is_root { | 
| 52 | 0 |  |  | 0 | 0 | 0 | my ($self) = @_; | 
| 53 | 0 | 0 |  |  |  | 0 | return scalar @{$self->positions} == 0 ? 1 : 0; | 
|  | 0 |  |  |  |  | 0 |  | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | sub position { | 
| 57 | 396 |  |  | 396 | 0 | 290 | my ($self) = @_; | 
| 58 | 396 |  |  |  |  | 277 | return '/' . join '/', @{$self->positions}; | 
|  | 396 |  |  |  |  | 556 |  | 
| 59 |  |  |  |  |  |  | } | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | sub generate_error { | 
| 62 | 378 |  |  | 378 | 0 | 365 | my ($self, $attr) = @_; | 
| 63 | 378 |  |  |  |  | 543 | return Valiemon::ValidationError->new($attr, $self->position); | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub in_attr ($&) { | 
| 67 | 1091 |  |  | 1091 | 0 | 1129 | my ($self, $attr, $code) = @_; | 
| 68 | 1091 |  |  |  |  | 2028 | $self->push_pos($attr->attr_name); | 
| 69 | 1091 |  |  |  |  | 5101 | my $is_valid = $code->(); | 
| 70 | 1054 | 100 |  |  |  | 26146 | my @res = $is_valid ? (1, undef) : (0, $self->generate_error($attr)); | 
| 71 | 1054 |  |  |  |  | 1356 | $self->pop_pos(); | 
| 72 | 1054 |  |  |  |  | 4755 | return @res; | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | sub in ($&) { | 
| 76 | 281 |  |  | 281 | 0 | 294 | my ($self, $pos, $code) = @_; | 
| 77 | 281 |  |  |  |  | 336 | $self->push_pos($pos); | 
| 78 | 281 |  |  |  |  | 1136 | my $res = $code->(); | 
| 79 | 273 |  |  |  |  | 510 | $self->pop_pos(); | 
| 80 | 273 |  |  |  |  | 985 | return $res; | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | sub sub_validator { | 
| 84 | 347 |  |  | 347 | 0 | 309 | my ($self, $sub_schema) = @_; | 
| 85 | 347 |  |  |  |  | 1234 | require Valiemon; | 
| 86 | 347 |  |  |  |  | 503 | return Valiemon->new( | 
| 87 |  |  |  |  |  |  | $sub_schema, | 
| 88 |  |  |  |  |  |  | $self->rv->options, # inherit options | 
| 89 |  |  |  |  |  |  | ); | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | 1; |