sub cp;
sub mv;
-$VERSION = '2.20';
+$VERSION = '2.21';
require Exporter;
@ISA = qw(Exporter);
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,
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,
package File::DosGlob;
-our $VERSION = '1.03';
+our $VERSION = '1.04';
use strict;
use warnings;
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
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()
use strict;
use warnings;
use warnings::register;
-our $VERSION = '1.18';
+our $VERSION = '1.19';
require Exporter;
require Cwd;
=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
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;
projects / platform / upstream / perl.git / commitdiff