From 81793b9077171abb50d56e2bdf5d4208e13a783d Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Thu, 9 Dec 1999 00:36:24 +0000 Subject: [PATCH] newer version of File::Find with support for following symlinks and other features, from Helmut Jarausch p4raw-id: //depot/perl@4671 --- lib/File/Find.pm | 706 ++++++++++++++++++++++++++++++++++++++++++++---------- pod/perldelta.pod | 8 + t/lib/filefind.t | 95 +++++++- 3 files changed, 676 insertions(+), 133 deletions(-) diff --git a/lib/File/Find.pm b/lib/File/Find.pm index 28e2e90..56ab798 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -12,70 +12,159 @@ finddepth - traverse a directory structure depth-first =head1 SYNOPSIS use File::Find; - find(\&wanted, '/foo','/bar'); + find(\&wanted, '/foo', '/bar'); sub wanted { ... } use File::Find; - finddepth(\&wanted, '/foo','/bar'); + finddepth(\&wanted, '/foo', '/bar'); sub wanted { ... } + + use File::Find; + find({ wanted => \&process, follow => 1 }, '.'); =head1 DESCRIPTION The first argument to find() is either a hash reference describing the -operations to be performed for each file, a code reference, or a string -that contains a subroutine name. If it is a hash reference, then the -value for the key C should be a code reference. This code -reference is called I below. +operations to be performed for each file, or a code reference. -Currently the only other supported key for the above hash is -C, in presense of which the walk over directories is -performed depth-first. Entry point finddepth() is a shortcut for -specifying C<{ bydepth => 1}> in the first argument of find(). +Here are the possible keys for the hash: + +=over 3 + +=item C + +The value should be a code reference. This code reference is called +I 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(). + +=item C + +Causes symbolic links to be followed. Since directory trees with symbolic +links (followed) may contain files more than once and may even have +cycles, a hash has to be built up with an entry for each file. +This might be expensive both in space and time for a large +directory tree. See I and I below. +If either I or I is in effect: + +=over 6 + +=item + +It is guarantueed that an I has been called before the user's +I function is called. This enables fast file checks involving S< _>. + +=item + +There is a variable C<$File::Find::fullname> which holds the absolute +pathname of the file with all symbolic links resolved + +=back + +=item C + +This is similar to I except that it may report some files +more than once. It does detect cycles however. +Since only symbolic links have to be hashed, this is +much cheaper both in space and time. +If processing a file more than once (by the user's I function) +is worse than just taking time, the option I should be used. + +=item C + +C, which is the default, causes all files which are +neither directories nor symbolic links to be ignored if they are about +to be processed a second time. If a directory or a symbolic link +are about to be processed a second time, File::Find dies. +C causes File::Find to die if any file is about to be +processed a second time. +C causes File::Find to ignore any duplicate files and +dirctories but to proceed normally otherwise. -The wanted() function does whatever verifications you want. -$File::Find::dir contains the current directory name, and $_ the -current filename within that directory. $File::Find::name contains -C<"$File::Find::dir/$_">. You are chdir()'d to $File::Find::dir when -the function is called. The function may set $File::Find::prune to -prune the tree. -File::Find assumes that you don't alter the $_ variable. If you do then -make sure you return it to its original value before exiting your function. +=item C + +Does not C to each directory as it recurses. The wanted() +function will need to be aware of this, of course. In this case, +C<$_> will be the same as C<$File::Find::name>. + +=item C + +If find is used in taint-mode (-T command line switch or if EUID != UID +or if EGID != GID) then internally directory names have to be untainted +before they can be cd'ed to. Therefore they are checked against a regular +expression I. Note, that all names passed to the +user's I function are still tainted. + +=item C + +See above. This should be set using the C quoting operator. +The default is set to C. +Note that the paranthesis which are vital. + +=item C + +If set, directories (subtrees) which fail the I +are skipped. 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 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. This library is useful for the C tool, which when fed, find2perl / -name .nfs\* -mtime +7 \ - -exec rm -f {} \; -o -fstype nfs -prune + -exec rm -f {} \; -o -fstype nfs -prune produces something like: sub wanted { /^\.nfs.*$/ && - (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && + (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && int(-M _) > 7 && unlink($_) || - ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && + ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) && $dev < 0 && ($File::Find::prune = 1); } -Set the variable $File::Find::dont_use_nlink if you're using AFS, +Set the variable C<$File::Find::dont_use_nlink> if you're using AFS, since AFS cheats. -C is just like C, except that it does a depth-first -search. Here's another interesting wanted function. It will find all symlinks that don't resolve: sub wanted { - -l && !-e && print "bogus link: $File::Find::name\n"; + -l && !-e && print "bogus link: $File::Find::name\n"; } -=head1 BUGS +See also the script C on CPAN for a nice application of this +module. + +=head1 CAVEAT + +Be aware that the option to follow symblic links can be dangerous. +Depending on the structure of the directory tree (including symbolic +links to directories) you might traverse a given (physical) directory +more than once (only if C is in effect). +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. -There is no way to make find or finddepth follow symlinks. =cut @@ -83,151 +172,508 @@ There is no way to make find or finddepth follow symlinks. @EXPORT = qw(find finddepth); -sub find_opt { - my $wanted = shift; - my $bydepth = $wanted->{bydepth}; - my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd(); - # Localize these rather than lexicalizing them for backwards - # compatibility. - local($topdir,$topdev,$topino,$topmode,$topnlink); - foreach $topdir (@_) { - (($topdev,$topino,$topmode,$topnlink) = - ($Is_VMS ? stat($topdir) : lstat($topdir))) - || (warn("Can't stat $topdir: $!\n"), next); - if (-d _) { - if (chdir($topdir)) { - $prune = 0; - unless ($bydepth) { - ($dir,$_) = ($topdir,'.'); - $name = $topdir; - $wanted->{wanted}->(); - } - next if $prune; - my $fixtopdir = $topdir; - $fixtopdir =~ s,/$,, ; - $fixtopdir =~ s/\.dir$// if $Is_VMS; - &finddir($wanted,$fixtopdir,$topnlink, $bydepth); - if ($bydepth) { - ($dir,$_) = ($fixtopdir,'.'); - $name = $fixtopdir; - $wanted->{wanted}->(); - } +use strict; +my $Is_VMS; + +require File::Basename; + +my %SLnkSeen; +my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, + $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat); + +sub contract_name { + my ($cdir,$fn) = @_; + + return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.'; + + $cdir = substr($cdir,0,rindex($cdir,'/')+1); + + $fn =~ s|^\./||; + + my $abs_name= $cdir . $fn; + + if (substr($fn,0,3) eq '../') { + do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|); + } + + return $abs_name; +} + + +sub PathCombine($$) { + my ($Base,$Name) = @_; + my $AbsName; + + if (substr($Name,0,1) eq '/') { + $AbsName= $Name; + } + else { + $AbsName= contract_name($Base,$Name); + } + + # (simple) check for recursion + my $newlen= length($AbsName); + if ($newlen <= length($Base)) { + if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/') + && $AbsName eq substr($Base,0,$newlen)) + { + return undef; + } + } + return $AbsName; +} + +sub Follow_SymLink($) { + my ($AbsName) = @_; + + my ($NewName,$DEV, $INO); + ($DEV, $INO)= lstat $AbsName; + + while (-l _) { + if ($SLnkSeen{$DEV, $INO}++) { + if ($follow_skip < 2) { + die "$AbsName is encountered a second time"; } else { - warn "Can't cd to $topdir: $!\n"; + return undef; } } - else { - require File::Basename; - unless (($_,$dir) = File::Basename::fileparse($topdir)) { - ($dir,$_) = ('.', $topdir); + $NewName= PathCombine($AbsName, readlink($AbsName)); + unless(defined $NewName) { + if ($follow_skip < 2) { + die "$AbsName is a recursive symbolic link"; + } + else { + return undef; } - if (chdir($dir)) { - $name = $topdir; - $wanted->{wanted}->(); + } + else { + $AbsName= $NewName; + } + ($DEV, $INO) = lstat($AbsName); + return undef unless defined $DEV; # dangling symbolic link + } + + if ($full_check && $SLnkSeen{$DEV, $INO}++) { + if ($follow_skip < 1) { + die "$AbsName encountered a second time"; + } + else { + return undef; + } + } + + return $AbsName; +} + +use vars qw/ $dir $name $fullname $prune /; +sub _find_dir_symlnk($$$); +sub _find_dir($$$); + +sub _find_opt { + my $wanted = shift; + die "invalid top directory" unless defined $_[0]; + + my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd(); + my $cwd_untainted = $cwd; + $wanted_callback = $wanted->{wanted}; + $bydepth = $wanted->{bydepth}; + $no_chdir = $wanted->{no_chdir}; + $full_check = $wanted->{follow}; + $follow = $full_check || $wanted->{follow_fast}; + $follow_skip = $wanted->{follow_skip}; + $untaint = $wanted->{untaint}; + $untaint_pat = $wanted->{untaint_pattern}; + $untaint_skip = $wanted->{untaint_skip}; + + + # a symbolic link to a directory doesn't increase the link count + $avoid_nlink = $follow || $File::Find::dont_use_nlink; + + if ( $untaint ) { + $cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|; + die "insecure cwd in find(depth)" unless defined($cwd_untainted); + } + + my ($abs_dir, $nlink, $Is_Dir); + + Proc_Top_Item: + foreach my $TOP (@_) { + my $top_item = $TOP; + $top_item =~ s|/$||; + $Is_Dir= 0; + + if ($follow) { + if (substr($top_item,0,1) eq '/') { + $abs_dir = $top_item; + } + elsif ($top_item eq '.') { + $abs_dir = $cwd; } + else { # care about any ../ + $abs_dir = contract_name("$cwd/",$top_item); + } + $abs_dir= Follow_SymLink($abs_dir); + unless (defined $abs_dir) { + warn "$top_item is a dangling symbolic link\n"; + next Proc_Top_Item; + } + if (-d _) { + _find_dir_symlnk($wanted, $abs_dir, $top_item); + $Is_Dir= 1; + } + } + else { # no follow + $nlink = (lstat $top_item)[3]; + unless (defined $nlink) { + warn "Can't stat $top_item: $!\n"; + next Proc_Top_Item; + } + if (-d _) { + $top_item =~ s/\.dir$// if $Is_VMS; + _find_dir($wanted, $top_item, $nlink); + $Is_Dir= 1; + } else { - warn "Can't cd to $dir: $!\n"; + $abs_dir= $top_item; + } + } + + unless ($Is_Dir) { + unless (($_,$dir) = File::Basename::fileparse($abs_dir)) { + ($dir,$_) = ('.', $top_item); + } + + $abs_dir = $dir; + if ($untaint) { + my $abs_dir_save = $abs_dir; + $abs_dir = $1 if $abs_dir =~ m|$untaint_pat|; + unless (defined $abs_dir) { + if ($untaint_skip == 0) { + die "directory $abs_dir_save is still tainted"; + } + else { + next Proc_Top_Item; + } + } + } + + unless ($no_chdir or chdir $abs_dir) { + warn "Couldn't chdir $abs_dir: $!\n"; + next Proc_Top_Item; + } + + $name = $abs_dir; + + &$wanted_callback; + + } + + $no_chdir or chdir $cwd_untainted; + } +} + +# API: +# $wanted +# $p_dir : "parent directory" +# $nlink : what came back from the stat +# preconditions: +# chdir (if not no_chdir) to dir + +sub _find_dir($$$) { + my ($wanted, $p_dir, $nlink) = @_; + my ($CdLvl,$Level) = (0,0); + my @Stack; + my @filenames; + my ($subcount,$sub_nlink); + my $SE= []; + my $dir_name= $p_dir; + my $dir_rel= '.'; # directory name relative to current directory + + local ($dir, $name, $prune, *DIR); + + unless ($no_chdir or $p_dir eq '.') { + my $udir = $p_dir; + if ($untaint) { + $udir = $1 if $p_dir =~ m|$untaint_pat|; + unless (defined $udir) { + if ($untaint_skip == 0) { + die "directory $p_dir is still tainted"; + } + else { + return; + } } } + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + return; + } + } + + while (defined $SE) { + unless ($bydepth) { + $dir= $p_dir; + $name= $dir_name; + $_= ($no_chdir ? $dir_name : $dir_rel ); + # prune may happen here + $prune= 0; + &$wanted_callback; + next if $prune; + } + + # change to that directory + unless ($no_chdir or $dir_rel eq '.') { + my $udir= $dir_rel; + if ($untaint) { + $udir = $1 if $dir_rel =~ m|$untaint_pat|; + unless (defined $udir) { + if ($untaint_skip == 0) { + die "directory ($p_dir/) $dir_rel is still tainted"; + } + } + } + unless (chdir $udir) { + warn "Can't cd to ($p_dir/) $udir : $!\n"; + next; + } + $CdLvl++; + } + + $dir= $dir_name; + + # Get the list of files in the current directory. + unless (opendir DIR, ($no_chdir ? $dir_name : '.')) { + warn "Can't opendir($dir_name): $!\n"; + next; + } + @filenames = readdir DIR; + closedir(DIR); + + if ($nlink == 2 && !$avoid_nlink) { + # This dir has no subdirectories. + for my $FN (@filenames) { + next if $FN =~ /^\.{1,2}$/; + + $name = "$dir_name/$FN"; + $_ = ($no_chdir ? $name : $FN); + &$wanted_callback; + } + + } + else { + # This dir has subdirectories. + $subcount = $nlink - 2; + + for my $FN (@filenames) { + next if $FN =~ /^\.{1,2}$/; + if ($subcount > 0 || $avoid_nlink) { + # Seen all the subdirs? + # check for directoriness. + # stat is faster for a file in the current directory + $sub_nlink = (lstat ($no_chdir ? "$dir_name/$FN" : $FN))[3]; + + if (-d _) { + --$subcount; + $FN =~ s/\.dir$// if $Is_VMS; + push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink]; + } + else { + $name = "$dir_name/$FN"; + $_= ($no_chdir ? $name : $FN); + &$wanted_callback; + } + } + else { $name = "$dir_name/$FN"; + $_= ($no_chdir ? $name : $FN); + &$wanted_callback; + } + } + } + if ($bydepth) { + $name = $dir_name; + $dir = $p_dir; + $_ = ($no_chdir ? $dir_name : $dir_rel ); + &$wanted_callback; + } } continue { - chdir $cwd; + if ( defined ($SE = pop @Stack) ) { + ($Level, $p_dir, $dir_rel, $nlink) = @$SE; + if ($CdLvl > $Level && !$no_chdir) { + die "Can't cd to $dir_name" . '../' x ($CdLvl-$Level) + unless chdir '../' x ($CdLvl-$Level); + $CdLvl = $Level; + } + $dir_name = "$p_dir/$dir_rel"; + } } } -sub finddir { - my($wanted, $nlink, $bydepth); - local($dir, $name); - ($wanted, $dir, $nlink, $bydepth) = @_; - - my($dev, $ino, $mode, $subcount); - - # Get the list of files in the current directory. - opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return); - my(@filenames) = readdir(DIR); - closedir(DIR); - - if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. - for (@filenames) { - next if $_ eq '.'; - next if $_ eq '..'; - $name = "$dir/$_"; - $nlink = 0; - $wanted->{wanted}->(); - } - } - else { # This dir has subdirectories. - $subcount = $nlink - 2; - for (@filenames) { - next if $_ eq '.'; - next if $_ eq '..'; - $nlink = 0; - $prune = 0 unless $bydepth; - $name = "$dir/$_"; - $wanted->{wanted}->() unless $bydepth; - if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? - - # Get link count and check for directoriness. - - $_ = "" if (!defined($_)); - ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); - # unless ($nlink || $dont_use_nlink); - - if (-d _) { - - # It really is a directory, so do it recursively. - - --$subcount; - next if $prune; - if (chdir $_) { - $name =~ s/\.dir$// if $Is_VMS; - &finddir($wanted,$name,$nlink, $bydepth); - chdir '..'; + +# API: +# $wanted +# $dir_loc : absolute location of a dir +# $p_dir : "parent directory" +# preconditions: +# chdir (if not no_chdir) to dir + +sub _find_dir_symlnk($$$) { + my ($wanted, $dir_loc, $p_dir) = @_; + my @Stack; + my @filenames; + my $new_loc; + my $SE = []; + my $dir_name = $p_dir; + my $dir_rel = '.'; # directory name relative to current directory + + local ($dir, $name, $fullname, $prune, *DIR); + + unless ($no_chdir or $p_dir eq '.') { + my $udir = $dir_loc; + if ($untaint) { + $udir = $1 if $dir_loc =~ m|$untaint_pat|; + unless (defined $udir) { + if ($untaint_skip == 0) { + die "directory $dir_loc is still tainted"; + } + else { + return; + } + } + } + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + return; + } + } + + while (defined $SE) { + + unless ($bydepth) { + $dir= $p_dir; + $name= $dir_name; + $_= ($no_chdir ? $dir_name : $dir_rel ); + $fullname= $dir_loc; + # prune may happen here + $prune= 0; + &$wanted_callback; + next if $prune; + } + + # change to that directory + unless ($no_chdir or $dir_rel eq '.') { + my $udir = $dir_loc; + if ($untaint) { + $udir = $1 if $dir_loc =~ m|$untaint_pat|; + unless (defined $udir ) { + if ($untaint_skip == 0) { + die "directory $dir_loc is still tainted"; } else { - warn "Can't cd to $_: $!\n"; + next; } } } - $wanted->{wanted}->() if $bydepth; + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + next; + } + } + + $dir = $dir_name; + + # Get the list of files in the current directory. + unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) { + warn "Can't opendir($dir_loc): $!\n"; + next; + } + @filenames = readdir DIR; + closedir(DIR); + + for my $FN (@filenames) { + next if $FN =~ /^\.{1,2}$/; + + # follow symbolic links / do an lstat + $new_loc= Follow_SymLink("$dir_loc/$FN"); + + # ignore if invalid symlink + next unless defined $new_loc; + + if (-d _) { + push @Stack,[$new_loc,$dir_name,$FN]; + } + else { + $fullname = $new_loc; + $name = "$dir_name/$FN"; + $_ = ($no_chdir ? $name : $FN); + &$wanted_callback; + } + } + + if ($bydepth) { + $fullname = $dir_loc; + $name = $dir_name; + $_ = ($no_chdir ? $dir_name : $dir_rel); + &$wanted_callback; + } + } + continue { + if (defined($SE = pop @Stack)) { + ($dir_loc, $p_dir, $dir_rel) = @$SE; + $dir_name = "$p_dir/$dir_rel"; } } } + sub wrap_wanted { - my $wanted = shift; - ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted }; + my $wanted = shift; + if ( ref($wanted) eq 'HASH' ) { + if ( $wanted->{follow} || $wanted->{follow_fast}) { + $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip}; + } + if ( $wanted->{untaint} ) { + $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$| + unless defined $wanted->{untaint_pattern}; + $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip}; + } + return $wanted; + } + else { + return { wanted => $wanted }; + } } sub find { - my $wanted = shift; - find_opt(wrap_wanted($wanted), @_); + my $wanted = shift; + _find_opt(wrap_wanted($wanted), @_); + %SLnkSeen= (); # free memory } sub finddepth { - my $wanted = wrap_wanted(shift); - $wanted->{bydepth} = 1; - find_opt($wanted, @_); + my $wanted = wrap_wanted(shift); + $wanted->{bydepth} = 1; + _find_opt($wanted, @_); + %SLnkSeen= (); # free memory } # These are hard-coded for now, but may move to hint files. if ($^O eq 'VMS') { - $Is_VMS = 1; - $dont_use_nlink = 1; + $Is_VMS = 1; + $File::Find::dont_use_nlink = 1; } -$dont_use_nlink = 1 +$File::Find::dont_use_nlink = 1 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; # 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 # of the number of files. # See, e.g. hints/machten.sh for MachTen 2.2. -unless ($dont_use_nlink) { - require Config; - $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); +unless ($File::Find::dont_use_nlink) { + require Config; + $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); } 1; - diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 74bb7e7..5fba768 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -1147,6 +1147,14 @@ autoloaded or is a symbolic reference. A bug that caused File::Find to lose track of the working directory when pruning top-level directories has been fixed. +File::Find now also supports several other options to control its +behavior. It can follow symbolic links if the C option is +specified. Enabling the C option will make File::Find skip +changing the current directory when walking directories. The C +flag can be useful when running with taint checks enabled. + +See L. + =item File::Glob This extension implements BSD-style file globbing. By default, diff --git a/t/lib/filefind.t b/t/lib/filefind.t index 5d1492f..8295eaf 100755 --- a/t/lib/filefind.t +++ b/t/lib/filefind.t @@ -1,14 +1,103 @@ -#!./perl +####!./perl + + +my %Expect; +my $symlink_exists = eval { symlink("",""); 1 }; BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; } -print "1..2\n"; +if ( $symlink_exists ) { print "1..59\n"; } +else { print "1..34\n"; } use File::Find; -# hope we will eventually find ourself find(sub { print "ok 1\n" if $_ eq 'filefind.t'; }, "."); finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, "."); + + +my $case = 2; + +END { + unlink 'FA/FA_ord','FA/FSL','FA/FAA/FAA_ord', + 'FA/FAB/FAB_ord','FA/FAB/FABA/FABA_ord','FB/FB_ord','FB/FBA/FBA_ord'; + rmdir 'FA/FAA'; + rmdir 'FA/FAB/FABA'; + rmdir 'FA/FAB'; + rmdir 'FA'; + rmdir 'FB/FBA'; + rmdir 'FB'; +} + +sub Check($) { + $case++; + if ($_[0]) { print "ok $case\n"; } + else { print "not ok $case\n"; } +} + +sub CheckDie($) { + $case++; + if ($_[0]) { print "ok $case\n"; } + else { print "not ok $case\n $!\n"; exit 0; } +} + +sub touch { + CheckDie( open(my $T,'>',$_[0]) ); +} + +sub MkDir($$) { + CheckDie( mkdir($_[0],$_[1]) ); +} + +sub wanted { +# print "'$_' => 1, "; + Check( $Expect{$_} ); + delete $Expect{$_}; + $File::Find::prune=1 if $_ eq 'FABA'; +} + +MkDir( 'FA',0770 ); +MkDir( 'FB',0770 ); +touch('FB/FB_ord'); +MkDir( 'FB/FBA',0770 ); +touch('FB/FBA/FBA_ord'); +CheckDie( symlink('../FB','FA/FSL') ) if $symlink_exists; +touch('FA/FA_ord'); + +MkDir( 'FA/FAA',0770 ); +touch('FA/FAA/FAA_ord'); +MkDir( 'FA/FAB',0770 ); +touch('FA/FAB/FAB_ord'); +MkDir( 'FA/FAB/FABA',0770 ); +touch('FA/FAB/FABA/FABA_ord'); + +%Expect=('.' => 1, 'FSL' => 1, 'FA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1, 'FABA' => 1, + 'FAA' => 1, 'FAA_ord' => 1); + +File::Find::find( {wanted => \&wanted, },'FA' ); +Check( scalar(keys %Expect) == 0 ); + +%Expect=('FA' => 1, 'FA/FSL' => 1, 'FA/FA_ord' => 1, 'FA/FAB' => 1, 'FA/FAB/FAB_ord' => 1, + 'FA/FAB/FABA' => 1, 'FA/FAB/FABA/FABA_ord' => 1, 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1); +File::Find::find( {wanted => \&wanted, no_chdir => 1},'FA' ); + +Check( scalar(keys %Expect) == 0 ); + +if ( $symlink_exists ) { + %Expect=('.' => 1, 'FA_ord' => 1, 'FSL' => 1, 'FB_ord' => 1, 'FBA' => 1, + 'FBA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1, 'FABA' => 1, 'FAA' => 1, + 'FAA_ord' => 1); + + File::Find::find( {wanted => \&wanted, follow_fast => 1},'FA' ); + Check( scalar(keys %Expect) == 0 ); + %Expect=('FA' => 1, 'FA/FA_ord' => 1, 'FA/FSL' => 1, 'FA/FSL/FB_ord' => 1, + 'FA/FSL/FBA' => 1, 'FA/FSL/FBA/FBA_ord' => 1, 'FA/FAB' => 1, + 'FA/FAB/FAB_ord' => 1, 'FA/FAB/FABA' => 1, 'FA/FAB/FABA/FABA_ord' => 1, + 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1); + File::Find::find( {wanted => \&wanted, follow_fast => 1, no_chdir => 1},'FA' ); + Check( scalar(keys %Expect) == 0 ); +} + +print "# of cases: $case\n"; -- 2.7.4