File Coverage

blib/lib/Data/Rx/FailureSet.pm
Criterion Covered Total %
statement 21 65 32.3
branch 3 34 8.8
condition 0 19 0.0
subroutine 6 8 75.0
pod 0 5 0.0
total 30 131 22.9


line stmt bran cond sub pod time code
1 1     1   6 use strict;
  1         3  
  1         32  
2 1     1   6 use warnings;
  1         2  
  1         52  
3             package Data::Rx::FailureSet;
4             # ABSTRACT: multiple structured failure reports from an Rx checker
5             $Data::Rx::FailureSet::VERSION = '0.200006';
6 1     1   4 use overload '""' => \&stringify;
  1         2  
  1         8  
7              
8             sub new {
9 1632     1632 0 2526 my ($class, $arg) = @_;
10              
11 1632         2683 my $failures;
12              
13 195         757 my $guts = {
14             failures => [ map $_->isa('Data::Rx::FailureSet')
15 1632 50       20861 ? @{ $_->{failures} }
16             : $_,
17 1632 100       2176 @{ $arg->{failures} || [] },
18             ]
19             };
20              
21 1632         14949 bless $guts => $class;
22             }
23              
24 1334     1334 0 76021 sub failures { $_[0]->{failures} }
25              
26             sub contextualize {
27 251     251 0 379 my ($self, $struct) = @_;
28              
29 251         327 foreach my $failure (@{ $self->{failures} }) {
  251         619  
30 253         709 $failure->contextualize($struct);
31             }
32              
33 251         576 return $self;
34             }
35              
36             sub stringify {
37 0     0 0   my ($self) = @_;
38              
39 0 0         if (@{$self->{failures}}) {
  0            
40 0           return join "\n", map "$_", @{$self->{failures}};
  0            
41             } else {
42 0           return "No failures\n";
43             }
44             }
45              
46             sub build_struct {
47 0     0 0   my ($self) = @_;
48              
49 0 0         return unless @{$self->{failures}};
  0            
50              
51 0           my $data;
52              
53 0           foreach my $failure (@{$self->{failures}}) {
  0            
54              
55 0           my @path = $failure->data_path;
56 0           my @type = $failure->data_path_type;
57              
58 0 0         @path == @type or die "bad path info in build_struct()";
59              
60             # go to the appropriate location in the struct, vivifying as necessary
61              
62 0           my $p = \$data;
63              
64 0           for (my $i = 0; $i < @path; ++$i) {
65 0 0         if ($type[$i] eq 'k') {
    0          
66 0 0 0       if (ref $$p && ref $$p ne 'HASH') {
67 0           die "conflict in path info in build_struct()";
68             }
69             # if $$p already points to an error, replace it with the ref
70             # I believe this can only happen with type errors in //all -- rjk
71 0 0         $$p = {} unless ref $$p;
72 0           $p = \$$p->{$path[$i]};
73             } elsif ($type[$i] eq 'i') {
74 0 0 0       if (ref $$p && ref $$p ne 'ARRAY') {
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             } else {
82 0           die "bad path type in build_struct()";
83             }
84             }
85              
86              
87             # insert the errors into the struct at the current location
88              
89 0           my $error = ($failure->error_types)[0];
90              
91 0 0 0       if ($error eq 'missing' || $error eq 'unexpected') {
    0          
92              
93 0 0 0       if (defined $$p && ref $$p ne 'HASH') {
94 0           die "conflict in path info in build_struct()";
95             }
96              
97 0           my @keys = $failure->keys;
98              
99 0   0       $$p ||= {};
100 0           @{$$p}{@keys} = ($error) x @keys;
  0            
101              
102             } elsif ($error eq 'size') {
103              
104 0 0 0       if (defined $$p && ref $$p ne 'ARRAY') {
105 0           die "conflict in path info in build_struct()";
106             }
107              
108 0           my $size = $failure->size;
109              
110 0   0       $$p ||= [];
111 0           $$p->[$size] = $error;
112              
113             } else {
114              
115 0 0         if (ref $$p) {
116             # if $$p already points to a ref, leave it and skip the error
117             # I believe this can only happen with type errors in //all -- rjk
118             } else {
119 0 0         $$p .= ',' if defined $$p;
120 0           $$p .= $error;
121             }
122              
123             }
124             }
125              
126 0           return $data;
127             }
128              
129             1;
130              
131             __END__