File Coverage

blib/lib/Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp.pm
Criterion Covered Total %
statement 26 30 86.6
branch 2 4 50.0
condition n/a
subroutine 6 7 85.7
pod 1 1 100.0
total 35 42 83.3


line stmt bran cond sub pod time code
1 10     10   3892 use 5.008; # utf8
  10         21  
2 10     10   32 use strict;
  10         10  
  10         147  
3 10     10   29 use warnings;
  10         10  
  10         192  
4 10     10   485 use utf8;
  10         20  
  10         37  
5              
6             package Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp;
7              
8             our $VERSION = '1.001003';
9              
10             # ABSTRACT: Match when a path has a child file matching an expression
11              
12             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25 10     10   914 use Role::Tiny;
  10         3015  
  10         45  
26              
27              
28              
29              
30              
31              
32              
33              
34              
35             sub _this_child_matchregexp {
36 24     24   30 my ( $self, $result_object, $child, $regexp ) = @_;
37 24         50 my $ctx = {
38             'child' => "$child",
39             'child_basename' => $child->basename,
40             expression => $regexp,
41             tests => [],
42             };
43 24         522 my $tests = $ctx->{tests};
44              
45 24 100       41 if ( $child->basename =~ $regexp ) {
46 5         51 push @{$tests}, { 'child_basename_matches_expression?' => 1 };
  5         11  
47 5         13 $result_object->add_reason( $self, 1, $child->basename . " matches $regexp", $ctx );
48 5         31 return 1;
49             }
50 19         123 push @{$tests}, { 'child_basename_matches_expression?' => 0 };
  19         36  
51 19         32 $result_object->add_reason( $self, 0, $child->basename . " does not match $regexp", $ctx );
52 19         73 return;
53             }
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67             sub child_basename_matchregexp {
68 0     0 1   my ( $self, $result_object, $regexp ) = @_;
69 0           for my $child ( $result_object->path->children ) {
70 0 0         return 1 if $self->_this_child_matchregexp( $result_object, $child, $regexp );
71             }
72 0           return;
73             }
74              
75             1;
76              
77             __END__