File Coverage

blib/lib/App/BoolFindGrep/Find.pm
Criterion Covered Total %
statement 59 74 79.7
branch 14 28 50.0
condition 5 14 35.7
subroutine 13 15 86.6
pod 1 1 100.0
total 92 132 69.7


line stmt bran cond sub pod time code
1             package App::BoolFindGrep::Find;
2              
3 1     1   6 use common::sense;
  1         2  
  1         9  
4 1     1   77 use charnames q(:full);
  1         2  
  1         8  
5 1     1   189 use Carp;
  1         1  
  1         67  
6 1     1   4 use English qw[-no_match_vars];
  1         1  
  1         5  
7 1     1   371 use File::Find;
  1         2  
  1         67  
8 1     1   7 use IO::File;
  1         2  
  1         211  
9 1     1   7 use Moo;
  1         2  
  1         7  
10 1     1   1140 use Text::Glob qw[glob_to_regex_string];
  1         1038  
  1         2393  
11              
12             our $VERSION = '0.04'; # VERSION
13              
14             has files_from => (
15             is => q(rw),
16             isa => sub {
17             ( ( -e $_[0] && -r $_[0] && -f $_[0] && -s $_[0] )
18             || ( $_[0] eq q(-) || $_[0] =~ /\Astdin\z/i ) )
19             || die;
20             }
21             );
22             has files_delim => (
23             is => q(rw),
24             default => undef,
25             );
26             has file_expr => (
27             is => q(rw),
28             isa => sub { die if @_ > 1; die if ref $_[0]; },
29             default => undef,
30             );
31             has find_type => (
32             is => q(rw),
33             isa => sub {
34             ( grep { $_[0] eq $_ } qw[glob literal regexp] ) > 0 or die;
35             },
36             default => q(regexp),
37             );
38             has find_ignore_case => (
39             is => q(rw),
40             isa => sub { ( $_[0] == 0 || $_[0] == 1 ) or die; },
41             default => 0,
42             );
43             has directory => (
44             is => q(rw),
45             isa => sub {
46             @{ $_[0] } == ( grep { -d $_ && -r $_ } @{ $_[0] } ) or die;
47             },
48             default => sub { [q(.)] },
49             );
50             has patterns => ( is => q(rw), default => sub { {}; }, );
51             has found => ( is => q(rw), default => sub { {}; }, );
52             has files => ( is => q(rw), default => sub { []; }, );
53              
54             sub process {
55 11     11 1 13 my $self = shift;
56              
57 11 50 33     50 die if defined $self->files_delim() && !( defined $self->files_from() );
58 11 50 33     234 die if defined $self->files_from() && defined $self->file_expr();
59 0         0 die
60             if defined $self->files_from()
61 11 0 33     784 && @{ $self->directory() } != 1
      33        
62             && $self->directory->[0] ne q(.);
63              
64 11 50       242 if ( defined $self->files_from() ) {
65 0         0 $self->_get_made_list();
66             }
67 11         74 else { $self->_finder(); }
68              
69 11         70 return 1;
70             } ## end sub process
71              
72             sub _get_made_list {
73 0     0   0 my $self = shift;
74              
75 0         0 local $INPUT_RECORD_SEPARATOR = $self->files_delim();
76              
77 0 0       0 my $fh
78             = $self->files_from() =~ /\A(?:-|stdin)\z/i
79             ? \*STDIN
80             : IO::File->new( $self->files_from(), q(r) );
81              
82 0         0 while ( my $file = readline $fh ) {
83 0         0 chomp $file;
84 0 0       0 croak sprintf q('%s': irregular file.), $file if !-f $file;
85 0         0 push @{ $self->files() }, $file;
  0         0  
86             }
87              
88 0         0 return 1;
89             } ## end sub _get_made_list
90              
91             sub _finder {
92 11     11   21 my $self = shift;
93              
94 11 50       243 unless ( defined $self->file_expr() ) {
95 0 0   0   0 find sub { push @{ $self->files() }, $File::Find::name if -f },
  0         0  
96 0         0 @{ $self->directory() };
  0         0  
97             }
98              
99 11         104 $self->_process_patterns();
100              
101             find sub {
102 3971 100   3971   33745 if ( -f $_ ) {
103 3960 50       3086 if ( %{ $self->patterns() } ) {
  3960         8311  
104 3960         2986 foreach my $pattern ( keys %{ $self->patterns() } ) {
  3960         6373  
105 3960         4261 my $re = $self->patterns->{$pattern};
106 3960   50     17197 $self->found->{$File::Find::name}{$pattern} //= 0;
107 3960 100       32328 $self->found->{$File::Find::name}{$pattern}++ if m{$re};
108             }
109             }
110             }
111 11         67 }, @{ $self->directory() };
  11         242  
112              
113 11         98 return 1;
114             } ## end sub _finder
115              
116             sub _process_patterns {
117 11     11   17 my $self = shift;
118              
119 11         13 foreach my $pattern ( keys %{ $self->patterns() } ) {
  11         61  
120 11         16 my $value = $pattern;
121 11         210 foreach ( $self->find_type() ) {
122 11 100       101 if ( $_ eq q(literal) ) { $value = quotemeta $value; }
  3 100       14  
123             elsif ( $_ eq q(glob) ) {
124 5         32 $value = glob_to_regex_string($value);
125             }
126             }
127 11 50       722 $value = $self->find_ignore_case() == 1 ? qr{$value}i : qr{$value};
128 11         794 $self->patterns->{$pattern} = $value;
129             }
130              
131 11         24 return 1;
132             } ## end sub _process_patterns
133              
134 1     1   13 no Moo;
  1         3  
  1         8  
135             __PACKAGE__->meta->make_immutable;
136              
137             1;
138              
139             __END__