File Coverage

blib/lib/Path/IsDev/Role/Matcher/Child/Exists/Any/Dir.pm
Criterion Covered Total %
statement 28 32 87.5
branch 3 4 75.0
condition 2 3 66.6
subroutine 7 7 100.0
pod 2 2 100.0
total 42 48 87.5


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