File Coverage

blib/lib/File/Find/Closures.pm
Criterion Covered Total %
statement 94 117 80.3
branch 39 62 62.9
condition n/a
subroutine 44 55 80.0
pod 16 16 100.0
total 193 250 77.2


line stmt bran cond sub pod time code
1 12     12   20050 use 5.008;
  12         49  
2              
3             package File::Find::Closures;
4 12     12   122 use strict;
  12         55  
  12         421  
5              
6 12     12   62 use warnings;
  12         28  
  12         388  
7 12     12   70 no warnings;
  12         25  
  12         674  
8              
9 12     12   90 use Carp qw(carp croak);
  12         26  
  12         1052  
10 12     12   75 use Exporter qw(import);
  12         38  
  12         427  
11 12     12   88 use File::Basename qw(dirname);
  12         22  
  12         1207  
12 12     12   1003 use File::Spec::Functions qw(canonpath no_upwards);
  12         1531  
  12         794  
13 12     12   6962 use UNIVERSAL;
  12         151  
  12         83  
14              
15             our $VERSION = '1.113';
16              
17             our @EXPORT_OK = qw(
18             find_regular_files
19             find_by_min_size
20             find_by_max_size
21             find_by_zero_size
22             find_by_directory_contains
23             find_by_name
24             find_by_regex
25             find_by_owner
26             find_by_group
27             find_by_executable
28             find_by_writeable
29             find_by_umask
30             find_by_modified_before
31             find_by_modified_after
32             find_by_created_before
33             find_by_created_after
34             );
35              
36             our %EXPORT_TAGS = (
37             all => \@EXPORT_OK
38             );
39              
40 1     1   832 sub _unimplemented { croak "Unimplemented function!" }
41              
42             =encoding utf8
43              
44             =head1 NAME
45              
46             File::Find::Closures - functions you can use with File::Find
47              
48             =head1 SYNOPSIS
49              
50             use File::Find;
51             use File::Find::Closures qw(:all);
52              
53             my( $wanted, $list_reporter ) = find_by_name( qw(README) );
54              
55             File::Find::find( $wanted, @directories );
56             File::Find::find( { wanted => $wanted, ... }, @directories );
57              
58             my @readmes = $list_reporter->();
59              
60             =head1 DESCRIPTION
61              
62             I wrote this module as an example of both using closures and using
63             File::Find. Students are always asking me what closures are good
64             for, and here's some examples. The functions mostly stand alone (i.e.
65             they don't need the rest of the module), so rather than creating a
66             dependency in your code, just lift the parts you want).
67              
68             When I use File::Find, I have two headaches---coming up with the
69             \&wanted function to pass to find(), and acculumating the files.
70              
71             This module provides the \&wanted functions as a closures that I can
72             pass directly to find(). Actually, for each pre-made closure, I
73             provide a closure to access the list of files too, so I don't have to
74             create a new array to hold the results.
75              
76             The filenames are the full path to the file as reported by File::Find.
77              
78             Unless otherwise noted, the reporter closure returns a list of the
79             filenames in list context and an anonymous array that is a copy (not a
80             reference) of the original list. The filenames have been normalized
81             by File::Spec::canonfile unless otherwise noted. The list of files
82             has been processed by File::Spec::no_upwards so that "." and ".." (or
83             their equivalents) do not show up in the list.
84              
85              
86             =head2 The closure factories
87              
88             Each factory returns two closures. The first one is for find(),
89             and the second one is the reporter.
90              
91             =over 4
92              
93             =item find_regular_files();
94              
95             Find all regular files.
96              
97             =cut
98              
99             sub find_regular_files {
100 2     2 1 4505 my @files = ();
101              
102 20 100   20   2184 sub { push @files, canonpath( $File::Find::name ) if -f $_ },
103 4 100   4   21 sub { @files = no_upwards( @files ); wantarray ? @files : [ @files ] }
  4         37  
104 2         10 }
105              
106             =item find_by_min_size( SIZE );
107              
108             Find files whose size is equal to or greater than SIZE bytes.
109              
110             =cut
111              
112             sub find_by_min_size {
113 1     1 1 842 my $min = shift;
114              
115 1         2 my @files = ();
116              
117 89 100   89   4967 sub { push @files, canonpath( $File::Find::name ) if -s $_ >= $min },
118 2 100   2   16 sub { @files = no_upwards( @files ); wantarray ? @files : [ @files ] }
  2         63  
119 1         7 }
120              
121             =item find_by_max_size( SIZE );
122              
123             Find files whose size is equal to or less than SIZE bytes.
124              
125             =cut
126              
127             sub find_by_max_size {
128 1     1 1 715 my $min = shift;
129              
130 1         2 my @files = ();
131              
132 85 100   85   4072 sub { push @files, canonpath( $File::Find::name ) if -s $_ <= $min },
133 2 100   2   14 sub { @files = no_upwards( @files ); wantarray ? @files : [ @files ] }
  2         31  
134 1         7 }
135              
136             =item find_by_zero_size();
137              
138             Find files whose size is equal to 0 bytes.
139              
140             =cut
141              
142             sub find_by_zero_size {
143 1     1 1 1004 my $min = shift;
144              
145 1         2 my @files = ();
146              
147 109 100   109   4666 sub { push @files, canonpath( $File::Find::name ) if -s $_ == 0 },
148 2 100   2   14 sub { @files = no_upwards( @files ); wantarray ? @files : [ @files ] }
  2         34  
149 1         6 }
150              
151             =item find_by_directory_contains( @names );
152              
153             Find directories which contain files with the same name
154             as any of the values in @names.
155              
156             =cut
157              
158             sub find_by_directory_contains {
159 2     2 1 1997 my @contains = @_;
160 2         5 my %contains = map { $_, 1 } @contains;
  2         8  
161              
162 2         3 my %files = ();
163              
164             sub {
165 152 100   152   5589 return unless exists $contains{$_};
166 2         106 my $dir = dirname( canonpath( $File::Find::name ) );
167              
168 2         31 $files{ $dir }++;
169             },
170              
171              
172 4 100   4   28 sub { wantarray ? ( keys %files ) : [ keys %files ] }
173 2         13 }
174              
175             =item find_by_name( @names );
176              
177             Find files with the names in @names. The result is the name returned
178             by $File::Find::name normalized by File::Spec::canonfile().
179              
180             In list context, it returns the list of files. In scalar context,,
181             it returns an anonymous array.
182              
183             This function does not use no_updirs, so if you ask for "." or "..",
184             that's what you get.
185              
186             =cut
187              
188             sub find_by_name {
189 2     2 1 6877 my %hash = map { $_, 1 } @_;
  2         7  
190 2         4 my @files = ();
191              
192 186 100   186   6150 sub { push @files, canonpath( $File::Find::name ) if exists $hash{$_} },
193 4 100   4   26 sub { wantarray ? @files : [ @files ] }
194 2         12 }
195              
196             =item find_by_regex( REGEX );
197              
198             Find files whose name match REGEX.
199              
200             This function does not use no_updirs, so if you ask for "." or "..",
201             that's what you get.
202              
203             =cut
204              
205             sub find_by_regex {
206 2     2 1 5260 require File::Spec::Functions;
207 2         10 require Carp;
208 2         9 require UNIVERSAL;
209              
210 2         5 my $regex = shift;
211              
212 2 100       22 unless( UNIVERSAL::isa( $regex, ref qr// ) ) {
213 1         218 croak "Argument must be a regular expression";
214             }
215              
216 1         27 my @files = ();
217              
218 101 100   101   4393 sub { push @files,
219             File::Spec::Functions::canonpath( $File::Find::name ) if m/$regex/ },
220 2 100   2   21 sub { wantarray ? @files : [ @files ] }
221 1         12 }
222              
223             =item find_by_owner( OWNER_NAME | OWNER_UID );
224              
225             Find files that are owned by the owner with the name OWNER_NAME.
226             You can also use the owner's UID.
227              
228             =cut
229              
230             sub find_by_owner {
231 0     0 1 0 my $id = getpwnam($_[0]);
232 0 0       0 $id = $_ unless defined($id);
233              
234 0 0       0 unless( $id =~ /\d+/ ) {
235 0         0 carp "Uid must be numeric of a valid system user name";
236             }
237              
238 0         0 return _find_by_stat_part_equal( $id, 4 );
239             }
240              
241             =item find_by_group( GROUP_NAME | GROUP_GID );
242              
243             Find files that are owned by the owner with the name GROUP_NAME.
244             You can also use the group's GID.
245              
246             =cut
247              
248             sub find_by_group {
249 0     0 1 0 my $id = getgrnam( $_[0] );
250 0 0       0 $id = $_ unless defined( $id );
251              
252 0 0       0 unless( $id =~ /\d+/ ) {
253 0         0 carp "Gid must be numeric or a valid system user name";
254             }
255              
256 0         0 return _find_by_stat_part_equal( $id, 5 );
257             }
258              
259             =item find_by_executable();
260              
261             Find files that are executable. This may not work on some operating
262             systems (like Windows) unless someone can provide me with an
263             alternate version.
264              
265             =cut
266              
267             sub find_by_executable {
268 0     0 1 0 my @files = ();
269 0 0   0   0 sub { push @files, canonpath( $File::Find::name )
270             if -x },
271 0 0   0   0 sub { wantarray ? @files : [ @files ] }
272 0         0 }
273              
274             =item find_by_writeable();
275              
276             Find files that are writable. This may not work on some operating
277             systems (like Windows) unless someone can provide me with an
278             alternate version.
279              
280             =cut
281              
282             sub find_by_writeable {
283 0     0 1 0 my @files = ();
284 0 0   0   0 sub { push @files, canonpath( $File::Find::name )
285             if -w },
286 0 0   0   0 sub { wantarray ? @files : [ @files ] }
287 0         0 }
288              
289             =item find_by_umask( UMASK );
290              
291             Find files that fit the umask UMASK. The files will not have those
292             permissions.
293              
294             =cut
295              
296             sub find_by_umask {
297 0     0 1 0 my ($mask) = @_;
298              
299 0         0 my @files;
300              
301 0 0   0   0 sub { push @files, canonpath( $File::Find::name )
302             if ((stat($_))[2] & $mask) == 0},
303 0 0   0   0 sub { wantarray ? @files : [ @files ] }
304 0         0 }
305              
306             =item find_by_modified_before( EPOCH_TIME );
307              
308             Find files modified before EPOCH_TIME, which is in seconds since
309             the local epoch (I may need to adjust this for some operating
310             systems).
311              
312             =cut
313              
314             sub find_by_modified_before {
315 1     1 1 1043 return _find_by_stat_part_lessthan( $_[0], 9 );
316             }
317              
318             =item find_by_modified_after( EPOCH_TIME );
319              
320             Find files modified after EPOCH_TIME, which is in seconds since
321             the local epoch (I may need to adjust this for some operating
322             systems).
323              
324             =cut
325              
326             sub find_by_modified_after {
327 1     1 1 989 return _find_by_stat_part_greaterthan( $_[0], 9 );
328             }
329              
330             =item find_by_created_before( EPOCH_TIME );
331              
332             Find files created before EPOCH_TIME, which is in seconds since
333             the local epoch (I may need to adjust this for some operating
334             systems).
335              
336             =cut
337              
338             sub find_by_created_before {
339 1     1 1 1758 return _find_by_stat_part_lessthan( $_[0], 10 );
340             }
341              
342             =item find_by_created_after( EPOCH_TIME );
343              
344             Find files created after EPOCH_TIME, which is in seconds since
345             the local epoch (I may need to adjust this for some operating
346             systems).
347              
348             =cut
349              
350             sub find_by_created_after {
351 1     1 1 1276 return _find_by_stat_part_greaterthan( $_[0], 10 );
352             }
353              
354             sub _find_by_stat_part_equal {
355 1     1   2406 my ($value, $stat_part) = @_;
356              
357 1         3 my @files;
358              
359 105 100   105   6135 sub { push @files, canonpath( $File::Find::name )
360             if (stat($_))[$stat_part] == $value },
361 2 50   2   2601 sub { wantarray ? @files : [ @files ] }
362 1         12 }
363              
364             sub _find_by_stat_part_lessthan {
365 3     3   1443 my ($value, $stat_part) = @_;
366              
367 3         21 my @files;
368              
369 315 100   315   15815 sub { push @files, canonpath( $File::Find::name )
370             if (stat($_))[$stat_part] < $value },
371 6 50   6   5356 sub { wantarray ? @files : [ @files ] }
372 3         35 }
373              
374             sub _find_by_stat_part_greaterthan {
375 3     3   1204 my ($value, $stat_part) = @_;
376              
377 3         6 my @files;
378              
379 315 100   315   16391 sub { push @files, canonpath( $File::Find::name )
380             if (stat($_))[$stat_part] > $value },
381 6 50   6   5327 sub { wantarray ? @files : [ @files ] }
382 3         24 }
383              
384              
385             =back
386              
387             =head1 ADD A CLOSURE
388              
389             I want to add as many of these little functions as I can, so please
390             send me ones that you create!
391              
392             You can follow the examples in the source code, but here is how you
393             should write your closures.
394              
395             You need to provide both closures. Start of with the basic subroutine
396             stub to do this. Create a lexical array in the scope of the subroutine.
397             The two closures will share this variable. Create two closures: one
398             of give to C and one to access the lexical array.
399              
400             sub find_by_foo
401             {
402             my @args = @_;
403              
404             my @found = ();
405              
406             my $finder = sub { push @found, $File::Find::name if ... };
407             my $reporter = sub { @found };
408              
409             return( $finder, $reporter );
410             }
411              
412             The filename should be the full path to the file that you get
413             from C<$File::Find::name>, unless you are doing something wierd,
414             like C.
415              
416             Once you have something, send it to me at C<< >>. You
417             must release your code under the Perl Artistic License.
418              
419             =head1 TO DO
420              
421             * more functions!
422              
423             * need input on how things like mod times work on other operating
424             systems
425              
426             =head1 SEE ALSO
427              
428             L
429              
430             Randal Schwartz's C, which does the same task but
431             differently.
432              
433             =head1 SOURCE AVAILABILITY
434              
435             This module is in Github:
436              
437             https://github.com/briandfoy/file-find-closures.git
438              
439             =head1 AUTHOR
440              
441             brian d foy, C<< >>
442              
443             Some functions implemented by Nathan Wagner, C<< >>
444              
445             =head1 COPYRIGHT AND LICENSE
446              
447             Copyright © 2004-2021, brian d foy . All rights reserved.
448              
449             You may redistribute this under the same terms as the Artistic License
450             2.0.
451              
452             =cut
453              
454             "Kanga and Baby Roo Come to the Forest";