X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFile%2FFind.pm;h=9b1549429902368d7a1842c16c7eee50d867a87d;hb=3bb6d3e5122054efefe647ff1c834b844fec2fa2;hp=eb4b2dee284492fd236171a51b3abd2322b92279;hpb=43dece2ab75d79010b4220d46295e13b03e10f25;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/File/Find.pm b/lib/File/Find.pm index eb4b2de..9b15494 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -1,25 +1,24 @@ package File::Find; +use 5.006; use strict; use warnings; -use 5.6.0; -our $VERSION = '1.01'; +use warnings::register; +our $VERSION = '1.04'; require Exporter; require Cwd; =head1 NAME -find - traverse a file tree - -finddepth - traverse a directory structure depth-first +File::Find - Traverse a directory tree. =head1 SYNOPSIS use File::Find; - find(\&wanted, '/foo', '/bar'); + find(\&wanted, @directories_to_seach); sub wanted { ... } use File::Find; - finddepth(\&wanted, '/foo', '/bar'); + finddepth(\&wanted, @directories_to_search); sub wanted { ... } use File::Find; @@ -27,8 +26,40 @@ finddepth - traverse a directory structure depth-first =head1 DESCRIPTION +These are functions for searching through directory trees doing work +on each file found similar to the Unix I command. File::Find +exports two functions, C and C. They work similarly +but have subtle differences. + +=over 4 + +=item B + + find(\&wanted, @directories); + find(\%options, @directories); + +find() does a breadth-first search over the given @directories in the +order they are given. In essense, it works from the top down. + +For each file or directory found the &wanted subroutine is called (see +below for details). Additionally, for each directory found it will go +into that directory and continue the search. + +=item B + + finddepth(\&wanted, @directories); + finddepth(\%options, @directories); + +finddepth() works just like find() except it does a depth-first search. +It works from the bottom of the directory tree up. + +=back + +=head2 %options + The first argument to find() is either a hash reference describing the -operations to be performed for each file, or a code reference. +operations to be performed for each file, or a code reference. The +code reference is described in L below. Here are the possible keys for the hash: @@ -36,14 +67,14 @@ Here are the possible keys for the hash: =item C -The value should be a code reference. This code reference is called -I below. +The value should be a code reference. This code reference is +described in L below. =item C Reports the name of a directory only AFTER all its entries have been reported. Entry point finddepth() is a shortcut for -specifying C<{ bydepth => 1 }> in the first argument of find(). +specifying C<{ bydepth =E 1 }> in the first argument of find(). =item C @@ -144,12 +175,48 @@ including all its sub-directories. The default is to 'die' in such a case. =back -The wanted() function does whatever verifications you want. -C<$File::Find::dir> contains the current directory name, and C<$_> the -current filename within that directory. C<$File::Find::name> contains -the complete pathname to the file. You are chdir()'d to -C<$File::Find::dir> when the function is called, unless C -was specified. When C or C are in effect, there is +=head2 The wanted function + +The wanted() function does whatever verifications you want on each +file and directory. It takes no arguments but rather does its work +through a collection of variables. + +=over 4 + +=item C<$File::Find::dir> is the current directory name, + +=item C<$_> is the current filename within that directory + +=item C<$File::Find::name> is the complete pathname to the file. + +=back + +Don't modify these variables. + +For example, when examining the file /some/path/foo.ext you will have: + + $File::Find::dir = /some/path/ + $_ = foo.ext + $File::Find::name = /some/path/foo.ext + +You are chdir()'d toC<$File::Find::dir> when the function is called, +unless C was specified. Note that when changing to +directories is in effect the root directory (F) is a somewhat +special case inasmuch as the concatenation of C<$File::Find::dir>, +C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The +table below summarizes all variants: + + $File::Find::name $File::Find::dir $_ + default / / . + no_chdir=>0 /etc / etc + /etc/x /etc x + + no_chdir=>1 / / / + /etc / /etc + /etc/x /etc /etc/x + + +When or are in effect, there is also a C<$File::Find::fullname>. The function may set C<$File::Find::prune> to prune the tree unless C was specified. Unless C or C is specified, for @@ -180,9 +247,6 @@ Notice the C<_> in the above C: the C<_> is a magical filehandle that caches the information from the preceding stat(), lstat(), or filetest. -Set the variable C<$File::Find::dont_use_nlink> if you're using AFS, -since AFS cheats. - Here's another interesting wanted function. It will find all symbolic links that don't resolve: @@ -193,8 +257,37 @@ links that don't resolve: See also the script C on CPAN for a nice application of this module. +=head1 WARNINGS + +If you run your program with the C<-w> switch, or if you use the +C pragma, File::Find will report warnings for several weird +situations. You can disable these warnings by putting the statement + + no warnings 'File::Find'; + +in the appropriate scope. See L for more info about lexical +warnings. + =head1 CAVEAT +=over 2 + +=item $dont_use_nlink + +You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to +force File::Find to always stat directories. This was used for file systems +that do not have an C count matching the number of sub-directories. +Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file +system) and a couple of others. + +You shouldn't need to set this variable, since File::Find should now detect +such file systems on-the-fly and switch itself to using stat. This works even +for parts of your file system, like a mounted CD-ROM. + +If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs. + +=item symlinks + Be aware that the option to follow symbolic links can be dangerous. Depending on the structure of the directory tree (including symbolic links to directories) you might traverse a given (physical) directory @@ -203,6 +296,8 @@ Furthermore, deleting or changing files in a symbolically linked directory might cause very unpleasant surprises, since you delete or change files in an unknown directory. +=back + =head1 NOTES =over 4 @@ -436,7 +531,7 @@ sub Follow_SymLink($) { return undef unless defined $DEV; # dangling symbolic link } - if ($full_check && $SLnkSeen{$DEV, $INO}++) { + if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) { if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) { die "$AbsName encountered a second time"; } @@ -473,9 +568,9 @@ sub _find_opt { local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat, $pre_process, $post_process, $dangling_symlinks); - local($dir, $name, $fullname, $prune); + local($dir, $name, $fullname, $prune, $_); - my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd(); + my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd(); my $cwd_untainted = $cwd; my $check_t_cwd = 1; $wanted_callback = $wanted->{wanted}; @@ -526,7 +621,7 @@ sub _find_opt { else { $abs_dir = contract_name_Mac($cwd, $top_item); unless (defined $abs_dir) { - warn "Can't determine absolute path for $top_item (No such file or directory)\n" if $^W; + warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n"; next Proc_Top_Item; } } @@ -549,7 +644,7 @@ sub _find_opt { if (ref $dangling_symlinks eq 'CODE') { $dangling_symlinks->($top_item, $cwd); } else { - warn "$top_item is a dangling symbolic link\n" if $^W; + warnings::warnif "$top_item is a dangling symbolic link\n"; } } next Proc_Top_Item; @@ -563,7 +658,7 @@ sub _find_opt { else { # no follow $topdir = $top_item; unless (defined $topnlink) { - warn "Can't stat $top_item: $!\n" if $^W; + warnings::warnif "Can't stat $top_item: $!\n"; next Proc_Top_Item; } if (-d _) { @@ -600,13 +695,14 @@ sub _find_opt { } unless ($no_chdir || chdir $abs_dir) { - warn "Couldn't chdir $abs_dir: $!\n" if $^W; + warnings::warnif "Couldn't chdir $abs_dir: $!\n"; next Proc_Top_Item; } $name = $abs_dir . $_; # $File::Find::name + $_ = $name if $no_chdir; - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" } @@ -641,16 +737,15 @@ sub _find_dir($$$) { my $SE= []; my $dir_name= $p_dir; my $dir_pref; - my $dir_rel; + my $dir_rel = $File::Find::current_dir; my $tainted = 0; + my $no_nlink; if ($Is_MacOS) { $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface - $dir_rel= ':'; # directory name relative to current directory } else { $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" ); - $dir_rel= '.'; # directory name relative to current directory } local ($dir, $name, $prune, *DIR); @@ -669,7 +764,7 @@ sub _find_dir($$$) { } } unless (chdir $udir) { - warn "Can't cd to $udir: $!\n" if $^W; + warnings::warnif "Can't cd to $udir: $!\n"; return; } } @@ -688,7 +783,7 @@ sub _find_dir($$$) { $_= ($no_chdir ? $dir_name : $dir_rel ); # $_ # prune may happen here $prune= 0; - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" next if $prune; } @@ -712,10 +807,11 @@ sub _find_dir($$$) { } unless (chdir $udir) { if ($Is_MacOS) { - warn "Can't cd to ($p_dir) $udir: $!\n" if $^W; + warnings::warnif "Can't cd to ($p_dir) $udir: $!\n"; } else { - warn "Can't cd to (" . ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n" if $^W; + warnings::warnif "Can't cd to (" . + ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n"; } next; } @@ -730,22 +826,28 @@ sub _find_dir($$$) { # Get the list of files in the current directory. unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) { - warn "Can't opendir($dir_name): $!\n" if $^W; + warnings::warnif "Can't opendir($dir_name): $!\n"; next; } @filenames = readdir DIR; closedir(DIR); - @filenames = &$pre_process(@filenames) if $pre_process; + @filenames = $pre_process->(@filenames) if $pre_process; push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process; - if ($nlink == 2 && !$avoid_nlink) { + # default: use whatever was specifid + # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back) + $no_nlink = $avoid_nlink; + # if dir has wrong nlink count, force switch to slower stat method + $no_nlink = 1 if ($nlink < 2); + + if ($nlink == 2 && !$no_nlink) { # This dir has no subdirectories. for my $FN (@filenames) { next if $FN =~ $File::Find::skip_pattern; $name = $dir_pref . $FN; # $File::Find::name $_ = ($no_chdir ? $name : $FN); # $_ - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" } } @@ -755,7 +857,7 @@ sub _find_dir($$$) { for my $FN (@filenames) { next if $FN =~ $File::Find::skip_pattern; - if ($subcount > 0 || $avoid_nlink) { + if ($subcount > 0 || $no_nlink) { # Seen all the subdirs? # check for directoriness. # stat is faster for a file in the current directory @@ -769,13 +871,13 @@ sub _find_dir($$$) { else { $name = $dir_pref . $FN; # $File::Find::name $_= ($no_chdir ? $name : $FN); # $_ - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" } } else { $name = $dir_pref . $FN; # $File::Find::name $_= ($no_chdir ? $name : $FN); # $_ - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" } } } @@ -809,13 +911,8 @@ sub _find_dir($$$) { if ( $nlink == -2 ) { $name = $dir = $p_dir; # $File::Find::name / dir - if ($Is_MacOS) { - $_ = ':'; # $_ - } - else { - $_ = '.'; - } - &$post_process; # End-of-directory processing + $_ = $File::Find::current_dir; + $post_process->(); # End-of-directory processing } elsif ( $nlink < 0 ) { # must be finddepth, report dirname now $name = $dir_name; @@ -829,15 +926,15 @@ sub _find_dir($$$) { } else { if ( substr($name,-2) eq '/.' ) { - $name =~ s|/\.$||; + substr($name, length($name) == 2 ? -1 : -2) = ''; } $dir = $p_dir; $_ = ($no_chdir ? $dir_name : $dir_rel ); if ( substr($_,-2) eq '/.' ) { - s|/\.$||; + substr($_, length($_) == 2 ? -1 : -2) = ''; } } - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" } else { push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; @@ -865,7 +962,7 @@ sub _find_dir_symlnk($$$) { my $dir_name = $p_dir; my $dir_pref; my $loc_pref; - my $dir_rel; + my $dir_rel = $File::Find::current_dir; my $byd_flag; # flag for pending stack entry if $bydepth my $tainted = 0; my $ok = 1; @@ -873,11 +970,9 @@ sub _find_dir_symlnk($$$) { if ($Is_MacOS) { $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:"; $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:"; - $dir_rel = ':'; # directory name relative to current directory } else { $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" ); $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" ); - $dir_rel = '.'; # directory name relative to current directory } local ($dir, $name, $fullname, $prune, *DIR); @@ -900,7 +995,7 @@ sub _find_dir_symlnk($$$) { } $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir); unless ($ok) { - warn "Can't cd to $updir_loc: $!\n" if $^W; + warnings::warnif "Can't cd to $updir_loc: $!\n"; return; } } @@ -917,7 +1012,7 @@ sub _find_dir_symlnk($$$) { # change (back) to parent directory (always untainted) unless ($no_chdir) { unless (chdir $updir_loc) { - warn "Can't cd to $updir_loc: $!\n" if $^W; + warnings::warnif "Can't cd to $updir_loc: $!\n"; next; } } @@ -928,7 +1023,7 @@ sub _find_dir_symlnk($$$) { # prune may happen here $prune= 0; lstat($_); # make sure file tests with '_' work - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" next if $prune; } @@ -948,7 +1043,7 @@ sub _find_dir_symlnk($$$) { } } unless (chdir $updir_loc) { - warn "Can't cd to $updir_loc: $!\n" if $^W; + warnings::warnif "Can't cd to $updir_loc: $!\n"; next; } } @@ -961,7 +1056,7 @@ sub _find_dir_symlnk($$$) { # Get the list of files in the current directory. unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) { - warn "Can't opendir($dir_loc): $!\n" if $^W; + warnings::warnif "Can't opendir($dir_loc): $!\n"; next; } @filenames = readdir DIR; @@ -983,7 +1078,7 @@ sub _find_dir_symlnk($$$) { $fullname = $new_loc; # $File::Find::fullname $name = $dir_pref . $FN; # $File::Find::name $_ = ($no_chdir ? $name : $FN); # $_ - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" } } @@ -1006,7 +1101,7 @@ sub _find_dir_symlnk($$$) { if ( $byd_flag < 0 ) { # must be finddepth, report dirname now unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) { unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted - warn "Can't cd to $updir_loc: $!\n" if $^W; + warnings::warnif "Can't cd to $updir_loc: $!\n"; next; } } @@ -1022,17 +1117,17 @@ sub _find_dir_symlnk($$$) { } else { if ( substr($name,-2) eq '/.' ) { - $name =~ s|/\.$||; # $File::Find::name + substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name } $dir = $p_dir; # $File::Find::dir $_ = ($no_chdir ? $dir_name : $dir_rel); # $_ if ( substr($_,-2) eq '/.' ) { - s|/\.$||; + substr($_, length($_) == 2 ? -1 : -2) = ''; } } lstat($_); # make sure file tests with '_' work - { &$wanted_callback }; # protect against wild "next" + { $wanted_callback->() }; # protect against wild "next" } else { push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth; @@ -1094,7 +1189,8 @@ $File::Find::current_dir = File::Spec->curdir || '.'; $File::Find::dont_use_nlink = 1 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' || - $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'NetWare'; + $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' || + $^O eq 'nto'; # Set dont_use_nlink in your hint file if your system's stat doesn't # report the number of links in a directory as an indication