File-Finder-0.53/0000755000076500000240000000000010225557744014171 5ustar merlynstaff00000000000000File-Finder-0.53/Changes0000644000076500000240000000206410225557575015470 0ustar merlynstaff00000000000000Revision history for Perl extension File::Finder. 0.53 Fri Apr 8 12:45:22 PDT 2005 - added "use strict" to File::Finder::Steps - added bug reporting address 0.52 Sat Mar 26 10:21:50 PST 2005 - Fix all tests in t/05-steps.t! Totally blown - Add Test::Pod and Test::Pod::Coverage for better Kwalitee 0.51 Wed Oct 6 18:13:37 PDT 2004 - Add stat(_) validator, stat $_ if not valid - Fix tests related to decimal permission values - added File::Find::Steps::contains (suggested by brian d foy) 0.50 Wed Oct 6 10:04:10 PDT 2004 - Set $File::Find::dont_use_nlink rather than stat($_) in _run Recommended by PerlMonk tye - refactored File::Find::Steps separately, and documented it - added TODO 0.03 Fri Dec 19 16:20:52 PST 2003 - Add ->ffr(File::Find::Rule->...) "You will be assimilated! Resistance is Futile!" 0.02 Thu Dec 18 14:35:45 PST 2003 - Added ->comma method - fixed stat()'ing bug reported by perlmonk YuckFoo 0.01 Tue Dec 16 08:50:16 PST 2003 - original version; created by h2xs 1.23 with options -b5.6.0 -AXn File::Finder File-Finder-0.53/lib/0000755000076500000240000000000010225557744014737 5ustar merlynstaff00000000000000File-Finder-0.53/lib/File/0000755000076500000240000000000010225557744015616 5ustar merlynstaff00000000000000File-Finder-0.53/lib/File/Finder/0000755000076500000240000000000010225557744017025 5ustar merlynstaff00000000000000File-Finder-0.53/lib/File/Finder/Steps.pm0000644000076500000240000004253510225557445020470 0ustar merlynstaff00000000000000package File::Finder::Steps; our $VERSION = 0.53; use strict; use Carp qw(croak); =head1 NAME File::Finder::Steps - steps for File::Finder =head1 SYNOPSIS ## See File::Finder for normal use of steps ## subclassing example: BEGIN { package My::File::Finder; use base File::Finder; sub _steps_class { "My::File::Finder::Steps" } } BEGIN { package My::File::Finder::Steps; use base File::Finder::Steps; sub bigger_than { # true if bigger than N bytes my $self = shift; my $bytes = shift; return sub { -s > $bytes; } } } my $over_1k = My::File::Finder->bigger_than(1024); print "Temp files over 1k:\n"; $over_1k->ls->in("/tmp"); =head1 DESCRIPTION C provide the predicates being tested for C. =head2 STEPS METHODS These methods are called on a class or instance to add a "step". Each step adds itself to a list of steps, returning the new object. This allows you to chain steps together to form a formula. As in I, the default operator is "and", and short-circuiting is performed. =over =item or Like I's C. =cut sub or { return "or" } =item left Like a left parenthesis. Used in nesting pairs with C. =cut sub left { return "left" } BEGIN { *begin = \&left; } =item right Like a right parenthesis. Used in nesting pairs with C. For example: my $big_or_old = File::Finder ->type('f') ->left ->size("+100")->or->mtime("+90") ->right; find($big_or_old->ls, "/tmp"); You need parens because the "or" operator is lower precedence than the implied "and", for the same reason you need them here: find /tmp -type f '(' -size +100 -o -mtime +90 ')' -print Without the parens, the -type would bind to -size, and not to the choice of -size or -mtime. Mismatched parens will not be found until the formula is used, causing a fatal error. =cut sub right { return "right" } BEGIN { *end = \&right; } =item begin Alias for C. =item end Alias for C. =item not Like I's C. Prefix operator, can be placed in front of individual terms or open parens. Can be nested, but what's the point? # list all non-files in /tmp File::Finder->not->type('f')->ls->in("/tmp"); =cut sub not { return "not" } =item true Always returns true. Useful when a subexpression might fail, but you don't want the overall code to fail: ... ->left-> ...[might return false]... ->or->true->right-> ... Of course, this is the I command's idiom of: find .... '(' .... -o -true ')' ... =cut sub true { return sub { 1 } } =item false Always returns false. =cut sub false { return sub { 0 } } =item comma Like GNU I's ",". The result of the expression (or subexpression if in parens) up to this point is discarded, and execution continues afresh. Useful when a part of the expression is needed for its side effects, but shouldn't affect the rest of the "and"-ed chain. # list all files and dirs, but don't descend into CVS dir contents: File::Finder->type('d')->name('CVS')->prune->comma->ls->in('.'); =cut sub comma { return "comma" } # gnu extension =item follow Enables symlink following, and returns true. =cut sub follow { my $self = shift; $self->{options}{follow} = 1; return sub { 1 }; } =item name(NAME) True if basename matches NAME, which can be given as a glob pattern or a regular expression object: my $pm_files = File::Finder->name('*.pm')->in('.'); my $pm_files_too = File::Finder->name(qr/pm$/)->in('.'); =cut sub name { my $self = shift; my $name = shift; unless (UNIVERSAL::isa($name, "Regexp")) { require Text::Glob; $name = Text::Glob::glob_to_regex($name); } return sub { /$name/; }; } =item perm(PERMISSION) Like I's C<-perm>. Leading "-" means "all of these bits". Leading "+" means "any of these bits". Value is de-octalized if a leading 0 is present, which is likely only if it's being passed as a string. my $files = File::Finder->type('f'); # find files that are exactly mode 644 my $files_644 = $files->perm(0644); # find files that are at least world executable: my $files_world_exec = $files->perm("-1"); # find files that have some executable bit set: my $files_exec = $files->perm("+0111"); =cut sub perm { my $self = shift; my $perm = shift; $perm =~ /^(\+|-)?\d+\z/ or croak "bad permissions $perm"; if ($perm =~ s/^-//) { $perm = oct($perm) if $perm =~ /^0/; return sub { ((stat _)[2] & $perm) == $perm; }; } elsif ($perm =~ s/^\+//) { # gnu extension $perm = oct($perm) if $perm =~ /^0/; return sub { ((stat _)[2] & $perm); }; } else { $perm = oct($perm) if $perm =~ /^0/; return sub { ((stat _)[2] & 0777) == $perm; }; } } =item type(TYPE) Like I's C<-type>. All native Perl types are supported. Note that C is a socket, mapping to Perl's C<-S>, to be consistent with I. Returns true or false, as appropriate. =cut BEGIN { my %typecast; sub type { my $self = shift; my $type = shift; $type =~ /^[a-z]\z/i or croak "bad type $type"; $type =~ s/s/S/; $typecast{$type} ||= eval "sub { -$type _ }"; } } =item print Prints the fullname to C, followed by a newline. Returns true. =cut sub print { return sub { print $File::Find::name, "\n"; 1; }; } =item print0 Prints the fullname to C, followed by a NUL. Returns true. =cut sub print0 { return sub { print $File::Find::name, "\0"; 1; }; } =item fstype Not implemented yet. =item user(USERNAME|UID) True if the owner is USERNAME or UID. =cut sub user { my $self = shift; my $user = shift; my $uid = ($user =~ /^\d+\z/) ? $user : _user_to_uid($user); die "bad user $user" unless defined $uid; return sub { (stat _)[4] == $uid; }; } =item group(GROUPNAME|GID) True if the group is GROUPNAME or GID. =cut sub group { my $self = shift; my $group = shift; my $gid = ($group =~ /^\d+\z/) ? $group : _group_to_gid($group); die "bad group $gid" unless defined $gid; return sub { (stat _)[5] == $gid; }; } =item nouser True if the entry doesn't belong to any known user. =cut sub nouser { return sub { CORE::not defined _uid_to_user((stat _)[4]); } } =item nogroup True if the entry doesn't belong to any known group. =cut sub nogroup { return sub { CORE::not defined _gid_to_group((stat _)[5]); } } =item links( +/- N ) Like I's C<-links N>. Leading plus means "more than", minus means "less than". =cut sub links { my $self = shift; my ($prefix, $n) = shift =~ /^(\+|-|)(.*)/; return sub { _n($prefix, $n, (stat(_))[3]); }; } =item inum( +/- N ) True if the inode number meets the qualification. =cut sub inum { my $self = shift; my ($prefix, $n) = shift =~ /^(\+|-|)(.*)/; return sub { _n($prefix, $n, (stat(_))[1]); }; } =item size( +/- N [c/k]) True if the file size meets the qualification. By default, N is in half-K blocks. Append a trailing "k" to the number to indicate 1K blocks, or "c" to indicate characters (bytes). =cut sub size { my $self = shift; my ($prefix, $n) = shift =~ /^(\+|-|)(.*)/; if ($n =~ s/c\z//) { return sub { _n($prefix, $n, int(-s _)); }; } if ($n =~ s/k\z//) { return sub { _n($prefix, $n, int(((-s _)+1023) / 1024)); }; } return sub { _n($prefix, $n, int(((-s _)+511) / 512)); }; } =item atime( +/- N ) True if access time (in days) meets the qualification. =cut sub atime { my $self = shift; my ($prefix, $n) = shift =~ /^(\+|-|)(.*)/; return sub { _n($prefix, $n, int(-A _)); }; } =item mtime( +/- N ) True if modification time (in days) meets the qualification. =cut sub mtime { my $self = shift; my ($prefix, $n) = shift =~ /^(\+|-|)(.*)/; return sub { _n($prefix, $n, int(-M _)); }; } =item ctime( +/- N ) True if inode change time (in days) meets the qualification. =cut sub ctime { my $self = shift; my ($prefix, $n) = shift =~ /^(\+|-|)(.*)/; return sub { _n($prefix, $n, int(-C _)); }; } =item exec(@COMMAND) Forks the child process via C. Any appearance of C<{}> in any argument is replaced by the current filename. Returns true if the child exit status is 0. The list is passed directly to C, so if it's a single arg, it can contain C syntax. Otherwise, it's a pre-parsed command that must be found on the PATH. Note that I couldn't figure out how to horse around with the current directory very well, so I'm using C<$_> here instead of the more traditional C. It still works, because we're still chdir'ed down into the directory, but it looks weird on a trace. Trigger C in C if you want a traditional I full path. my $f = File::Finder->exec('ls', '-ldg', '{}'); find({ no_chdir => 1, wanted => $f }, @starting_dirs); Yeah, it'd be trivial for me to add a no_chdir method. Soon. =cut sub exec { my $self = shift; my @command = @_; return sub { my @mapped = @command; for my $one (@mapped) { $one =~ s/{}/$_/g; } system @mapped; return !$?; }; } =item ok(@COMMAND) Like C, but displays the command line first, and waits for a response. If the response begins with C or C, runs the command. If the command fails, or the response wasn't yes, returns false, otherwise true. =cut sub ok { my $self = shift; my @command = @_; return sub { my @mapped = @command; for my $one (@mapped) { $one =~ s/{}/$_/g; } my $old = select(STDOUT); $|++; print "@mapped? "; select $old; return 0 unless =~ /^y/i; system @mapped; return !$?; }; } =item prune Sets C<$File::Find::prune>, and returns true. =cut sub prune { return sub { $File::Find::prune = 1 }; } =item xdev Not yet implemented. =item newer Not yet implemented. =item eval(CODEREF) Ah yes, the master escape, with extra benefits. Give it a coderef, and it evaluates that code at the proper time. The return value is noted for true/false and used accordingly. my $blaster = File::Finder->atime("+30")->eval(sub { unlink }); But wait, there's more. If the parameter is an object that responds to C, that method is automatically called, hoping for a coderef return. This neat feature allows subroutines to be created and nested: my $old = File::Finder->atime("+30"); my $big = File::Finder->size("+100"); my $old_or_big = File::Finder->eval($old)->or->eval($big); my $killer = File::Finder->eval(sub { unlink }); my $kill_old_or_big = File::Finder->eval($old_or_big)->ls->eval($killer); $kill_old_or_big->in('/tmp'); Almost too cool for words. =cut sub eval { my $self = shift; my $eval = shift; ## if this is another File::Finder object... then cheat: $eval = $eval->as_wanted if UNIVERSAL::can($eval, "as_wanted"); return $eval; # just reuse the coderef } =item depth Like I's C<-depth>. Sets a flag for C, and returns true. =cut sub depth { my $self = shift; $self->{options}{bydepth} = 1; return sub { 1 }; } =item ls Like I's C<-ls>. Performs a C on the entry to C (without forking), and returns true. =cut sub ls { return \&_ls; } =item tar Not yet implemented. =item [n]cpio Not yet implemented. =item ffr($ffr_object) Incorporate a C object as a step. Note that this must be a rule object, and not a result, so don't call or pass C. For example, using C to define a predicate for image files that are bigger than a megapixel in my friends folder, I get: require File::Finder; require File::Find::Rule; require File::Find::Rule::ImageSize; my $ffr = File::Find::Rule->file->image_x('>1000')->image_y('>1000'); my @big_friends = File::Finder->ffr($ffr) ->in("/Users/merlyn/Pictures/Sorted/Friends"); =cut sub ffr { my $self = shift; my $ffr_object = shift; my $their_wanted; no warnings; local *File::Find::find = sub { my ($options) = @_; for (my ($k, $v) = each %$options) { if ($k eq "wanted") { $their_wanted = $v; } else { $self->{options}->{$k} = $v; } } }; $ffr_object->in("/DUMMY"); # boom! croak "no wanted defined" unless defined $their_wanted; return $their_wanted; } =item contains(pattern) True if the file contains C (either a literal string treated as a regex, or a true regex object). my $plugh_files = File::Finder->type('f')->contains(qr/plugh/); Searching is performed on a line-by-line basis, respecting the current value of C<$/>. =cut sub contains { my $self = shift; my $pat = shift; return sub { open my $f, "<$_" or return 0; while (<$f>) { return 1 if /$pat/; } return 0; }; } =back =head2 EXTENDING A step consists of a compile-time and a run-time component. During the creation of a C object, step methods are called as if they were methods against the slowly-growing C instance, including any additional parameters as in a normal method call. The step is expected to return a coderef (possibly a closure) to be executed at run-time. When a C object is being evaluated as the C C routine, the collected coderefs are evaluated in sequence, again as method calls against the C object. No additional parameters are passed. However, the normal C values are available, such as C<$_>, C<$File::Find::name>, and so on. The C<_> pseudo-handle has been set properly, so you can safely use C<-X> filetests and C against the pseudo-handle. The routine is expected to return a true/false value, which becomes the value of the step. Although a C object is passed both to the compile-time invocation and the resulting run-time invocation, only the C self-hash element is properly duplicated through the cloning process. Do not be tempted to add additional self-hash elements without overriding C's C<_clone>. Instead, pass values from the compile-time phase to the run-time phase using closure variables, as shown in the synopsis. For simplicity, you can also just mix-in your methods to the existing C class, rather than subclassing both classes as shown above. However, this may result in conflicting implementations of a given step name, so beware. =head1 SEE ALSO L =head1 BUGS None known yet. =head1 AUTHOR Randal L. Schwartz, Emerlyn@stonehenge.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2003,2004 by Randal L. Schwartz, Stonehenge Consulting Services, Inc. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.2 or, at your option, any later version of Perl 5 you may have available. =cut ## utility subroutines sub _n { my ($prefix, $arg, $value) = @_; if ($prefix eq "+") { $value > $arg; } elsif ($prefix eq "-") { $value < $arg; } else { $value == $arg; } } BEGIN { my %user_to_uid; my %uid_to_user; my $initialize = sub { while (my ($user, $pw, $uid) = getpwent) { $user_to_uid{$user} = $uid; $uid_to_user{$uid} = $user; } }; sub _user_to_uid { my $user = shift; %user_to_uid or $initialize->(); $user_to_uid{$user}; } sub _uid_to_user { my $uid = shift; %uid_to_user or $initialize->(); $uid_to_user{$uid}; } } BEGIN { my %group_to_gid; my %gid_to_group; my $initialize = sub { while (my ($group, $pw, $gid) = getgrent) { $group_to_gid{$group} = $gid; $gid_to_group{$gid} = $group; } }; sub _group_to_gid { my $group = shift; %group_to_gid or $initialize->(); $group_to_gid{$group}; } sub _gid_to_group { my $gid = shift; %gid_to_group or $initialize->(); $gid_to_group{$gid}; } } BEGIN { ## from find2perl my @rwx = qw(--- --x -w- -wx r-- r-x rw- rwx); my @moname = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); sub _sizemm { my $rdev = shift; sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff); } sub _ls { my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat(_); my $pname = $File::Find::name; $blocks or $blocks = int(($size + 1023) / 1024); my $perms = $rwx[$mode & 7]; $mode >>= 3; $perms = $rwx[$mode & 7] . $perms; $mode >>= 3; $perms = $rwx[$mode & 7] . $perms; substr($perms, 2, 1) =~ tr/-x/Ss/ if -u _; substr($perms, 5, 1) =~ tr/-x/Ss/ if -g _; substr($perms, 8, 1) =~ tr/-x/Tt/ if -k _; if (-f _) { $perms = '-' . $perms; } elsif (-d _) { $perms = 'd' . $perms; } elsif (-l _) { $perms = 'l' . $perms; $pname .= ' -> ' . readlink($_); } elsif (-c _) { $perms = 'c' . $perms; $size = _sizemm($rdev); } elsif (-b _) { $perms = 'b' . $perms; $size = _sizemm($rdev); } elsif (-p _) { $perms = 'p' . $perms; } elsif (-S _) { $perms = 's' . $perms; } else { $perms = '?' . $perms; } my $user = _uid_to_user($uid) || $uid; my $group = _gid_to_group($gid) || $gid; my ($sec,$min,$hour,$mday,$mon,$timeyear) = localtime($mtime); if (-M _ > 365.25 / 2) { $timeyear += 1900; } else { $timeyear = sprintf("%02d:%02d", $hour, $min); } printf "%5lu %4ld %-10s %3d %-8s %-8s %8s %s %2d %5s %s\n", $ino, $blocks, $perms, $nlink, $user, $group, $size, $moname[$mon], $mday, $timeyear, $pname; 1; } } 1; __END__ File-Finder-0.53/lib/File/Finder.pm0000644000076500000240000002515310225557640017364 0ustar merlynstaff00000000000000package File::Finder; use 5.006; use strict; use warnings; use base qw(Exporter); ## no exports our $VERSION = '0.53'; use Carp qw(croak); ## public methods: sub new { my $class = shift; bless { options => {}, steps => [], }, $class; } sub as_wanted { my $self = shift; return sub { $self->_run }; } use overload '&{}' => 'as_wanted', # '""' => sub { overload::StrVal(shift) }, ; sub as_options { my $self = shift; return { %{$self->{options}}, wanted => sub { $self->_run } }; } sub in { my $self = _force_object(shift); ## this must return count in a scalar context $self->collect(sub { $File::Find::name }, @_); } sub collect { my $self = _force_object(shift); my $code = shift; my @result; my $self_store = $self->eval( sub { push @result, $code->() } ); require File::Find; File::Find::find($self_store->as_options, @_); ## this must return count in a scalar context return @result; } ## private methods sub _force_object { my $self_or_class = shift; ref $self_or_class ? $self_or_class : $self_or_class->new; } sub _clone { my $self = _force_object(shift); bless { options => {%{$self->{options}}}, steps => [@{$self->{steps}}], }, ref $self; } ## we set this to ensure that _ is correct for all tests $File::Find::dont_use_nlink = 1; ## otherwise, we have to lstat/stat($_) inside _run ## thanks, tye! sub _run { my $self = shift; my @stat; @stat = stat if defined $_; my @state = (1); ## $state[-1]: ## if 2: we're in a true state, but we've just seen a NOT ## if 1: we're in a true state ## if 0: we're in a false state ## if -1: we're in a "skipping" state (true OR ...[here]...) for my $step(@{$self->{steps}}) { ## verify underscore handle is good: if (@stat) { my @cache_stat = stat _; stat unless "@stat" eq "@cache_stat"; } if (ref $step) { # coderef if ($state[-1] >= 1) { # true state if ($self->$step) { # coderef ran returning true if ($state[-1] == 2) { $state[-1] = 0; } } else { $state[-1]--; # 2 => 1, 1 => 0 } } } elsif ($step eq "or") { # -1 => -1, 0 => 1, 1 => -1, 2 is error croak "not before or?" if $state[-1] > 1; if ($state[-1] == 0) { $state[-1] = 1; } elsif ($state[-1] == 1) { $state[-1] = -1; } } elsif ($step eq "left") { ## start subrule ## -1 => -1, 0 => -1, 1 => 1, 2 => 1 push @state, ($state[-1] >= 1) ? 1 : -1; } elsif ($step eq "right") { ## end subrule croak "right without left" unless @state > 1; croak "not before right" if $state[-1] > 1; my $result = pop @state; if ($state[-1] >= 1) { if ($result) { # 1 or -1, so counts as true if ($state[-1] == 2) { $state[-1] = 0; } } else { $state[-1]--; # 2 => 1, 1 => 0 } } } elsif ($step eq "comma") { croak "not before comma" if $state[-1] > 1; if (@state < 2) { # not in parens $state[-1] = 1; # reset to true } else { # in parens, reset as if start of parens $state[-1] = (($state[-2] >= 1) ? 1 : -1); } } elsif ($step eq "not") { # -1 => -1, 0 => 0, 1 => 2, 2 => 1 if ($state[-1] >= 1) { $state[-1] = $state[-1] > 1 ? 1 : 2; } } else { die "internal error at $step"; } } croak "left without right" unless @state == 1; croak "trailing not" if $state[-1] > 1; return $state[-1] != 0; # true and skipping are both true } sub AUTOLOAD { my $self = _force_object(shift); my ($method) = our $AUTOLOAD =~ /(?:.*::)?(.*)/; return if $method eq "DESTROY"; my $clone = $self->_clone; ## bring in the steps my $steps_class = $clone->_steps_class; $steps_class =~ /[^\w:]/ and die "bad value for \$steps_class: $steps_class"; eval "require $steps_class"; die $@ if $@; my $sub_method = $steps_class->can($method) or croak "Cannot add step $method"; push @{$clone->{steps}}, $sub_method->($clone, @_); $clone; } sub _steps_class { "File::Finder::Steps" } 1; __END__ =head1 NAME File::Finder - nice wrapper for File::Find ala find(1) =head1 SYNOPSIS use File::Finder; ## simulate "-type f" my $all_files = File::Finder->type('f'); ## any rule can be extended: my $all_files_printer = $all_files->print; ## traditional use: generating "wanted" subroutines: use File::Find; find($all_files_printer, @starting_points); ## or, we can gather up the results immediately: my @results = $all_files->in(@starting_points); ## -depth and -follow are noted, but need a bit of help for find: my $deep_dirs = File::Finder->depth->type('d')->ls->exec('rmdir','{}'); find($deep_dirs->as_options, @places); =head1 DESCRIPTION C is great, but constructing the C routine can sometimes be a pain. This module provides a C-writer, using syntax that is directly mappable to the I command's syntax. Also, I find myself (heh) frequently just wanting the list of names that match. With C, I have to write a little accumulator, and then access that from a closure. But with C, I can turn the problem inside out. A C object contains a hash of C options, and a series of steps that mimic I's predicates. Initially, a C object has no steps. Each step method clones the previous object's options and steps, and then adds the new step, returning the new object. In this manner, an object can be grown, step by step, by chaining method calls. Furthermore, a partial sequence can be created and held, and used as the head of many different sequences. For example, a step sequence that finds only files looks like: my $files = File::Finder->type('f'); Here, C is acting as a class method and thus a constructor. An instance of C is returned, containing the one step to verify that only files are selected. We could use this immediately as a C wanted routine, although it'd be uninteresting: use File::Find; find($files, "/tmp"); Calling a step method on an existing object adds the step, returning the new object: my $files_print = $files->print; And now if we use this with C, we get a nice display: find($files_print, "/tmp"); Of course, we didn't really need that second object: we could have generated it on the fly: find($files->print, "/tmp"); C supports options to modify behavior, such as depth-first searching. The C step flags this in the options as well: my $files_depth_print = $files->depth->print; However, the C object needs to be told explictly to generate an options hash for C to pass this information along: find($files_depth_print->as_options, "/tmp"); A C object, like the I command, supports AND, OR, NOT, and parenthesized sub-expressions. AND binds tighter than OR, and is also implied everywhere that it makes sense. Like I, the predicates are computed in a "short-circuit" fashion, so that a false to the left of the (implied) AND keeps the right side from being evaluated, including entire parenthesized subexpressions. Similarly, if the left side of an OR is false, the right side is evaluated, and if the left side of the OR is true, the right side is skipped. Nested parens are handled properly. Parens are indicated with the rather ugly C and C methods: my $big_or_old_files = $files->left->size("+50")->or->atime("+30")->right; The parens here correspond directly to the parens in: find somewhere -type f '(' -size +50 -o -atime +30 ')' and are needed so that the OR and the implied ANDs have the right nesting. Besides passing the constructed C object to C directly as a C routine or an options hash, you can also call C implictly, with C. C provides a list of starting points, and returns all filenames that match the criteria. For example, a list of all names in /tmp can be generated simply with: my @names = File::Finder->in("/tmp"); For more flexibility, use C to execute an arbitrary block in a list context, concatenating all the results (similar to C): my %sizes = File::Finder ->collect(sub { $File::Find::name => -s _ }, "/tmp"); That's all I can think of for now. The rest is in the detailed reference below. =head2 META METHODS All of these methods can be used as class or instance methods, except C, which is usually not needed and is class only. =over =item new Not strictly needed, because any instance method called on a class will create a new object anyway. =item as_wanted Returns a subroutine suitable for passing to C or C as the I routine. If the object is used in a place that wants a coderef, this happens automatically through overloading. =item as_options Returns a hashref suitable for passing to C or C as the I hash. This is necessary if you want the meta-information to carry forward properly. =item in(@starting_points) Calls C<< File::Find::find($self->as_options, @starting_points) >>, gathering the results, and returns the results as a list. At the moment, it also returns the count of those items in a scalar context. If that's useful, I'll maintain that. =item collect($coderef, @starting_points) Calls C<$coderef> in a list context for each of the matching items, gathering and concatenating the results, and returning the results as a list. my $f = File::Finder->type('f'); my %sizes = $f->collect(sub { $File::Find::name, -s _ }, "/tmp"); In fact, C is implemented by calling C with a coderef of just C. =back =head2 STEPS See L. =head2 SPEED All the steps can have a compile-time and run-time component. As much work is done during compile-time as possible. Runtime consists of a simple linear pass executing a series of closures representing the individual steps (not method calls). It is hoped that this will produce a speed that is within a factor of 2 or 3 of a handcrafted monolithic C routine. =head1 SEE ALSO L, L, L, L =head1 BUGS Please report bugs to C. =head1 AUTHOR Randal L. Schwartz, Emerlyn@stonehenge.comE, with a tip of the hat to Richard Clamp for C. =head1 COPYRIGHT AND LICENSE Copyright (C) 2003,2004 by Randal L. Schwartz, Stonehenge Consulting Services, Inc. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.2 or, at your option, any later version of Perl 5 you may have available. =cut File-Finder-0.53/Makefile.PL0000644000076500000240000000076107770017115016141 0ustar merlynstaff00000000000000use 5.006; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'File::Finder', VERSION_FROM => 'lib/File/Finder.pm', # finds $VERSION PREREQ_PM => { "Text::Glob" => 0, "Test::More" => 0, }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/File/Finder.pm', # retrieve abstract from module AUTHOR => 'Randal L. Schwartz ') : ()), ); File-Finder-0.53/MANIFEST0000644000076500000240000000036710221321312015300 0ustar merlynstaff00000000000000Changes lib/File/Finder.pm lib/File/Finder/Steps.pm Makefile.PL MANIFEST MANIFEST.SKIP META.yml README t/01-core.t t/02-basic-logic.t t/03-options.t t/04-ffr.t t/05-steps.t t/99-test-distro.t t/99-test-pod-coverage.t t/99-test-pod.t t/cprove TODO File-Finder-0.53/MANIFEST.SKIP0000644000076500000240000000070510221320162016043 0ustar merlynstaff00000000000000# Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ # Avoid Devel::Cover files. \bcover_db\b ### LOCAL ### ^OLD/ File-Finder-0.53/META.yml0000644000076500000240000000057410225557744015450 0ustar merlynstaff00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: File-Finder version: 0.53 version_from: lib/File/Finder.pm installdirs: site requires: Test::More: 0 Text::Glob: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.27 File-Finder-0.53/README0000644000076500000240000000206407770017264015052 0ustar merlynstaff00000000000000File::Finder - nice wrapper for File::Find ala find(1) SYNOPSIS use File::Finder; ## simulate "-type f" my $all_files = File::Finder->type('f'); ## any rule can be extended: my $all_files_printer = $all_files->print; ## traditional use: generating "wanted" subroutines: use File::Find; find($all_files_printer, @starting_points); ## or, we can gather up the results immediately: my @results = $all_files->in(@starting_points); ## -depth and -follow are noted, but need a bit of help for find: my $deep_dirs = File::Finder->depth->type('d')->ls->exec('rmdir','{}'); find($deep_dirs->as_options, @places); DESCRIPTION File::Find is great, but constructing the wanted routine can sometimes be a pain. This module provides a wanted-writer, using syntax that is directly mappable to the find command's syntax. Also, I find myself (heh) frequently just wanting the list of names that match. With File::Find, I have to write a little accumulator, and then access that from a closure. But with File::Finder, I can turn the problem inside out. File-Finder-0.53/t/0000755000076500000240000000000010225557744014434 5ustar merlynstaff00000000000000File-Finder-0.53/t/01-core.t0000644000076500000240000000120010127541577015756 0ustar merlynstaff00000000000000#! perl use Test::More 'no_plan'; # use File::Find; # use Data::Dumper; # $Data::Dumper::Deparse = 1; ## test presence of documented protocol require_ok('File::Finder'); can_ok('File::Finder', qw(new as_wanted as_options in collect)); require_ok('File::Finder::Steps'); can_ok('File::Finder::Steps', qw(or left begin right end not true false comma follow name perm type print print0 user group nouser nogroup links inum size atime mtime ctime exec ok prune depth ls ffr )); isa_ok(my $f = File::Finder->new, "File::Finder"); isa_ok($f->as_wanted, "CODE"); isa_ok($f->as_options, "HASH"); File-Finder-0.53/t/02-basic-logic.t0000644000076500000240000001536110127530053017203 0ustar merlynstaff00000000000000#! perl use Test::More 'no_plan'; BEGIN { use_ok('File::Finder') } isa_ok(my $f = File::Finder->new, "File::Finder"); { my $r; $f->eval(sub {$r += 2})->as_wanted->(); is($r, 2, 'core eval'); } { my $r; $f ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'core true'); } { my $r; $f->eval(sub { 0 }) ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'core false'); } { my $r; $f->or ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, undef, 'core skipping'); } { my $r; $f->true ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'explicit true'); } { my $r; $f->false ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'explicit false'); } { my $r; $f->not->true ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'not true = false'); } { my $r; $f->not->false ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'not false = true'); } { my $r; $f->not->not->true ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'not not true = true'); } { my $r; $f->not->not->false ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'not not false = false'); } { my $r; $f->or ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, undef, 'true OR ... = skipping'); } { my $r; $f->false->or ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'false OR ... = true'); } { my $r; $f->or->or ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, undef, 'skipping OR ... = skipping'); } { my $r; $f ->left->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'true () = true'); } { my $r; $f->eval(sub { 0 }) ->left->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'false () = false'); } { my $r; $f->or ->left->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, undef, 'skipping () = skipping'); } { my $r; $f ->left ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, 2, 'true ( ... = true'); } { my $r; $f->eval(sub { 0 }) ->left ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'false ( ... = skipping'); } { my $r; $f->or ->left ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'skipping ( ... = skipping'); } { my $r; $f ->left->true->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'true ( true ) = true'); } { my $r; $f ->left->false->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'true ( false ) = false'); } { my $r; $f ->left->or->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'true ( skipping ) = true'); } { my $r; $f->false ->left->true->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'false ( true ) = false'); } { my $r; $f->false ->left->false->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'false ( false ) = false'); } { my $r; $f->false ->left->or->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'false ( skipping ) = false'); } { my $r; $f->or ->left->true->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, undef, 'skipping ( true ) = skipping'); } { my $r; $f->or ->left->false->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, undef, 'skipping ( false ) = skipping'); } { my $r; $f->or ->left->or->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, undef, 'skipping ( skipping ) = skipping'); } { my $r; $f->not ->left->true->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'not ( true ) = false'); } { my $r; $f->not ->left->false->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'not ( false ) = true'); } { my $r; $f->not ->left->or->right ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 1, 'not ( skipping ) = false'); } { my $r; $f->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'true , = true'); } { my $r; $f->false ->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'false , = true'); } { my $r; $f->or->true ->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->as_wanted->(); is($r, 2, 'skipping , = true'); } { my $r; $f ->left ->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, 2, 'true ( true , ... = true'); } { my $r; $f->eval(sub { 0 }) ->left ->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'false ( true , ... = skipping'); } { my $r; $f->or ->left ->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'skipping ( true , ... = skipping'); } { my $r; $f ->left ->false->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, 2, 'true ( false , ... = true'); } { my $r; $f->eval(sub { 0 }) ->left ->false->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'false ( false , ... = skipping'); } { my $r; $f->or ->left ->false->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'skipping ( false , ... = skipping'); } { my $r; $f ->left ->or->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, 2, 'true ( skipping , ... = true'); } { my $r; $f->eval(sub { 0 }) ->left ->or->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'false ( skipping , ... = skipping'); } { my $r; $f->or ->left ->or->comma ->eval(sub {$r += 2})->or->eval(sub {$r += 1}) ->right ->as_wanted->(); is($r, undef, 'skipping ( skipping , ... = skipping'); } File-Finder-0.53/t/03-options.t0000644000076500000240000000075010127527731016530 0ustar merlynstaff00000000000000#! perl use Test::More 'no_plan'; BEGIN { use_ok('File::Finder') } isa_ok(my $f = File::Finder->new, "File::Finder"); ## also tests cloning { isa_ok(my $f1 = $f->depth, "File::Finder"); ok($f1->as_options->{bydepth}, "setting bydepth"); ok(!$f1->as_options->{follow}, "setting bydepth, follow not set"); } { isa_ok(my $f1 = $f->follow, "File::Finder"); ok($f1->as_options->{follow}, "setting follow"); ok(!$f1->as_options->{bydepth}, "setting follow, bydepth not set"); } File-Finder-0.53/t/04-ffr.t0000644000076500000240000000273107770710450015616 0ustar merlynstaff00000000000000#! perl use Test::More; BEGIN { eval { require File::Find::Rule }; plan 'skip_all' => 'No File::Find::Rule installed' if $@; } plan 'no_plan'; BEGIN { use_ok('File::Finder') } isa_ok(my $f = File::Finder->new, 'File::Finder'); isa_ok(my $ffr = File::Find::Rule->new, 'File::Find::Rule'); isa_ok(my $combined = $f->ffr($ffr), 'File::Finder'); { my $r; isa_ok(my $ffr = File::Find::Rule->exec(sub { $r = 1 }), "File::Find::Rule"); isa_ok(my $combined = $f->ffr($ffr), "File::Finder"); ## have to simulate being called in File::Find::find; local $File::Find::name = "/DUM/MY"; local $_ = "MY"; local $File::Find::dir = "/DUM"; $combined->as_wanted->(); is($r, 1, "simple ffr rule ran"); } { my $r; isa_ok(my $ffr = File::Find::Rule->exec(sub { 1 }), "File::Find::Rule"); isa_ok(my $combined = $f->ffr($ffr), "File::Finder"); ## have to simulate being called in File::Find::find; local $File::Find::name = "/DUM/MY"; local $_ = "MY"; local $File::Find::dir = "/DUM"; $combined->eval(sub { $r = 1 })->as_wanted->(); is($r, 1, "simple ffr rule returned true"); } { my $r; isa_ok(my $ffr = File::Find::Rule->exec(sub { 0 }), "File::Find::Rule"); isa_ok(my $combined = $f->ffr($ffr), "File::Finder"); ## have to simulate being called in File::Find::find; local $File::Find::name = "/DUM/MY"; local $_ = "MY"; local $File::Find::dir = "/DUM"; $combined->eval(sub { $r = 1 })->as_wanted->(); is($r, undef, "simple ffr rule returned false"); } File-Finder-0.53/t/05-steps.t0000644000076500000240000000630310131156134016163 0ustar merlynstaff00000000000000#! perl use Test::More 'no_plan'; require_ok('File::Finder'); isa_ok(my $f = File::Finder->new, "File::Finder"); use File::Find; sub fin { my $wanted = shift; my @results; find(sub {$wanted->() and push @results, $File::Find::name}, @_); @results; } is_deeply([File::Finder->in(qw(.))], [fin(sub { 1 }, '.')], 'all names'); is_deeply([File::Finder->name(qr/\.t$/)->in(qw(.))], [fin(sub { /\.t$/ }, '.')], 'all files named *.t via regex'); is_deeply([File::Finder->name('*.t')->in(qw(.))], [fin(sub { /\.t$/ }, '.')], 'all files named *.t via glob'); is_deeply([File::Finder->perm('+0444')->in(qw(.))], [fin(sub { (stat($_))[2] & 0444 }, '.')], 'readable by someone'); is_deeply([File::Finder->perm('-0444')->in(qw(.))], [fin(sub { ((stat($_))[2] & 0444) == 0444 }, '.')], 'readable by everyone'); is_deeply([File::Finder->perm('+0222')->in(qw(.))], [fin(sub { (stat($_))[2] & 0222 }, '.')], 'writeable by someone'); is_deeply([File::Finder->perm('+0111')->in(qw(.))], [fin(sub { (stat($_))[2] & 0111 }, '.')], 'executable by someone'); is_deeply([File::Finder->perm('0644')->in(qw(.))], [fin(sub { ((stat($_))[2] & 0777) == 0644 }, '.')], 'mode 0644'); is_deeply([File::Finder->perm('0755')->in(qw(.))], [fin(sub { ((stat($_))[2] & 0777) == 0755 }, '.')], 'mode 755'); { my $dirperm = (stat ".")[2] & 07777; is_deeply([File::Finder->perm($dirperm)->in(qw(.))], [fin(sub { ((stat($_))[2] & 07777) == $dirperm }, '.')], 'mode same as current directory'); } is_deeply([File::Finder->type('f')->in(qw(.))], [fin(sub { -f }, '.')], 'all files'); is_deeply([File::Finder->eval(sub { stat('/') })->type('f')->in(qw(.))], [fin(sub { -f }, '.')], 'all files even after messing with _ pseudo handle'); is_deeply([File::Finder->user($<)->in(qw(.))], [fin(sub { -o }, '.')], 'owned'); is_deeply([File::Finder->not->user($<)->in(qw(.))], [fin(sub { not -o }, '.')], 'not owned'); is_deeply([File::Finder->group(0+$()->in(qw(.))], [fin(sub { $( == (stat)[5] }, '.')], 'group'); is_deeply([File::Finder->not->group(0+$()->in(qw(.))], [fin(sub { $( != (stat)[5] }, '.')], 'not group'); is_deeply([File::Finder->nouser->in(qw(.))], [fin(sub { not defined getpwuid((stat)[4]) }, '.')], 'nouser'); is_deeply([File::Finder->not->nouser->in(qw(.))], [fin(sub { defined getpwuid((stat)[4]) }, '.')], 'not nouser'); is_deeply([File::Finder->nogroup->in(qw(.))], [fin(sub { not defined getgrgid((stat)[5]) }, '.')], 'nogroup'); is_deeply([File::Finder->not->nogroup->in(qw(.))], [fin(sub { defined getgrgid((stat)[5]) }, '.')], 'not nogroup'); is_deeply([File::Finder->links('-2')->in(qw(.))], [fin(sub { (stat)[3] < 2 }, '.')], 'less than 2 links'); is_deeply([File::Finder->links('+1')->in(qw(.))], [fin(sub { (stat)[3] > 1 }, '.')], 'more than 1 link'); is_deeply([File::Finder->size('-10c')->in(qw(.))], [fin(sub { -s $_ < 10 }, '.')], 'less than 10 bytes'); is_deeply([File::Finder->size('+10c')->in(qw(.))], [fin(sub { -s $_ > 10 }, '.')], 'more than 10 bytes'); is_deeply([File::Finder->contains('AvErYuNlIkElYsTrInG')->in(qw(.))], ["./" . __FILE__], 'files with a very unlikely string'); File-Finder-0.53/t/99-test-distro.t0000644000076500000240000000055607772620570017350 0ustar merlynstaff00000000000000#! perl use Test::More; BEGIN { eval { require Test::Distribution }; plan 'skip_all' => 'Test::Distribution not installed' if $@; } $ENV{TEST_VERBOSE} or plan 'skip_all' => 'Distribution tests selected only in verbose mode'; Test::Distribution->import; diag "package: $_" for Test::Distribution::packages(); diag "file: $_" for Test::Distribution::files(); File-Finder-0.53/t/99-test-pod-coverage.t0000644000076500000240000000037310221320475020374 0ustar merlynstaff00000000000000#!perl use Test::More; plan skip_all => "Test::Pod::Coverage required for testing POD" unless eval "use Test::Pod::Coverage; 1"; $ENV{TEST_VERBOSE} or plan 'skip_all' => 'Distribution tests selected only in verbose mode'; all_pod_coverage_ok(); File-Finder-0.53/t/99-test-pod.t0000644000076500000240000000036010221320504016570 0ustar merlynstaff00000000000000#!perl use Test::More; plan skip_all => "Test::Pod 1.00 required for testing POD" unless eval "use Test::Pod 1.00; 1"; $ENV{TEST_VERBOSE} or plan 'skip_all' => 'Distribution tests selected only in verbose mode'; all_pod_files_ok(); File-Finder-0.53/t/cprove0000755000076500000240000000014210137327225015644 0ustar merlynstaff00000000000000#!/bin/sh cover -delete PERL5OPT=-MDevel::Cover=+inc,/Volumes/UFS prove -v -I../lib "$@" && cover File-Finder-0.53/TODO0000644000076500000240000000135410225557657014667 0ustar merlynstaff00000000000000## -*- cperl -*- ## update _run from the article (which did it better) ## and vice versa... reference the article from the See Also use File::Finder qw(contains foo bar); # pulls in File::Finder::Plugin::contains etc ## oval: like eval, but operates on open file handle ## (like a more general "contains") ## from ovid: my %status = ( links => sub { (stat(_))[3] }, inum => sub { (stat(_))[1] }, atime => sub { int(-A _) }, mtime => sub { int(-M _) }, ctime => sub { int(-C _) }, ); while (my ($function,$op) = each %status) { no strict 'refs'; *$function = sub { my $self = shift; my ($prefix, $n) = shift =~ qr/^(\+|-|)(.*)/; return sub { _n($prefix, $n, $op->()); }; } }