File Coverage

blib/lib/Path/IsDev/Role/Matcher/Child/Exists/Any.pm
Criterion Covered Total %
statement 28 32 87.5
branch 2 4 50.0
condition n/a
subroutine 6 7 85.7
pod 2 2 100.0
total 38 45 84.4


line stmt bran cond sub pod time code
1 24     24   95059 use 5.008; # utf8
  24         87  
  24         1787  
2 24     24   692 use strict;
  24         204  
  24         808  
3 24     24   528 use warnings;
  24         47  
  24         619  
4 24     24   1411 use utf8;
  24         74  
  24         142  
5              
6             package Path::IsDev::Role::Matcher::Child::Exists::Any;
7              
8             our $VERSION = '1.001002';
9              
10             # ABSTRACT: Match if any of a list of children exists
11              
12             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
13              
14 24     24   3527 use Role::Tiny;
  24         4563  
  24         173  
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35             sub child_exists {
36 111     111 1 202 my ( $self, $result_object, $child ) = @_;
37              
38 111         3828 my $child_path = $result_object->path->child($child);
39              
40 111         7202 my $ctx = { 'child_name' => $child, child_path => "$child_path", tests => [] };
41 111         1073 my $tests = $ctx->{tests};
42              
43 111 100       377 if ( -e $child_path ) {
44 12         1090 push @{$tests}, { 'child_path_exists?' => 1 };
  12         62  
45 12         83 $result_object->add_reason( $self, 1, "$child exists", $ctx );
46 12         123 return 1;
47             }
48 99         4049 push @{$tests}, { 'child_path_exists?' => 0 };
  99         374  
49 99         545 $result_object->add_reason( $self, 0, "$child does not exist", $ctx );
50 99         931 return;
51             }
52              
53              
54              
55              
56              
57              
58              
59              
60              
61             sub child_exists_any {
62 0     0 1   my ( $self, $result_object, @children ) = @_;
63 0           for my $child (@children) {
64 0 0         return 1 if $self->child_exists( $result_object, $child );
65             }
66 0           return;
67             }
68              
69             1;
70              
71             __END__
72              
73             =pod
74              
75             =encoding UTF-8
76              
77             =head1 NAME
78              
79             Path::IsDev::Role::Matcher::Child::Exists::Any - Match if any of a list of children exists
80              
81             =head1 VERSION
82              
83             version 1.001002
84              
85             =head1 METHODS
86              
87             =head2 C<child_exists>
88              
89             $class->child_exists( $result_object, $path );
90              
91             Return match if C<$path> exists as a child of C<< $result_object->path >>
92              
93             =head2 C<child_exists_any>
94              
95             $class->child_exists_any( $result_object, @childnames );
96              
97             Return match if any of C<@childnames> exist under C<< $result_object->path >>.
98              
99             =begin MetaPOD::JSON v1.1.0
100              
101             {
102             "namespace":"Path::IsDev::Role::Matcher::Child::Exists::Any",
103             "interface":"role"
104             }
105              
106              
107             =end MetaPOD::JSON
108              
109             =head1 AUTHOR
110              
111             Kent Fredric <kentfredric@gmail.com>
112              
113             =head1 COPYRIGHT AND LICENSE
114              
115             This software is copyright (c) 2014 by Kent Fredric <kentfredric@gmail.com>.
116              
117             This is free software; you can redistribute it and/or modify it under
118             the same terms as the Perl 5 programming language system itself.
119              
120             =cut