File Coverage

lib/Path/IsDev/Result.pm
Criterion Covered Total %
statement 41 45 91.1
branch 8 14 57.1
condition n/a
subroutine 9 10 90.0
pod 2 2 100.0
total 60 71 84.5


line stmt bran cond sub pod time code
1 12     12   1899 use 5.008;
  12         39  
  12         467  
2 12     12   289 use strict;
  12         21  
  12         380  
3 12     12   59 use warnings;
  12         19  
  12         315  
4 12     12   1061 use utf8;
  12         164  
  12         211  
5              
6             package Path::IsDev::Result;
7              
8             our $VERSION = '1.001002';
9              
10             # ABSTRACT: Result container
11              
12             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44 12     12   2004 use Class::Tiny 'path', 'result', { reasons => sub { [] }, };
  12         3163  
  12         138  
  16         500  
45              
46 2     2   1265 sub _path { require Path::Tiny; goto &Path::Tiny::path }
  2         22469  
47 0     0   0 sub _croak { require Carp; goto &Carp::croak }
  0         0  
48             ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
49 216     216   1002 sub _debug { require Path::IsDev; shift; goto &Path::IsDev::debug }
  216         281  
  216         827  
50              
51              
52              
53              
54              
55             sub BUILD {
56 16     16 1 1338 my ( $self, ) = @_;
57 16 50       557 if ( not $self->path ) {
58 0         0 return _croak(q[<path> is a mandatory parameter]);
59             }
60 16 100       687 if ( not ref $self->path ) {
61 2         56 $self->path( _path( $self->path ) );
62             }
63 16 50       657 if ( not -e $self->path ) {
64 0         0 return _croak(q[<path> parameter must exist for heuristics to be performed]);
65             }
66 16         1373 $self->path( $self->path->absolute );
67 16         1377 return $self;
68             }
69              
70              
71              
72              
73              
74              
75              
76              
77              
78              
79              
80              
81              
82              
83              
84              
85              
86              
87              
88              
89              
90              
91              
92              
93              
94              
95              
96              
97              
98              
99              
100              
101             sub add_reason {
102 216     216 1 1656 my ( $self, $heuristic_name, $heuristic_result, $summary, $context ) = @_;
103 216         333 my $name = $heuristic_name;
104 216 50       1654 if ( $name->can('name') ) {
105 216         743 $name = $name->name;
106             }
107 216         1155 $self->_debug("$name => $heuristic_result : $summary ");
108              
109             # $self->_debug( " > " . $_) for _pp($context);
110 216         305 my ($heuristic_type);
111              
112 216 50       1564 if ( $heuristic_name->can(q[heuristic_type]) ) {
113 216         684 $heuristic_type = $heuristic_name->heuristic_type;
114             }
115              
116 216 50       1910 my $reason = {
117             heuristic => $heuristic_name,
118             result => $heuristic_result,
119             ( defined $heuristic_type ? ( type => $heuristic_type ) : () ),
120 216 50       625 %{ $context || {} },
121             };
122 216         402 push @{ $self->reasons }, $reason;
  216         6713  
123 216         2375 return $self;
124             }
125              
126             1;
127              
128             __END__
129              
130             =pod
131              
132             =encoding UTF-8
133              
134             =head1 NAME
135              
136             Path::IsDev::Result - Result container
137              
138             =head1 VERSION
139              
140             version 1.001002
141              
142             =head1 SYNOPSIS
143              
144             use Path::IsDev::Result;
145              
146             my $result = Path::IsDev::Result->new( path => '/some/path/that/exists' ):
147              
148             if ( $heuristcset->matches( $result ) ) {
149             print Dumper($result);
150             }
151              
152             =head1 DESCRIPTION
153              
154             This is a reasonably new internal component for Path::IsDev.
155              
156             Its purpose is to communicate state between internal things, and give some sort of introspectable
157             context for why things happened in various places without resorting to spamming debug everywhere.
158              
159             Now instead of turning on debug, as long as you can get a result, you can inspect and dump that result
160             at the point you need it.
161              
162             =head1 METHODS
163              
164             =head2 C<BUILD>
165              
166             =head2 C<add_reason>
167              
168             Call this method from a heuristic to record checking of the heuristic
169             and the relevant meta-data.
170              
171             $result->add_reason( $heuristic, $matchvalue, $reason_summary, \%contextinfo );
172              
173             For example:
174              
175             sub Foo::matches {
176             my ( $self , $result_object ) = @_;
177             if ( $result_object->path->child('bar')->exists ) {
178             $result_object->add_reason( $self, 1, "child 'bar' exists" , {
179             child => 'bar',
180             'exists?' => 1,
181             child_path => $result_object->path->child('bar')
182             });
183             $result_object->result(1);
184             return 1;
185             }
186             return;
187             }
188              
189             Note that here, C<$matchvalue> should be the result of the relevant matching logic, not the global impact.
190              
191             For instance, C<excludes> compositions should still add reasons of C<< $matchvalue == 1 >>, but they should not
192             set C<< $result_object->result(1) >>. ( In fact, setting C<result> is the job of the individual heuristic, not the matches
193             that are folded into it )
194              
195             =head1 ATTRIBUTES
196              
197             =head2 C<path>
198              
199             =head2 C<result>
200              
201             =head2 C<reasons>
202              
203             =begin MetaPOD::JSON v1.1.0
204              
205             {
206             "namespace":"Path::IsDev::Result",
207             "interface":"class",
208             "inherits":"Class::Tiny::Object"
209             }
210              
211              
212             =end MetaPOD::JSON
213              
214             =head1 AUTHOR
215              
216             Kent Fredric <kentfredric@gmail.com>
217              
218             =head1 COPYRIGHT AND LICENSE
219              
220             This software is copyright (c) 2014 by Kent Fredric <kentfredric@gmail.com>.
221              
222             This is free software; you can redistribute it and/or modify it under
223             the same terms as the Perl 5 programming language system itself.
224              
225             =cut