summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/File/Find.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/File/Find.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/File/Find.pm350
1 files changed, 60 insertions, 290 deletions
diff --git a/Master/tlpkg/tlperl/lib/File/Find.pm b/Master/tlpkg/tlperl/lib/File/Find.pm
index e72f3e32b30..cdcf97e0a79 100644
--- a/Master/tlpkg/tlperl/lib/File/Find.pm
+++ b/Master/tlpkg/tlperl/lib/File/Find.pm
@@ -3,12 +3,12 @@ use 5.006;
use strict;
use warnings;
use warnings::register;
-our $VERSION = '1.15';
+our $VERSION = '1.19';
require Exporter;
require Cwd;
#
-# Modified to ensure sub-directory traversal order is not inverded by stack
+# Modified to ensure sub-directory traversal order is not inverted by stack
# push and pops. That is remains in the same order as in the directory file,
# or user pre-processing (EG:sorted).
#
@@ -324,81 +324,6 @@ in an unknown directory.
=back
-=head1 NOTES
-
-=over 4
-
-=item *
-
-Mac OS (Classic) users should note a few differences:
-
-=over 4
-
-=item *
-
-The path separator is ':', not '/', and the current directory is denoted
-as ':', not '.'. You should be careful about specifying relative pathnames.
-While a full path always begins with a volume name, a relative pathname
-should always begin with a ':'. If specifying a volume name only, a
-trailing ':' is required.
-
-=item *
-
-C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
-contains the name of a directory, that name may or may not end with a
-':'. Likewise, C<$File::Find::name>, which contains the complete
-pathname to that directory, and C<$File::Find::fullname>, which holds
-the absolute pathname of that directory with all symbolic links resolved,
-may or may not end with a ':'.
-
-=item *
-
-The default C<untaint_pattern> (see above) on Mac OS is set to
-C<qr|^(.+)$|>. Note that the parentheses are vital.
-
-=item *
-
-The invisible system file "Icon\015" is ignored. While this file may
-appear in every directory, there are some more invisible system files
-on every volume, which are all located at the volume root level (i.e.
-"MacintoshHD:"). These system files are B<not> excluded automatically.
-Your filter may use the following code to recognize invisible files or
-directories (requires Mac::Files):
-
- use Mac::Files;
-
- # invisible() -- returns 1 if file/directory is invisible,
- # 0 if it's visible or undef if an error occurred
-
- sub invisible($) {
- my $file = shift;
- my ($fileCat, $fileInfo);
- my $invisible_flag = 1 << 14;
-
- if ( $fileCat = FSpGetCatInfo($file) ) {
- if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
- return (($fileInfo->fdFlags & $invisible_flag) && 1);
- }
- }
- return undef;
- }
-
-Generally, invisible files are system files, unless an odd application
-decides to use invisible files for its own purposes. To distinguish
-such files from system files, you have to look at the B<type> and B<creator>
-file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
-C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
-(see MacPerl.pm for details).
-
-Files that appear on the desktop actually reside in an (hidden) directory
-named "Desktop Folder" on the particular disk volume. Note that, although
-all desktop files appear to be on the same "virtual" desktop, each disk
-volume actually maintains its own "Desktop Folder" directory.
-
-=back
-
-=back
-
=head1 BUGS AND CAVEATS
Despite the name of the C<finddepth()> function, both C<find()> and
@@ -423,7 +348,7 @@ our @EXPORT = qw(find finddepth);
use strict;
my $Is_VMS;
-my $Is_MacOS;
+my $Is_Win32;
require File::Basename;
require File::Spec;
@@ -454,83 +379,24 @@ sub contract_name {
return $abs_name;
}
-# return the absolute name of a directory or file
-sub contract_name_Mac {
- my ($cdir,$fn) = @_;
- my $abs_name;
-
- if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
-
- my $colon_count = length ($1);
- if ($colon_count == 1) {
- $abs_name = $cdir . $2;
- return $abs_name;
- }
- else {
- # need to move up the tree, but
- # only if it's not a volume name
- for (my $i=1; $i<$colon_count; $i++) {
- unless ($cdir =~ /^[^:]+:$/) { # volume name
- $cdir =~ s/[^:]+:$//;
- }
- else {
- return undef;
- }
- }
- $abs_name = $cdir . $2;
- return $abs_name;
- }
-
- }
- else {
-
- # $fn may be a valid path to a directory or file or (dangling)
- # symlink, without a leading ':'
- if ( (-e $fn) || (-l $fn) ) {
- if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
- return $fn; # $fn is already an absolute path
- }
- else {
- $abs_name = $cdir . $fn;
- return $abs_name;
- }
- }
- else { # argh!, $fn is not a valid directory/file
- return undef;
- }
- }
-}
-
sub PathCombine($$) {
my ($Base,$Name) = @_;
my $AbsName;
- if ($Is_MacOS) {
- # $Name is the resolved symlink (always a full path on MacOS),
- # i.e. there's no need to call contract_name_Mac()
- $AbsName = $Name;
-
- # (simple) check for recursion
- if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
- return undef;
- }
+ if (substr($Name,0,1) eq '/') {
+ $AbsName= $Name;
}
else {
- if (substr($Name,0,1) eq '/') {
- $AbsName= $Name;
- }
- else {
- $AbsName= contract_name($Base,$Name);
- }
+ $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;
- }
+ # (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;
@@ -629,8 +495,8 @@ sub _find_opt {
$pre_process = $wanted->{preprocess};
$post_process = $wanted->{postprocess};
$no_chdir = $wanted->{no_chdir};
- $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
- $follow = $^O eq 'MSWin32' ? 0 :
+ $full_check = $Is_Win32 ? 0 : $wanted->{follow};
+ $follow = $Is_Win32 ? 0 :
$full_check || $wanted->{follow_fast};
$follow_skip = $wanted->{follow_skip};
$untaint = $wanted->{untaint};
@@ -652,11 +518,9 @@ sub _find_opt {
($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
- if ($Is_MacOS) {
- $top_item = ":$top_item"
- if ( (-d _) && ( $top_item !~ /:/ ) );
- } elsif ($^O eq 'MSWin32') {
- $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
+ if ($Is_Win32) {
+ $top_item =~ s|[/\\]\z||
+ unless $top_item =~ m{^(?:\w:)?[/\\]$};
}
else {
$top_item =~ s|/\z|| unless $top_item eq '/';
@@ -666,32 +530,15 @@ sub _find_opt {
if ($follow) {
- if ($Is_MacOS) {
- $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
-
- if ($top_item eq $File::Find::current_dir) {
- $abs_dir = $cwd;
- }
- else {
- $abs_dir = contract_name_Mac($cwd, $top_item);
- unless (defined $abs_dir) {
- warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
- next Proc_Top_Item;
- }
- }
-
+ if (substr($top_item,0,1) eq '/') {
+ $abs_dir = $top_item;
}
- else {
- if (substr($top_item,0,1) eq '/') {
- $abs_dir = $top_item;
- }
- elsif ($top_item eq $File::Find::current_dir) {
- $abs_dir = $cwd;
- }
- else { # care about any ../
- $top_item =~ s/\.dir\z//i if $Is_VMS;
- $abs_dir = contract_name("$cwd/",$top_item);
- }
+ elsif ($top_item eq $File::Find::current_dir) {
+ $abs_dir = $cwd;
+ }
+ else { # care about any ../
+ $top_item =~ s/\.dir\z//i if $Is_VMS;
+ $abs_dir = contract_name("$cwd/",$top_item);
}
$abs_dir= Follow_SymLink($abs_dir);
unless (defined $abs_dir) {
@@ -729,12 +576,7 @@ sub _find_opt {
unless ($Is_Dir) {
unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
- if ($Is_MacOS) {
- ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
- }
- else {
- ($dir,$_) = ('./', $top_item);
- }
+ ($dir,$_) = ('./', $top_item);
}
$abs_dir = $dir;
@@ -797,11 +639,10 @@ sub _find_dir($$$) {
my $tainted = 0;
my $no_nlink;
- if ($Is_MacOS) {
- $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
- } elsif ($^O eq 'MSWin32') {
- $dir_pref = ($p_dir =~ m|\w:/?$| ? $p_dir : "$p_dir/" );
- } elsif ($^O eq 'VMS') {
+ if ($Is_Win32) {
+ $dir_pref
+ = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
+ } elsif ($Is_VMS) {
# VMS is returning trailing .dir on directories
# and trailing . on files and symbolic links
@@ -840,10 +681,6 @@ sub _find_dir($$$) {
# push the starting directory
push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
- if ($Is_MacOS) {
- $p_dir = $dir_pref; # ensure trailing ':'
- }
-
while (defined $SE) {
unless ($bydepth) {
$dir= $p_dir; # $File::Find::dir
@@ -862,34 +699,20 @@ sub _find_dir($$$) {
( $udir ) = $dir_rel =~ m|$untaint_pat|;
unless (defined $udir) {
if ($untaint_skip == 0) {
- if ($Is_MacOS) {
- die "directory ($p_dir) $dir_rel is still tainted";
- }
- else {
- die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
- }
+ die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
} else { # $untaint_skip == 1
next;
}
}
}
unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
- if ($Is_MacOS) {
- warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
- }
- else {
- warnings::warnif "Can't cd to (" .
- ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
- }
+ warnings::warnif "Can't cd to (" .
+ ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
next;
}
$CdLvl++;
}
- if ($Is_MacOS) {
- $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
- }
-
$dir= $dir_name; # $File::Find::dir
# Get the list of files in the current directory.
@@ -902,7 +725,7 @@ sub _find_dir($$$) {
@filenames = $pre_process->(@filenames) if $pre_process;
push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
- # default: use whatever was specifid
+ # default: use whatever was specified
# (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
@@ -971,10 +794,7 @@ sub _find_dir($$$) {
($Level, $p_dir, $dir_rel, $nlink) = @$SE;
if ($CdLvl > $Level && !$no_chdir) {
my $tmp;
- if ($Is_MacOS) {
- $tmp = (':' x ($CdLvl-$Level)) . ':';
- }
- elsif ($Is_VMS) {
+ if ($Is_VMS) {
$tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
}
else {
@@ -985,14 +805,9 @@ sub _find_dir($$$) {
$CdLvl = $Level;
}
- if ($Is_MacOS) {
- # $pdir always has a trailing ':', except for the starting dir,
- # where $dir_rel eq ':'
- $dir_name = "$p_dir$dir_rel";
- $dir_pref = "$dir_name:";
- }
- elsif ($^O eq 'MSWin32') {
- $dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
+ if ($Is_Win32) {
+ $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
+ ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
$dir_pref = "$dir_name/";
}
elsif ($^O eq 'VMS') {
@@ -1018,23 +833,13 @@ sub _find_dir($$$) {
}
elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
$name = $dir_name;
- if ($Is_MacOS) {
- if ($dir_rel eq ':') { # must be the top dir, where we started
- $name =~ s|:$||; # $File::Find::name
- $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
- }
- $dir = $p_dir; # $File::Find::dir
- $_ = ($no_chdir ? $name : $dir_rel); # $_
+ if ( substr($name,-2) eq '/.' ) {
+ substr($name, length($name) == 2 ? -1 : -2) = '';
}
- else {
- if ( substr($name,-2) eq '/.' ) {
- substr($name, length($name) == 2 ? -1 : -2) = '';
- }
- $dir = $p_dir;
- $_ = ($no_chdir ? $dir_name : $dir_rel );
- if ( substr($_,-2) eq '/.' ) {
- substr($_, length($_) == 2 ? -1 : -2) = '';
- }
+ $dir = $p_dir;
+ $_ = ($no_chdir ? $dir_name : $dir_rel );
+ if ( substr($_,-2) eq '/.' ) {
+ substr($_, length($_) == 2 ? -1 : -2) = '';
}
{ $wanted_callback->() }; # protect against wild "next"
}
@@ -1069,13 +874,8 @@ sub _find_dir_symlnk($$$) {
my $tainted = 0;
my $ok = 1;
- if ($Is_MacOS) {
- $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
- $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
- } else {
- $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
- $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
- }
+ $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
+ $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
local ($dir, $name, $fullname, $prune, *DIR);
@@ -1104,10 +904,6 @@ sub _find_dir_symlnk($$$) {
push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
- if ($Is_MacOS) {
- $p_dir = $dir_pref; # ensure trailing ':'
- }
-
while (defined $SE) {
unless ($bydepth) {
@@ -1150,10 +946,6 @@ sub _find_dir_symlnk($$$) {
}
}
- if ($Is_MacOS) {
- $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
- }
-
$dir = $dir_name; # $File::Find::dir
# Get the list of files in the current directory.
@@ -1216,18 +1008,9 @@ sub _find_dir_symlnk($$$) {
continue {
while (defined($SE = pop @Stack)) {
($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
- if ($Is_MacOS) {
- # $p_dir always has a trailing ':', except for the starting dir,
- # where $dir_rel eq ':'
- $dir_name = "$p_dir$dir_rel";
- $dir_pref = "$dir_name:";
- $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
- }
- else {
- $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
- $dir_pref = "$dir_name/";
- $loc_pref = "$dir_loc/";
- }
+ $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
+ $dir_pref = "$dir_name/";
+ $loc_pref = "$dir_loc/";
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
@@ -1237,23 +1020,13 @@ sub _find_dir_symlnk($$$) {
}
$fullname = $dir_loc; # $File::Find::fullname
$name = $dir_name; # $File::Find::name
- if ($Is_MacOS) {
- if ($dir_rel eq ':') { # must be the top dir, where we started
- $name =~ s|:$||; # $File::Find::name
- $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
- }
- $dir = $p_dir; # $File::Find::dir
- $_ = ($no_chdir ? $name : $dir_rel); # $_
+ if ( substr($name,-2) eq '/.' ) {
+ substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
}
- else {
- if ( substr($name,-2) eq '/.' ) {
- 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 '/.' ) {
- substr($_, length($_) == 2 ? -1 : -2) = '';
- }
+ $dir = $p_dir; # $File::Find::dir
+ $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
+ if ( substr($_,-2) eq '/.' ) {
+ substr($_, length($_) == 2 ? -1 : -2) = '';
}
lstat($_); # make sure file tests with '_' work
@@ -1312,11 +1085,8 @@ if ($^O eq 'VMS') {
$Is_VMS = 1;
$File::Find::dont_use_nlink = 1;
}
-elsif ($^O eq 'MacOS') {
- $Is_MacOS = 1;
- $File::Find::dont_use_nlink = 1;
- $File::Find::skip_pattern = qr/^Icon\015\z/;
- $File::Find::untaint_pattern = qr|^(.+)$|;
+elsif ($^O eq 'MSWin32') {
+ $Is_Win32 = 1;
}
# this _should_ work properly on all platforms
@@ -1324,7 +1094,7 @@ elsif ($^O eq 'MacOS') {
$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' ||
+ if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
$^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
$^O eq 'nto';
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 01:25:15 +0000