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