diff options
| -rw-r--r-- | lib/DirHandle.pm | 16 | ||||
| -rw-r--r-- | lib/File/Copy.pm | 33 | ||||
| -rw-r--r-- | lib/File/DosGlob.pm | 224 | ||||
| -rw-r--r-- | lib/File/Find.pm | 124 |
4 files changed, 4 insertions, 393 deletions
diff --git a/lib/DirHandle.pm b/lib/DirHandle.pm index fc27dfb1e6..7493c00a54 100644 --- a/lib/DirHandle.pm +++ b/lib/DirHandle.pm @@ -1,6 +1,6 @@ package DirHandle; -our $VERSION = '1.03'; +our $VERSION = '1.04'; =head1 NAME @@ -25,20 +25,6 @@ opendir(), closedir(), readdir(), and rewinddir() functions. The only objective benefit to using C<DirHandle> is that it avoids namespace pollution by creating globs to hold directory handles. -=head1 NOTES - -=over 4 - -=item * - -On Mac OS (Classic), 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. - -=back - =cut require 5.000; diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 0f17e2b9ac..1cf084bb91 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -22,7 +22,7 @@ sub syscopy; sub cp; sub mv; -$VERSION = '2.20'; +$VERSION = '2.21'; require Exporter; @ISA = qw(Exporter); @@ -529,9 +529,6 @@ VMS systems, this calls the C<rmscopy> routine (see below). For OS/2 systems, this calls the C<syscopy> XSUB directly. For Win32 systems, this calls C<Win32::CopyFile>. -On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>, -if available. - B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>: If both arguments to C<copy> are not file handles, @@ -590,34 +587,6 @@ it sets C<$!>, deletes the output file, and returns 0. All functions return 1 on success, 0 on failure. $! will be set if an error was encountered. -=head1 NOTES - -=over 4 - -=item * - -On Mac OS (Classic), 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. - -E.g. - - copy("file1", "tmp"); # creates the file 'tmp' in the current directory - copy("file1", ":tmp:"); # creates :tmp:file1 - copy("file1", ":tmp"); # same as above - copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but don't do - # that, since it may cause confusion, see example #1) - copy("file1", "tmp:file1"); # error, since 'tmp:' is not a volume - copy("file1", ":tmp:file1"); # ok, partial path - copy("file1", "DataHD:"); # creates DataHD:file1 - - move("MacintoshHD:fileA", "DataHD:fileB"); # moves (doesn't copy) files from one - # volume to another - -=back - =head1 AUTHOR File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995, diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm index 29d2efc797..90434fd467 100644 --- a/lib/File/DosGlob.pm +++ b/lib/File/DosGlob.pm @@ -9,7 +9,7 @@ package File::DosGlob; -our $VERSION = '1.03'; +our $VERSION = '1.04'; use strict; use warnings; @@ -99,173 +99,6 @@ sub doglob { return @retval; } - -# -# Do DOS-like globbing on Mac OS -# -sub doglob_Mac { - my $cond = shift; - my @retval = (); - - #print "doglob_Mac: ", join('|', @_), "\n"; - OUTER: - for my $arg (@_) { - local $_ = $arg; - my @matched = (); - my @globdirs = (); - my $head = ':'; - my $not_esc_head = $head; - my $sepchr = ':'; - next OUTER unless defined $_ and $_ ne ''; - # if arg is within quotes strip em and do no globbing - if (/^"(.*)"\z/s) { - $_ = $1; - # $_ may contain escaped metachars '\*', '\?' and '\' - my $not_esc_arg = $_; - $not_esc_arg =~ s/\\([*?\\])/$1/g; - if ($cond eq 'd') { push(@retval, $not_esc_arg) if -d $not_esc_arg } - else { push(@retval, $not_esc_arg) if -e $not_esc_arg } - next OUTER; - } - - if (m|^(.*?)(:+)([^:]*)\z|s) { # note: $1 is not greedy - my $tail; - ($head, $sepchr, $tail) = ($1,$2,$3); - #print "div: |$head|$sepchr|$tail|\n"; - push (@retval, $_), next OUTER if $tail eq ''; - # - # $head may contain escaped metachars '\*' and '\?' - - my $tmp_head = $head; - # if a '*' or '?' is preceded by an odd count of '\', temporary delete - # it (and its preceding backslashes), i.e. don't treat '\*' and '\?' as - # wildcards - $tmp_head =~ s/(\\*)([*?])/$2 x ((length($1) + 1) % 2)/eg; - - if ($tmp_head =~ /[*?]/) { # if there are wildcards ... - @globdirs = doglob_Mac('d', $head); - push(@retval, doglob_Mac($cond, map {"$_$sepchr$tail"} @globdirs)), - next OUTER if @globdirs; - } - - $head .= $sepchr; - $not_esc_head = $head; - # unescape $head for file operations - $not_esc_head =~ s/\\([*?\\])/$1/g; - $_ = $tail; - } - # - # If file component has no wildcards, we can avoid opendir - - my $tmp_tail = $_; - # if a '*' or '?' is preceded by an odd count of '\', temporary delete - # it (and its preceding backslashes), i.e. don't treat '\*' and '\?' as - # wildcards - $tmp_tail =~ s/(\\*)([*?])/$2 x ((length($1) + 1) % 2)/eg; - - unless ($tmp_tail =~ /[*?]/) { # if there are wildcards ... - $not_esc_head = $head = '' if $head eq ':'; - my $not_esc_tail = $_; - # unescape $head and $tail for file operations - $not_esc_tail =~ s/\\([*?\\])/$1/g; - $head .= $_; - $not_esc_head .= $not_esc_tail; - if ($cond eq 'd') { push(@retval,$head) if -d $not_esc_head } - else { push(@retval,$head) if -e $not_esc_head } - next OUTER; - } - #print "opendir($not_esc_head)\n"; - opendir(D, $not_esc_head) or next OUTER; - my @leaves = readdir D; - closedir D; - - # escape regex metachars but not '\' and glob chars '*', '?' - $_ =~ s:([].+^\-\${}[|]):\\$1:g; - # and convert DOS-style wildcards to regex, - # but only if they are not escaped - $_ =~ s/(\\*)([*?])/$1 . ('.' x ((length($1) + 1) % 2)) . $2/eg; - - #print "regex: '$_', head: '$head', unescaped head: '$not_esc_head'\n"; - my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '\\z|ios }'; - warn($@), next OUTER if $@; - INNER: - for my $e (@leaves) { - next INNER if $e eq '.' or $e eq '..'; - next INNER if $cond eq 'd' and ! -d "$not_esc_head$e"; - - if (&$matchsub($e)) { - my $leave = (($not_esc_head eq ':') && (-f "$not_esc_head$e")) ? - "$e" : "$not_esc_head$e"; - # - # On Mac OS, the two glob metachars '*' and '?' and the escape - # char '\' are valid characters for file and directory names. - # We have to escape and treat them specially. - $leave =~ s|([*?\\])|\\$1|g; - push(@matched, $leave); - next INNER; - } - } - push @retval, @matched if @matched; - } - return @retval; -} - -# -# _expand_volume() will only be used on Mac OS (Classic): -# Takes an array of original patterns as argument and returns an array of -# possibly modified patterns. Each original pattern is processed like -# that: -# + If there's a volume name in the pattern, we push a separate pattern -# for each mounted volume that matches (with '*', '?' and '\' escaped). -# + If there's no volume name in the original pattern, it is pushed -# unchanged. -# Note that the returned array of patterns may be empty. -# -sub _expand_volume { - - require MacPerl; # to be verbose - - my @pat = @_; - my @new_pat = (); - my @FSSpec_Vols = MacPerl::Volumes(); - my @mounted_volumes = (); - - foreach my $spec_vol (@FSSpec_Vols) { - # push all mounted volumes into array - push @mounted_volumes, MacPerl::MakePath($spec_vol); - } - #print "mounted volumes: |@mounted_volumes|\n"; - - while (@pat) { - my $pat = shift @pat; - if ($pat =~ /^([^:]+:)(.*)\z/) { # match a volume name? - my $vol_pat = $1; - my $tail = $2; - # - # escape regex metachars but not '\' and glob chars '*', '?' - $vol_pat =~ s:([].+^\-\${}[|]):\\$1:g; - # and convert DOS-style wildcards to regex, - # but only if they are not escaped - $vol_pat =~ s/(\\*)([*?])/$1 . ('.' x ((length($1) + 1) % 2)) . $2/eg; - #print "volume regex: '$vol_pat' \n"; - - foreach my $volume (@mounted_volumes) { - if ($volume =~ m|^$vol_pat\z|ios) { - # - # On Mac OS, the two glob metachars '*' and '?' and the - # escape char '\' are valid characters for volume names. - # We have to escape and treat them specially. - $volume =~ s|([*?\\])|\\$1|g; - push @new_pat, $volume . $tail; - } - } - } else { # no volume name in pattern, push original pattern - push @new_pat, $pat; - } - } - return @new_pat; -} - # # this can be used to override CORE::glob in a specific # package by saying C<use File::DosGlob 'glob';> in that @@ -425,61 +258,6 @@ of the quoting rules used. Extending it to csh patterns is left as an exercise to the reader. -=head1 NOTES - -=over 4 - -=item * - -Mac OS (Classic) users should note a few differences. The specification -of pathnames in glob patterns adheres to the usual Mac OS conventions: -The path separator is a colon ':', not a slash '/' or backslash '\'. A -full path always begins with a volume name. A relative pathname on Mac -OS must always begin with a ':', except when specifying a file or -directory name in the current working directory, where the leading colon -is optional. If specifying a volume name only, a trailing ':' is -required. Due to these rules, a glob like E<lt>*:E<gt> will find all -mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find -all files and directories in the current directory. - -Note that updirs in the glob pattern are resolved before the matching begins, -i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also, -that a single trailing ':' in the pattern is ignored (unless it's a volume -name pattern like "*HD:"), i.e. a glob like <:*:> will find both directories -I<and> files (and not, as one might expect, only directories). - -The metachars '*', '?' and the escape char '\' are valid characters in -volume, directory and file names on Mac OS. Hence, if you want to match -a '*', '?' or '\' literally, you have to escape these characters. Due to -perl's quoting rules, things may get a bit complicated, when you want to -match a string like '\*' literally, or when you want to match '\' literally, -but treat the immediately following character '*' as metachar. So, here's a -rule of thumb (applies to both single- and double-quoted strings): escape -each '*' or '?' or '\' with a backslash, if you want to treat them literally, -and then double each backslash and your are done. E.g. - -- Match '\*' literally - - escape both '\' and '*' : '\\\*' - double the backslashes : '\\\\\\*' - -(Internally, the glob routine sees a '\\\*', which means that both '\' and -'*' are escaped.) - - -- Match '\' literally, treat '*' as metachar - - escape '\' but not '*' : '\\*' - double the backslashes : '\\\\*' - -(Internally, the glob routine sees a '\\*', which means that '\' is escaped and -'*' is not.) - -Note that you also have to quote literal spaces in the glob pattern, as described -above. - -=back - =head1 EXPORTS (by request only) glob() diff --git a/lib/File/Find.pm b/lib/File/Find.pm index 2b00bf0e25..cdcf97e0a7 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; use warnings::register; -our $VERSION = '1.18'; +our $VERSION = '1.19'; require Exporter; require Cwd; @@ -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 @@ -454,53 +379,6 @@ 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; |