File Coverage

blib/lib/Data/Rx/FailureSet.pm
Criterion Covered Total %
statement 20 64 31.2
branch 3 34 8.8
condition 0 19 0.0
subroutine 6 8 75.0
pod 0 5 0.0
total 29 130 22.3


line stmt bran cond sub pod time code
1 1     1   11 use v5.12.0;
  1         3  
2 1     1   6 use warnings;
  1         2  
  1         51  
3             package Data::Rx::FailureSet 0.200008;
4             # ABSTRACT: multiple structured failure reports from an Rx checker
5              
6             #pod =head1 SYNOPSIS
7             #pod
8             #pod This is what is thrown when a schema's C method finds a problem
9             #pod with the input. For more information on it, look at the documentation for
10             #pod L.
11             #pod
12             #pod =cut
13              
14 1     1   5 use overload '""' => \&stringify;
  1         2  
  1         6  
15              
16             sub new {
17 1632     1632 0 3024 my ($class, $arg) = @_;
18              
19 1632         2192 my $failures;
20              
21             my $guts = {
22             failures => [ map $_->isa('Data::Rx::FailureSet')
23 195         552 ? @{ $_->{failures} }
24             : $_,
25 1632 100       2618 @{ $arg->{failures} || [] },
  1632 50       10758  
26             ]
27             };
28              
29 1632         10143 bless $guts => $class;
30             }
31              
32 1334     1334 0 74701 sub failures { $_[0]->{failures} }
33              
34             sub contextualize {
35 251     251 0 445 my ($self, $struct) = @_;
36              
37 251         331 foreach my $failure (@{ $self->{failures} }) {
  251         531  
38 253         516 $failure->contextualize($struct);
39             }
40              
41 251         417 return $self;
42             }
43              
44             sub stringify {
45 0     0 0   my ($self) = @_;
46              
47 0 0         if (@{$self->{failures}}) {
  0            
48 0           return join "\n", map "$_", @{$self->{failures}};
  0            
49             } else {
50 0           return "No failures\n";
51             }
52             }
53              
54             sub build_struct {
55 0     0 0   my ($self) = @_;
56              
57 0 0         return unless @{$self->{failures}};
  0            
58              
59 0           my $data;
60              
61 0           foreach my $failure (@{$self->{failures}}) {
  0            
62              
63 0           my @path = $failure->data_path;
64 0           my @type = $failure->data_path_type;
65              
66 0 0         @path == @type or die "bad path info in build_struct()";
67              
68             # go to the appropriate location in the struct, vivifying as necessary
69              
70 0           my $p = \$data;
71              
72 0           for (my $i = 0; $i < @path; ++$i) {
73 0 0         if ($type[$i] eq 'k') {
    0          
74 0 0 0       if (ref $$p && ref $$p ne 'HASH') {
75 0           die "conflict in path info in build_struct()";
76             }
77             # if $$p already points to an error, replace it with the ref
78             # I believe this can only happen with type errors in //all -- rjk
79 0 0         $$p = {} unless ref $$p;
80 0           $p = \$$p->{$path[$i]};
81             } elsif ($type[$i] eq 'i') {
82 0 0 0       if (ref $$p && ref $$p ne 'ARRAY') {
83 0           die "conflict in path info in build_struct()";
84             }
85             # if $$p already points to an error, replace it with the ref
86             # I believe this can only happen with type errors in //all -- rjk
87 0 0         $$p = [] unless ref $$p;
88 0           $p = \$$p->[$path[$i]];
89             } else {
90 0           die "bad path type in build_struct()";
91             }
92             }
93              
94              
95             # insert the errors into the struct at the current location
96              
97 0           my $error = ($failure->error_types)[0];
98              
99 0 0 0       if ($error eq 'missing' || $error eq 'unexpected') {
    0          
100              
101 0 0 0       if (defined $$p && ref $$p ne 'HASH') {
102 0           die "conflict in path info in build_struct()";
103             }
104              
105 0           my @keys = $failure->keys;
106              
107 0   0       $$p ||= {};
108 0           @{$$p}{@keys} = ($error) x @keys;
  0            
109              
110             } elsif ($error eq 'size') {
111              
112 0 0 0       if (defined $$p && ref $$p ne 'ARRAY') {
113 0           die "conflict in path info in build_struct()";
114             }
115              
116 0           my $size = $failure->size;
117              
118 0   0       $$p ||= [];
119 0           $$p->[$size] = $error;
120              
121             } else {
122              
123 0 0         if (ref $$p) {
124             # if $$p already points to a ref, leave it and skip the error
125             # I believe this can only happen with type errors in //all -- rjk
126             } else {
127 0 0         $$p .= ',' if defined $$p;
128 0           $$p .= $error;
129             }
130              
131             }
132             }
133              
134 0           return $data;
135             }
136              
137             1;
138              
139             __END__