[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/File/ -> Find.pm (source)

   1  package File::Find;
   2  use 5.006;
   3  use strict;
   4  use warnings;
   5  use warnings::register;
   6  our $VERSION = '1.12';
   7  require Exporter;
   8  require Cwd;
   9  
  10  #
  11  # Modified to ensure sub-directory traversal order is not inverded by stack
  12  # push and pops.  That is remains in the same order as in the directory file,
  13  # or user pre-processing (EG:sorted).
  14  #
  15  
  16  =head1 NAME
  17  
  18  File::Find - Traverse a directory tree.
  19  
  20  =head1 SYNOPSIS
  21  
  22      use File::Find;
  23      find(\&wanted, @directories_to_search);
  24      sub wanted { ... }
  25  
  26      use File::Find;
  27      finddepth(\&wanted, @directories_to_search);
  28      sub wanted { ... }
  29  
  30      use File::Find;
  31      find({ wanted => \&process, follow => 1 }, '.');
  32  
  33  =head1 DESCRIPTION
  34  
  35  These are functions for searching through directory trees doing work
  36  on each file found similar to the Unix I<find> command.  File::Find
  37  exports two functions, C<find> and C<finddepth>.  They work similarly
  38  but have subtle differences.
  39  
  40  =over 4
  41  
  42  =item B<find>
  43  
  44    find(\&wanted,  @directories);
  45    find(\%options, @directories);
  46  
  47  C<find()> does a depth-first search over the given C<@directories> in
  48  the order they are given.  For each file or directory found, it calls
  49  the C<&wanted> subroutine.  (See below for details on how to use the
  50  C<&wanted> function).  Additionally, for each directory found, it will
  51  C<chdir()> into that directory and continue the search, invoking the
  52  C<&wanted> function on each file or subdirectory in the directory.
  53  
  54  =item B<finddepth>
  55  
  56    finddepth(\&wanted,  @directories);
  57    finddepth(\%options, @directories);
  58  
  59  C<finddepth()> works just like C<find()> except that it invokes the
  60  C<&wanted> function for a directory I<after> invoking it for the
  61  directory's contents.  It does a postorder traversal instead of a
  62  preorder traversal, working from the bottom of the directory tree up
  63  where C<find()> works from the top of the tree down.
  64  
  65  =back
  66  
  67  =head2 %options
  68  
  69  The first argument to C<find()> is either a code reference to your
  70  C<&wanted> function, or a hash reference describing the operations
  71  to be performed for each file.  The
  72  code reference is described in L<The wanted function> below.
  73  
  74  Here are the possible keys for the hash:
  75  
  76  =over 3
  77  
  78  =item C<wanted>
  79  
  80  The value should be a code reference.  This code reference is
  81  described in L<The wanted function> below.
  82  
  83  =item C<bydepth>
  84  
  85  Reports the name of a directory only AFTER all its entries
  86  have been reported.  Entry point C<finddepth()> is a shortcut for
  87  specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>.
  88  
  89  =item C<preprocess>
  90  
  91  The value should be a code reference. This code reference is used to
  92  preprocess the current directory. The name of the currently processed
  93  directory is in C<$File::Find::dir>. Your preprocessing function is
  94  called after C<readdir()>, but before the loop that calls the C<wanted()>
  95  function. It is called with a list of strings (actually file/directory
  96  names) and is expected to return a list of strings. The code can be
  97  used to sort the file/directory names alphabetically, numerically,
  98  or to filter out directory entries based on their name alone. When
  99  I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
 100  
 101  =item C<postprocess>
 102  
 103  The value should be a code reference. It is invoked just before leaving
 104  the currently processed directory. It is called in void context with no
 105  arguments. The name of the current directory is in C<$File::Find::dir>. This
 106  hook is handy for summarizing a directory, such as calculating its disk
 107  usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
 108  no-op.
 109  
 110  =item C<follow>
 111  
 112  Causes symbolic links to be followed. Since directory trees with symbolic
 113  links (followed) may contain files more than once and may even have
 114  cycles, a hash has to be built up with an entry for each file.
 115  This might be expensive both in space and time for a large
 116  directory tree. See I<follow_fast> and I<follow_skip> below.
 117  If either I<follow> or I<follow_fast> is in effect:
 118  
 119  =over 6
 120  
 121  =item *
 122  
 123  It is guaranteed that an I<lstat> has been called before the user's
 124  C<wanted()> function is called. This enables fast file checks involving S<_>.
 125  Note that this guarantee no longer holds if I<follow> or I<follow_fast>
 126  are not set.
 127  
 128  =item *
 129  
 130  There is a variable C<$File::Find::fullname> which holds the absolute
 131  pathname of the file with all symbolic links resolved.  If the link is
 132  a dangling symbolic link, then fullname will be set to C<undef>.
 133  
 134  =back
 135  
 136  This is a no-op on Win32.
 137  
 138  =item C<follow_fast>
 139  
 140  This is similar to I<follow> except that it may report some files more
 141  than once.  It does detect cycles, however.  Since only symbolic links
 142  have to be hashed, this is much cheaper both in space and time.  If
 143  processing a file more than once (by the user's C<wanted()> function)
 144  is worse than just taking time, the option I<follow> should be used.
 145  
 146  This is also a no-op on Win32.
 147  
 148  =item C<follow_skip>
 149  
 150  C<follow_skip==1>, which is the default, causes all files which are
 151  neither directories nor symbolic links to be ignored if they are about
 152  to be processed a second time. If a directory or a symbolic link
 153  are about to be processed a second time, File::Find dies.
 154  
 155  C<follow_skip==0> causes File::Find to die if any file is about to be
 156  processed a second time.
 157  
 158  C<follow_skip==2> causes File::Find to ignore any duplicate files and
 159  directories but to proceed normally otherwise.
 160  
 161  =item C<dangling_symlinks>
 162  
 163  If true and a code reference, will be called with the symbolic link
 164  name and the directory it lives in as arguments.  Otherwise, if true
 165  and warnings are on, warning "symbolic_link_name is a dangling
 166  symbolic link\n" will be issued.  If false, the dangling symbolic link
 167  will be silently ignored.
 168  
 169  =item C<no_chdir>
 170  
 171  Does not C<chdir()> to each directory as it recurses. The C<wanted()>
 172  function will need to be aware of this, of course. In this case,
 173  C<$_> will be the same as C<$File::Find::name>.
 174  
 175  =item C<untaint>
 176  
 177  If find is used in taint-mode (-T command line switch or if EUID != UID
 178  or if EGID != GID) then internally directory names have to be untainted
 179  before they can be chdir'ed to. Therefore they are checked against a regular
 180  expression I<untaint_pattern>.  Note that all names passed to the user's
 181  I<wanted()> function are still tainted. If this option is used while
 182  not in taint-mode, C<untaint> is a no-op.
 183  
 184  =item C<untaint_pattern>
 185  
 186  See above. This should be set using the C<qr> quoting operator.
 187  The default is set to  C<qr|^([-+@\w./]+)$|>.
 188  Note that the parentheses are vital.
 189  
 190  =item C<untaint_skip>
 191  
 192  If set, a directory which fails the I<untaint_pattern> is skipped,
 193  including all its sub-directories. The default is to 'die' in such a case.
 194  
 195  =back
 196  
 197  =head2 The wanted function
 198  
 199  The C<wanted()> function does whatever verifications you want on
 200  each file and directory.  Note that despite its name, the C<wanted()>
 201  function is a generic callback function, and does B<not> tell
 202  File::Find if a file is "wanted" or not.  In fact, its return value
 203  is ignored.
 204  
 205  The wanted function takes no arguments but rather does its work
 206  through a collection of variables.
 207  
 208  =over 4
 209  
 210  =item C<$File::Find::dir> is the current directory name,
 211  
 212  =item C<$_> is the current filename within that directory
 213  
 214  =item C<$File::Find::name> is the complete pathname to the file.
 215  
 216  =back
 217  
 218  The above variables have all been localized and may be changed without
 219  effecting data outside of the wanted function.
 220  
 221  For example, when examining the file F</some/path/foo.ext> you will have:
 222  
 223      $File::Find::dir  = /some/path/
 224      $_                = foo.ext
 225      $File::Find::name = /some/path/foo.ext
 226  
 227  You are chdir()'d to C<$File::Find::dir> when the function is called,
 228  unless C<no_chdir> was specified. Note that when changing to
 229  directories is in effect the root directory (F</>) is a somewhat
 230  special case inasmuch as the concatenation of C<$File::Find::dir>,
 231  C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
 232  table below summarizes all variants:
 233  
 234                $File::Find::name  $File::Find::dir  $_
 235   default      /                  /                 .
 236   no_chdir=>0  /etc               /                 etc
 237                /etc/x             /etc              x
 238  
 239   no_chdir=>1  /                  /                 /
 240                /etc               /                 /etc
 241                /etc/x             /etc              /etc/x
 242  
 243  
 244  When <follow> or <follow_fast> are in effect, there is
 245  also a C<$File::Find::fullname>.  The function may set
 246  C<$File::Find::prune> to prune the tree unless C<bydepth> was
 247  specified.  Unless C<follow> or C<follow_fast> is specified, for
 248  compatibility reasons (find.pl, find2perl) there are in addition the
 249  following globals available: C<$File::Find::topdir>,
 250  C<$File::Find::topdev>, C<$File::Find::topino>,
 251  C<$File::Find::topmode> and C<$File::Find::topnlink>.
 252  
 253  This library is useful for the C<find2perl> tool, which when fed,
 254  
 255      find2perl / -name .nfs\* -mtime +7 \
 256          -exec rm -f {} \; -o -fstype nfs -prune
 257  
 258  produces something like:
 259  
 260      sub wanted {
 261          /^\.nfs.*\z/s &&
 262          (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
 263          int(-M _) > 7 &&
 264          unlink($_)
 265          ||
 266          ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
 267          $dev < 0 &&
 268          ($File::Find::prune = 1);
 269      }
 270  
 271  Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
 272  filehandle that caches the information from the preceding
 273  C<stat()>, C<lstat()>, or filetest.
 274  
 275  Here's another interesting wanted function.  It will find all symbolic
 276  links that don't resolve:
 277  
 278      sub wanted {
 279           -l && !-e && print "bogus link: $File::Find::name\n";
 280      }
 281  
 282  See also the script C<pfind> on CPAN for a nice application of this
 283  module.
 284  
 285  =head1 WARNINGS
 286  
 287  If you run your program with the C<-w> switch, or if you use the
 288  C<warnings> pragma, File::Find will report warnings for several weird
 289  situations. You can disable these warnings by putting the statement
 290  
 291      no warnings 'File::Find';
 292  
 293  in the appropriate scope. See L<perllexwarn> for more info about lexical
 294  warnings.
 295  
 296  =head1 CAVEAT
 297  
 298  =over 2
 299  
 300  =item $dont_use_nlink
 301  
 302  You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
 303  force File::Find to always stat directories. This was used for file systems
 304  that do not have an C<nlink> count matching the number of sub-directories.
 305  Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
 306  system) and a couple of others.
 307  
 308  You shouldn't need to set this variable, since File::Find should now detect
 309  such file systems on-the-fly and switch itself to using stat. This works even
 310  for parts of your file system, like a mounted CD-ROM.
 311  
 312  If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
 313  
 314  =item symlinks
 315  
 316  Be aware that the option to follow symbolic links can be dangerous.
 317  Depending on the structure of the directory tree (including symbolic
 318  links to directories) you might traverse a given (physical) directory
 319  more than once (only if C<follow_fast> is in effect).
 320  Furthermore, deleting or changing files in a symbolically linked directory
 321  might cause very unpleasant surprises, since you delete or change files
 322  in an unknown directory.
 323  
 324  =back
 325  
 326  =head1 NOTES
 327  
 328  =over 4
 329  
 330  =item *
 331  
 332  Mac OS (Classic) users should note a few differences:
 333  
 334  =over 4
 335  
 336  =item *
 337  
 338  The path separator is ':', not '/', and the current directory is denoted
 339  as ':', not '.'. You should be careful about specifying relative pathnames.
 340  While a full path always begins with a volume name, a relative pathname
 341  should always begin with a ':'.  If specifying a volume name only, a
 342  trailing ':' is required.
 343  
 344  =item *
 345  
 346  C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
 347  contains the name of a directory, that name may or may not end with a
 348  ':'. Likewise, C<$File::Find::name>, which contains the complete
 349  pathname to that directory, and C<$File::Find::fullname>, which holds
 350  the absolute pathname of that directory with all symbolic links resolved,
 351  may or may not end with a ':'.
 352  
 353  =item *
 354  
 355  The default C<untaint_pattern> (see above) on Mac OS is set to
 356  C<qr|^(.+)$|>. Note that the parentheses are vital.
 357  
 358  =item *
 359  
 360  The invisible system file "Icon\015" is ignored. While this file may
 361  appear in every directory, there are some more invisible system files
 362  on every volume, which are all located at the volume root level (i.e.
 363  "MacintoshHD:"). These system files are B<not> excluded automatically.
 364  Your filter may use the following code to recognize invisible files or
 365  directories (requires Mac::Files):
 366  
 367   use Mac::Files;
 368  
 369   # invisible() --  returns 1 if file/directory is invisible,
 370   # 0 if it's visible or undef if an error occurred
 371  
 372   sub invisible($) {
 373     my $file = shift;
 374     my ($fileCat, $fileInfo);
 375     my $invisible_flag =  1 << 14;
 376  
 377     if ( $fileCat = FSpGetCatInfo($file) ) {
 378       if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
 379         return (($fileInfo->fdFlags & $invisible_flag) && 1);
 380       }
 381     }
 382     return undef;
 383   }
 384  
 385  Generally, invisible files are system files, unless an odd application
 386  decides to use invisible files for its own purposes. To distinguish
 387  such files from system files, you have to look at the B<type> and B<creator>
 388  file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
 389  C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
 390  (see MacPerl.pm for details).
 391  
 392  Files that appear on the desktop actually reside in an (hidden) directory
 393  named "Desktop Folder" on the particular disk volume. Note that, although
 394  all desktop files appear to be on the same "virtual" desktop, each disk
 395  volume actually maintains its own "Desktop Folder" directory.
 396  
 397  =back
 398  
 399  =back
 400  
 401  =head1 BUGS AND CAVEATS
 402  
 403  Despite the name of the C<finddepth()> function, both C<find()> and
 404  C<finddepth()> perform a depth-first search of the directory
 405  hierarchy.
 406  
 407  =head1 HISTORY
 408  
 409  File::Find used to produce incorrect results if called recursively.
 410  During the development of perl 5.8 this bug was fixed.
 411  The first fixed version of File::Find was 1.01.
 412  
 413  =cut
 414  
 415  our @ISA = qw(Exporter);
 416  our @EXPORT = qw(find finddepth);
 417  
 418  
 419  use strict;
 420  my $Is_VMS;
 421  my $Is_MacOS;
 422  
 423  require File::Basename;
 424  require File::Spec;
 425  
 426  # Should ideally be my() not our() but local() currently
 427  # refuses to operate on lexicals
 428  
 429  our %SLnkSeen;
 430  our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
 431      $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
 432      $pre_process, $post_process, $dangling_symlinks);
 433  
 434  sub contract_name {
 435      my ($cdir,$fn) = @_;
 436  
 437      return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
 438  
 439      $cdir = substr($cdir,0,rindex($cdir,'/')+1);
 440  
 441      $fn =~ s|^\./||;
 442  
 443      my $abs_name= $cdir . $fn;
 444  
 445      if (substr($fn,0,3) eq '../') {
 446         1 while $abs_name =~ s!/[^/]*/\.\./!/!;
 447      }
 448  
 449      return $abs_name;
 450  }
 451  
 452  # return the absolute name of a directory or file
 453  sub contract_name_Mac {
 454      my ($cdir,$fn) = @_;
 455      my $abs_name;
 456  
 457      if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
 458  
 459      my $colon_count = length ($1);
 460      if ($colon_count == 1) {
 461          $abs_name = $cdir . $2;
 462          return $abs_name;
 463      }
 464      else {
 465          # need to move up the tree, but
 466          # only if it's not a volume name
 467          for (my $i=1; $i<$colon_count; $i++) {
 468          unless ($cdir =~ /^[^:]+:$/) { # volume name
 469              $cdir =~ s/[^:]+:$//;
 470          }
 471          else {
 472              return undef;
 473          }
 474          }
 475          $abs_name = $cdir . $2;
 476          return $abs_name;
 477      }
 478  
 479      }
 480      else {
 481  
 482      # $fn may be a valid path to a directory or file or (dangling)
 483      # symlink, without a leading ':'
 484      if ( (-e $fn) || (-l $fn) ) {
 485          if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
 486          return $fn; # $fn is already an absolute path
 487          }
 488          else {
 489          $abs_name = $cdir . $fn;
 490          return $abs_name;
 491          }
 492      }
 493      else { # argh!, $fn is not a valid directory/file
 494           return undef;
 495      }
 496      }
 497  }
 498  
 499  sub PathCombine($$) {
 500      my ($Base,$Name) = @_;
 501      my $AbsName;
 502  
 503      if ($Is_MacOS) {
 504      # $Name is the resolved symlink (always a full path on MacOS),
 505      # i.e. there's no need to call contract_name_Mac()
 506      $AbsName = $Name;
 507  
 508      # (simple) check for recursion
 509      if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
 510          return undef;
 511      }
 512      }
 513      else {
 514      if (substr($Name,0,1) eq '/') {
 515          $AbsName= $Name;
 516      }
 517      else {
 518          $AbsName= contract_name($Base,$Name);
 519      }
 520  
 521      # (simple) check for recursion
 522      my $newlen= length($AbsName);
 523      if ($newlen <= length($Base)) {
 524          if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
 525          && $AbsName eq substr($Base,0,$newlen))
 526          {
 527          return undef;
 528          }
 529      }
 530      }
 531      return $AbsName;
 532  }
 533  
 534  sub Follow_SymLink($) {
 535      my ($AbsName) = @_;
 536  
 537      my ($NewName,$DEV, $INO);
 538      ($DEV, $INO)= lstat $AbsName;
 539  
 540      while (-l _) {
 541      if ($SLnkSeen{$DEV, $INO}++) {
 542          if ($follow_skip < 2) {
 543          die "$AbsName is encountered a second time";
 544          }
 545          else {
 546          return undef;
 547          }
 548      }
 549      $NewName= PathCombine($AbsName, readlink($AbsName));
 550      unless(defined $NewName) {
 551          if ($follow_skip < 2) {
 552          die "$AbsName is a recursive symbolic link";
 553          }
 554          else {
 555          return undef;
 556          }
 557      }
 558      else {
 559          $AbsName= $NewName;
 560      }
 561      ($DEV, $INO) = lstat($AbsName);
 562      return undef unless defined $DEV;  #  dangling symbolic link
 563      }
 564  
 565      if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
 566      if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
 567          die "$AbsName encountered a second time";
 568      }
 569      else {
 570          return undef;
 571      }
 572      }
 573  
 574      return $AbsName;
 575  }
 576  
 577  our($dir, $name, $fullname, $prune);
 578  sub _find_dir_symlnk($$$);
 579  sub _find_dir($$$);
 580  
 581  # check whether or not a scalar variable is tainted
 582  # (code straight from the Camel, 3rd ed., page 561)
 583  sub is_tainted_pp {
 584      my $arg = shift;
 585      my $nada = substr($arg, 0, 0); # zero-length
 586      local $@;
 587      eval { eval "# $nada" };
 588      return length($@) != 0;
 589  }
 590  
 591  sub _find_opt {
 592      my $wanted = shift;
 593      die "invalid top directory" unless defined $_[0];
 594  
 595      # This function must local()ize everything because callbacks may
 596      # call find() or finddepth()
 597  
 598      local %SLnkSeen;
 599      local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
 600      $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
 601      $pre_process, $post_process, $dangling_symlinks);
 602      local($dir, $name, $fullname, $prune);
 603      local *_ = \my $a;
 604  
 605      my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
 606      if ($Is_VMS) {
 607      # VMS returns this by default in VMS format which just doesn't
 608      # work for the rest of this module.
 609      $cwd = VMS::Filespec::unixpath($cwd);
 610  
 611      # Apparently this is not expected to have a trailing space.
 612      # To attempt to make VMS/UNIX conversions mostly reversable,
 613      # a trailing slash is needed.  The run-time functions ignore the
 614      # resulting double slash, but it causes the perl tests to fail.
 615          $cwd =~ s#/\z##;
 616  
 617      # This comes up in upper case now, but should be lower.
 618      # In the future this could be exact case, no need to change.
 619      }
 620      my $cwd_untainted  = $cwd;
 621      my $check_t_cwd    = 1;
 622      $wanted_callback   = $wanted->{wanted};
 623      $bydepth           = $wanted->{bydepth};
 624      $pre_process       = $wanted->{preprocess};
 625      $post_process      = $wanted->{postprocess};
 626      $no_chdir          = $wanted->{no_chdir};
 627      $full_check        = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
 628      $follow            = $^O eq 'MSWin32' ? 0 :
 629                               $full_check || $wanted->{follow_fast};
 630      $follow_skip       = $wanted->{follow_skip};
 631      $untaint           = $wanted->{untaint};
 632      $untaint_pat       = $wanted->{untaint_pattern};
 633      $untaint_skip      = $wanted->{untaint_skip};
 634      $dangling_symlinks = $wanted->{dangling_symlinks};
 635  
 636      # for compatibility reasons (find.pl, find2perl)
 637      local our ($topdir, $topdev, $topino, $topmode, $topnlink);
 638  
 639      # a symbolic link to a directory doesn't increase the link count
 640      $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
 641  
 642      my ($abs_dir, $Is_Dir);
 643  
 644      Proc_Top_Item:
 645      foreach my $TOP (@_) {
 646      my $top_item = $TOP;
 647  
 648      ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
 649  
 650      if ($Is_MacOS) {
 651          $top_item = ":$top_item"
 652          if ( (-d _) && ( $top_item !~ /:/ ) );
 653      } elsif ($^O eq 'MSWin32') {
 654          $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
 655      }
 656      else {
 657          $top_item =~ s|/\z|| unless $top_item eq '/';
 658      }
 659  
 660      $Is_Dir= 0;
 661  
 662      if ($follow) {
 663  
 664          if ($Is_MacOS) {
 665          $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
 666  
 667          if ($top_item eq $File::Find::current_dir) {
 668              $abs_dir = $cwd;
 669          }
 670          else {
 671              $abs_dir = contract_name_Mac($cwd, $top_item);
 672              unless (defined $abs_dir) {
 673              warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
 674              next Proc_Top_Item;
 675              }
 676          }
 677  
 678          }
 679          else {
 680          if (substr($top_item,0,1) eq '/') {
 681              $abs_dir = $top_item;
 682          }
 683          elsif ($top_item eq $File::Find::current_dir) {
 684              $abs_dir = $cwd;
 685          }
 686          else {  # care about any  ../
 687              $top_item =~ s/\.dir\z//i if $Is_VMS;
 688              $abs_dir = contract_name("$cwd/",$top_item);
 689          }
 690          }
 691          $abs_dir= Follow_SymLink($abs_dir);
 692          unless (defined $abs_dir) {
 693          if ($dangling_symlinks) {
 694              if (ref $dangling_symlinks eq 'CODE') {
 695              $dangling_symlinks->($top_item, $cwd);
 696              } else {
 697              warnings::warnif "$top_item is a dangling symbolic link\n";
 698              }
 699          }
 700          next Proc_Top_Item;
 701          }
 702  
 703          if (-d _) {
 704          $top_item =~ s/\.dir\z//i if $Is_VMS;
 705          _find_dir_symlnk($wanted, $abs_dir, $top_item);
 706          $Is_Dir= 1;
 707          }
 708      }
 709      else { # no follow
 710          $topdir = $top_item;
 711          unless (defined $topnlink) {
 712          warnings::warnif "Can't stat $top_item: $!\n";
 713          next Proc_Top_Item;
 714          }
 715          if (-d _) {
 716          $top_item =~ s/\.dir\z//i if $Is_VMS;
 717          _find_dir($wanted, $top_item, $topnlink);
 718          $Is_Dir= 1;
 719          }
 720          else {
 721          $abs_dir= $top_item;
 722          }
 723      }
 724  
 725      unless ($Is_Dir) {
 726          unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
 727          if ($Is_MacOS) {
 728              ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
 729          }
 730          else {
 731              ($dir,$_) = ('./', $top_item);
 732          }
 733          }
 734  
 735          $abs_dir = $dir;
 736          if (( $untaint ) && (is_tainted($dir) )) {
 737          ( $abs_dir ) = $dir =~ m|$untaint_pat|;
 738          unless (defined $abs_dir) {
 739              if ($untaint_skip == 0) {
 740              die "directory $dir is still tainted";
 741              }
 742              else {
 743              next Proc_Top_Item;
 744              }
 745          }
 746          }
 747  
 748          unless ($no_chdir || chdir $abs_dir) {
 749          warnings::warnif "Couldn't chdir $abs_dir: $!\n";
 750          next Proc_Top_Item;
 751          }
 752  
 753          $name = $abs_dir . $_; # $File::Find::name
 754          $_ = $name if $no_chdir;
 755  
 756          { $wanted_callback->() }; # protect against wild "next"
 757  
 758      }
 759  
 760      unless ( $no_chdir ) {
 761          if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
 762          ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
 763          unless (defined $cwd_untainted) {
 764              die "insecure cwd in find(depth)";
 765          }
 766          $check_t_cwd = 0;
 767          }
 768          unless (chdir $cwd_untainted) {
 769          die "Can't cd to $cwd: $!\n";
 770          }
 771      }
 772      }
 773  }
 774  
 775  # API:
 776  #  $wanted
 777  #  $p_dir :  "parent directory"
 778  #  $nlink :  what came back from the stat
 779  # preconditions:
 780  #  chdir (if not no_chdir) to dir
 781  
 782  sub _find_dir($$$) {
 783      my ($wanted, $p_dir, $nlink) = @_;
 784      my ($CdLvl,$Level) = (0,0);
 785      my @Stack;
 786      my @filenames;
 787      my ($subcount,$sub_nlink);
 788      my $SE= [];
 789      my $dir_name= $p_dir;
 790      my $dir_pref;
 791      my $dir_rel = $File::Find::current_dir;
 792      my $tainted = 0;
 793      my $no_nlink;
 794  
 795      if ($Is_MacOS) {
 796      $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
 797      } elsif ($^O eq 'MSWin32') {
 798      $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
 799      } elsif ($^O eq 'VMS') {
 800  
 801      #    VMS is returning trailing .dir on directories
 802      #    and trailing . on files and symbolic links
 803      #    in UNIX syntax.
 804      #
 805  
 806      $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
 807  
 808      $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
 809      }
 810      else {
 811      $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
 812      }
 813  
 814      local ($dir, $name, $prune, *DIR);
 815  
 816      unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
 817      my $udir = $p_dir;
 818      if (( $untaint ) && (is_tainted($p_dir) )) {
 819          ( $udir ) = $p_dir =~ m|$untaint_pat|;
 820          unless (defined $udir) {
 821          if ($untaint_skip == 0) {
 822              die "directory $p_dir is still tainted";
 823          }
 824          else {
 825              return;
 826          }
 827          }
 828      }
 829      unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 830          warnings::warnif "Can't cd to $udir: $!\n";
 831          return;
 832      }
 833      }
 834  
 835      # push the starting directory
 836      push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
 837  
 838      if ($Is_MacOS) {
 839      $p_dir = $dir_pref;  # ensure trailing ':'
 840      }
 841  
 842      while (defined $SE) {
 843      unless ($bydepth) {
 844          $dir= $p_dir; # $File::Find::dir
 845          $name= $dir_name; # $File::Find::name
 846          $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
 847          # prune may happen here
 848          $prune= 0;
 849          { $wanted_callback->() };    # protect against wild "next"
 850          next if $prune;
 851      }
 852  
 853      # change to that directory
 854      unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
 855          my $udir= $dir_rel;
 856          if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
 857          ( $udir ) = $dir_rel =~ m|$untaint_pat|;
 858          unless (defined $udir) {
 859              if ($untaint_skip == 0) {
 860              if ($Is_MacOS) {
 861                  die "directory ($p_dir) $dir_rel is still tainted";
 862              }
 863              else {
 864                  die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
 865              }
 866              } else { # $untaint_skip == 1
 867              next;
 868              }
 869          }
 870          }
 871          unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
 872          if ($Is_MacOS) {
 873              warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
 874          }
 875          else {
 876              warnings::warnif "Can't cd to (" .
 877              ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
 878          }
 879          next;
 880          }
 881          $CdLvl++;
 882      }
 883  
 884      if ($Is_MacOS) {
 885          $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
 886      }
 887  
 888      $dir= $dir_name; # $File::Find::dir
 889  
 890      # Get the list of files in the current directory.
 891      unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
 892          warnings::warnif "Can't opendir($dir_name): $!\n";
 893          next;
 894      }
 895      @filenames = readdir DIR;
 896      closedir(DIR);
 897      @filenames = $pre_process->(@filenames) if $pre_process;
 898      push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
 899  
 900      # default: use whatever was specifid
 901          # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
 902          $no_nlink = $avoid_nlink;
 903          # if dir has wrong nlink count, force switch to slower stat method
 904          $no_nlink = 1 if ($nlink < 2);
 905  
 906      if ($nlink == 2 && !$no_nlink) {
 907          # This dir has no subdirectories.
 908          for my $FN (@filenames) {
 909          if ($Is_VMS) {
 910          # Big hammer here - Compensate for VMS trailing . and .dir
 911          # No win situation until this is changed, but this
 912          # will handle the majority of the cases with breaking the fewest
 913  
 914              $FN =~ s/\.dir\z//i;
 915              $FN =~ s#\.$## if ($FN ne '.');
 916          }
 917          next if $FN =~ $File::Find::skip_pattern;
 918          
 919          $name = $dir_pref . $FN; # $File::Find::name
 920          $_ = ($no_chdir ? $name : $FN); # $_
 921          { $wanted_callback->() }; # protect against wild "next"
 922          }
 923  
 924      }
 925      else {
 926          # This dir has subdirectories.
 927          $subcount = $nlink - 2;
 928  
 929          # HACK: insert directories at this position. so as to preserve
 930          # the user pre-processed ordering of files.
 931          # EG: directory traversal is in user sorted order, not at random.
 932              my $stack_top = @Stack;
 933  
 934          for my $FN (@filenames) {
 935          next if $FN =~ $File::Find::skip_pattern;
 936          if ($subcount > 0 || $no_nlink) {
 937              # Seen all the subdirs?
 938              # check for directoriness.
 939              # stat is faster for a file in the current directory
 940              $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
 941  
 942              if (-d _) {
 943              --$subcount;
 944              $FN =~ s/\.dir\z//i if $Is_VMS;
 945              # HACK: replace push to preserve dir traversal order
 946              #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
 947              splice @Stack, $stack_top, 0,
 948                       [$CdLvl,$dir_name,$FN,$sub_nlink];
 949              }
 950              else {
 951              $name = $dir_pref . $FN; # $File::Find::name
 952              $_= ($no_chdir ? $name : $FN); # $_
 953              { $wanted_callback->() }; # protect against wild "next"
 954              }
 955          }
 956          else {
 957              $name = $dir_pref . $FN; # $File::Find::name
 958              $_= ($no_chdir ? $name : $FN); # $_
 959              { $wanted_callback->() }; # protect against wild "next"
 960          }
 961          }
 962      }
 963      }
 964      continue {
 965      while ( defined ($SE = pop @Stack) ) {
 966          ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
 967          if ($CdLvl > $Level && !$no_chdir) {
 968          my $tmp;
 969          if ($Is_MacOS) {
 970              $tmp = (':' x ($CdLvl-$Level)) . ':';
 971          }
 972          elsif ($Is_VMS) {
 973              $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
 974          }
 975          else {
 976              $tmp = join('/',('..') x ($CdLvl-$Level));
 977          }
 978          die "Can't cd to $tmp from $dir_name"
 979              unless chdir ($tmp);
 980          $CdLvl = $Level;
 981          }
 982  
 983          if ($Is_MacOS) {
 984          # $pdir always has a trailing ':', except for the starting dir,
 985          # where $dir_rel eq ':'
 986          $dir_name = "$p_dir$dir_rel";
 987          $dir_pref = "$dir_name:";
 988          }
 989          elsif ($^O eq 'MSWin32') {
 990          $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
 991          $dir_pref = "$dir_name/";
 992          }
 993          elsif ($^O eq 'VMS') {
 994                  if ($p_dir =~ m/[\]>]+$/) {
 995                      $dir_name = $p_dir;
 996                      $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
 997                      $dir_pref = $dir_name;
 998                  }
 999                  else {
1000                      $dir_name = "$p_dir/$dir_rel";
1001                      $dir_pref = "$dir_name/";
1002                  }
1003          }
1004          else {
1005          $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1006          $dir_pref = "$dir_name/";
1007          }
1008  
1009          if ( $nlink == -2 ) {
1010          $name = $dir = $p_dir; # $File::Find::name / dir
1011                  $_ = $File::Find::current_dir;
1012          $post_process->();        # End-of-directory processing
1013          }
1014          elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
1015          $name = $dir_name;
1016          if ($Is_MacOS) {
1017              if ($dir_rel eq ':') { # must be the top dir, where we started
1018              $name =~ s|:$||; # $File::Find::name
1019              $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1020              }
1021              $dir = $p_dir; # $File::Find::dir
1022              $_ = ($no_chdir ? $name : $dir_rel); # $_
1023          }
1024          else {
1025              if ( substr($name,-2) eq '/.' ) {
1026              substr($name, length($name) == 2 ? -1 : -2) = '';
1027              }
1028              $dir = $p_dir;
1029              $_ = ($no_chdir ? $dir_name : $dir_rel );
1030              if ( substr($_,-2) eq '/.' ) {
1031              substr($_, length($_) == 2 ? -1 : -2) = '';
1032              }
1033          }
1034          { $wanted_callback->() }; # protect against wild "next"
1035           }
1036           else {
1037          push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
1038          last;
1039          }
1040      }
1041      }
1042  }
1043  
1044  
1045  # API:
1046  #  $wanted
1047  #  $dir_loc : absolute location of a dir
1048  #  $p_dir   : "parent directory"
1049  # preconditions:
1050  #  chdir (if not no_chdir) to dir
1051  
1052  sub _find_dir_symlnk($$$) {
1053      my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1054      my @Stack;
1055      my @filenames;
1056      my $new_loc;
1057      my $updir_loc = $dir_loc; # untainted parent directory
1058      my $SE = [];
1059      my $dir_name = $p_dir;
1060      my $dir_pref;
1061      my $loc_pref;
1062      my $dir_rel = $File::Find::current_dir;
1063      my $byd_flag; # flag for pending stack entry if $bydepth
1064      my $tainted = 0;
1065      my $ok = 1;
1066  
1067      if ($Is_MacOS) {
1068      $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1069      $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1070      } else {
1071      $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
1072      $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1073      }
1074  
1075      local ($dir, $name, $fullname, $prune, *DIR);
1076  
1077      unless ($no_chdir) {
1078      # untaint the topdir
1079      if (( $untaint ) && (is_tainted($dir_loc) )) {
1080          ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1081           # once untainted, $updir_loc is pushed on the stack (as parent directory);
1082          # hence, we don't need to untaint the parent directory every time we chdir
1083          # to it later
1084          unless (defined $updir_loc) {
1085          if ($untaint_skip == 0) {
1086              die "directory $dir_loc is still tainted";
1087          }
1088          else {
1089              return;
1090          }
1091          }
1092      }
1093      $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1094      unless ($ok) {
1095          warnings::warnif "Can't cd to $updir_loc: $!\n";
1096          return;
1097      }
1098      }
1099  
1100      push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
1101  
1102      if ($Is_MacOS) {
1103      $p_dir = $dir_pref; # ensure trailing ':'
1104      }
1105  
1106      while (defined $SE) {
1107  
1108      unless ($bydepth) {
1109          # change (back) to parent directory (always untainted)
1110          unless ($no_chdir) {
1111          unless (chdir $updir_loc) {
1112              warnings::warnif "Can't cd to $updir_loc: $!\n";
1113              next;
1114          }
1115          }
1116          $dir= $p_dir; # $File::Find::dir
1117          $name= $dir_name; # $File::Find::name
1118          $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1119          $fullname= $dir_loc; # $File::Find::fullname
1120          # prune may happen here
1121          $prune= 0;
1122          lstat($_); # make sure  file tests with '_' work
1123          { $wanted_callback->() }; # protect against wild "next"
1124          next if $prune;
1125      }
1126  
1127      # change to that directory
1128      unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1129          $updir_loc = $dir_loc;
1130          if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1131          # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1132          ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1133          unless (defined $updir_loc) {
1134              if ($untaint_skip == 0) {
1135              die "directory $dir_loc is still tainted";
1136              }
1137              else {
1138              next;
1139              }
1140          }
1141          }
1142          unless (chdir $updir_loc) {
1143          warnings::warnif "Can't cd to $updir_loc: $!\n";
1144          next;
1145          }
1146      }
1147  
1148      if ($Is_MacOS) {
1149          $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1150      }
1151  
1152      $dir = $dir_name; # $File::Find::dir
1153  
1154      # Get the list of files in the current directory.
1155      unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1156          warnings::warnif "Can't opendir($dir_loc): $!\n";
1157          next;
1158      }
1159      @filenames = readdir DIR;
1160      closedir(DIR);
1161  
1162      for my $FN (@filenames) {
1163          if ($Is_VMS) {
1164          # Big hammer here - Compensate for VMS trailing . and .dir
1165          # No win situation until this is changed, but this
1166          # will handle the majority of the cases with breaking the fewest.
1167  
1168          $FN =~ s/\.dir\z//i;
1169          $FN =~ s#\.$## if ($FN ne '.');
1170          }
1171          next if $FN =~ $File::Find::skip_pattern;
1172  
1173          # follow symbolic links / do an lstat
1174          $new_loc = Follow_SymLink($loc_pref.$FN);
1175  
1176          # ignore if invalid symlink
1177          unless (defined $new_loc) {
1178              if (!defined -l _ && $dangling_symlinks) {
1179                  if (ref $dangling_symlinks eq 'CODE') {
1180                      $dangling_symlinks->($FN, $dir_pref);
1181                  } else {
1182                      warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1183                  }
1184              }
1185  
1186              $fullname = undef;
1187              $name = $dir_pref . $FN;
1188              $_ = ($no_chdir ? $name : $FN);
1189              { $wanted_callback->() };
1190              next;
1191          }
1192  
1193          if (-d _) {
1194          if ($Is_VMS) {
1195              $FN =~ s/\.dir\z//i;
1196              $FN =~ s#\.$## if ($FN ne '.');
1197              $new_loc =~ s/\.dir\z//i;
1198              $new_loc =~ s#\.$## if ($new_loc ne '.');
1199          }
1200          push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1201          }
1202          else {
1203          $fullname = $new_loc; # $File::Find::fullname
1204          $name = $dir_pref . $FN; # $File::Find::name
1205          $_ = ($no_chdir ? $name : $FN); # $_
1206          { $wanted_callback->() }; # protect against wild "next"
1207          }
1208      }
1209  
1210      }
1211      continue {
1212      while (defined($SE = pop @Stack)) {
1213          ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1214          if ($Is_MacOS) {
1215          # $p_dir always has a trailing ':', except for the starting dir,
1216          # where $dir_rel eq ':'
1217          $dir_name = "$p_dir$dir_rel";
1218          $dir_pref = "$dir_name:";
1219          $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1220          }
1221          else {
1222          $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1223          $dir_pref = "$dir_name/";
1224          $loc_pref = "$dir_loc/";
1225          }
1226          if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
1227          unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1228              unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1229              warnings::warnif "Can't cd to $updir_loc: $!\n";
1230              next;
1231              }
1232          }
1233          $fullname = $dir_loc; # $File::Find::fullname
1234          $name = $dir_name; # $File::Find::name
1235          if ($Is_MacOS) {
1236              if ($dir_rel eq ':') { # must be the top dir, where we started
1237              $name =~ s|:$||; # $File::Find::name
1238              $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1239              }
1240              $dir = $p_dir; # $File::Find::dir
1241               $_ = ($no_chdir ? $name : $dir_rel); # $_
1242          }
1243          else {
1244              if ( substr($name,-2) eq '/.' ) {
1245              substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1246              }
1247              $dir = $p_dir; # $File::Find::dir
1248              $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1249              if ( substr($_,-2) eq '/.' ) {
1250              substr($_, length($_) == 2 ? -1 : -2) = '';
1251              }
1252          }
1253  
1254          lstat($_); # make sure file tests with '_' work
1255          { $wanted_callback->() }; # protect against wild "next"
1256          }
1257          else {
1258          push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
1259          last;
1260          }
1261      }
1262      }
1263  }
1264  
1265  
1266  sub wrap_wanted {
1267      my $wanted = shift;
1268      if ( ref($wanted) eq 'HASH' ) {
1269      if ( $wanted->{follow} || $wanted->{follow_fast}) {
1270          $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1271      }
1272      if ( $wanted->{untaint} ) {
1273          $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1274          unless defined $wanted->{untaint_pattern};
1275          $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1276      }
1277      return $wanted;
1278      }
1279      else {
1280      return { wanted => $wanted };
1281      }
1282  }
1283  
1284  sub find {
1285      my $wanted = shift;
1286      _find_opt(wrap_wanted($wanted), @_);
1287  }
1288  
1289  sub finddepth {
1290      my $wanted = wrap_wanted(shift);
1291      $wanted->{bydepth} = 1;
1292      _find_opt($wanted, @_);
1293  }
1294  
1295  # default
1296  $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
1297  $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1298  
1299  # These are hard-coded for now, but may move to hint files.
1300  if ($^O eq 'VMS') {
1301      $Is_VMS = 1;
1302      $File::Find::dont_use_nlink  = 1;
1303  }
1304  elsif ($^O eq 'MacOS') {
1305      $Is_MacOS = 1;
1306      $File::Find::dont_use_nlink  = 1;
1307      $File::Find::skip_pattern    = qr/^Icon\015\z/;
1308      $File::Find::untaint_pattern = qr|^(.+)$|;
1309  }
1310  
1311  # this _should_ work properly on all platforms
1312  # where File::Find can be expected to work
1313  $File::Find::current_dir = File::Spec->curdir || '.';
1314  
1315  $File::Find::dont_use_nlink = 1
1316      if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1317         $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1318         $^O eq 'nto';
1319  
1320  # Set dont_use_nlink in your hint file if your system's stat doesn't
1321  # report the number of links in a directory as an indication
1322  # of the number of files.
1323  # See, e.g. hints/machten.sh for MachTen 2.2.
1324  unless ($File::Find::dont_use_nlink) {
1325      require Config;
1326      $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1327  }
1328  
1329  # We need a function that checks if a scalar is tainted. Either use the
1330  # Scalar::Util module's tainted() function or our (slower) pure Perl
1331  # fallback is_tainted_pp()
1332  {
1333      local $@;
1334      eval { require Scalar::Util };
1335      *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1336  }
1337  
1338  1;


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1