diff options
Diffstat (limited to 'contrib/perl5/lib/File')
| -rw-r--r-- | contrib/perl5/lib/File/Basename.pm | 273 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/CheckTree.pm | 151 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Compare.pm | 182 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Copy.pm | 353 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/DosGlob.pm | 254 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Find.pm | 735 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Path.pm | 238 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Spec.pm | 92 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Spec/Functions.pm | 95 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Spec/Mac.pm | 397 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Spec/OS2.pm | 59 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Spec/Unix.pm | 442 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Spec/VMS.pm | 492 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/Spec/Win32.pm | 405 | ||||
| -rw-r--r-- | contrib/perl5/lib/File/stat.pm | 115 |
15 files changed, 0 insertions, 4283 deletions
diff --git a/contrib/perl5/lib/File/Basename.pm b/contrib/perl5/lib/File/Basename.pm deleted file mode 100644 index 4581e7e93c26c..0000000000000 --- a/contrib/perl5/lib/File/Basename.pm +++ /dev/null @@ -1,273 +0,0 @@ -package File::Basename; - -=head1 NAME - -fileparse - split a pathname into pieces - -basename - extract just the filename from a path - -dirname - extract just the directory from a path - -=head1 SYNOPSIS - - use File::Basename; - - ($name,$path,$suffix) = fileparse($fullname,@suffixlist) - fileparse_set_fstype($os_string); - $basename = basename($fullname,@suffixlist); - $dirname = dirname($fullname); - - ($name,$path,$suffix) = fileparse("lib/File/Basename.pm","\.pm"); - fileparse_set_fstype("VMS"); - $basename = basename("lib/File/Basename.pm",".pm"); - $dirname = dirname("lib/File/Basename.pm"); - -=head1 DESCRIPTION - -These routines allow you to parse file specifications into useful -pieces using the syntax of different operating systems. - -=over 4 - -=item fileparse_set_fstype - -You select the syntax via the routine fileparse_set_fstype(). - -If the argument passed to it contains one of the substrings -"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification -syntax of that operating system is used in future calls to -fileparse(), basename(), and dirname(). If it contains none of -these substrings, Unix syntax is used. This pattern matching is -case-insensitive. If you've selected VMS syntax, and the file -specification you pass to one of these routines contains a "/", -they assume you are using Unix emulation and apply the Unix syntax -rules instead, for that function call only. - -If the argument passed to it contains one of the substrings "VMS", -"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern -matching for suffix removal is performed without regard for case, -since those systems are not case-sensitive when opening existing files -(though some of them preserve case on file creation). - -If you haven't called fileparse_set_fstype(), the syntax is chosen -by examining the builtin variable C<$^O> according to these rules. - -=item fileparse - -The fileparse() routine divides a file specification into three -parts: a leading B<path>, a file B<name>, and a B<suffix>. The -B<path> contains everything up to and including the last directory -separator in the input file specification. The remainder of the input -file specification is then divided into B<name> and B<suffix> based on -the optional patterns you specify in C<@suffixlist>. Each element of -this list is interpreted as a regular expression, and is matched -against the end of B<name>. If this succeeds, the matching portion of -B<name> is removed and prepended to B<suffix>. By proper use of -C<@suffixlist>, you can remove file types or versions for examination. - -You are guaranteed that if you concatenate B<path>, B<name>, and -B<suffix> together in that order, the result will denote the same -file as the input file specification. - -=back - -=head1 EXAMPLES - -Using Unix file syntax: - - ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7', - '\.book\d+'); - -would yield - - $base eq 'draft' - $path eq '/virgil/aeneid/', - $type eq '.book7' - -Similarly, using VMS syntax: - - ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh', - '\..*'); - -would yield - - $name eq 'Rhetoric' - $dir eq 'Doc_Root:[Help]' - $type eq '.Rnh' - -=over - -=item C<basename> - -The basename() routine returns the first element of the list produced -by calling fileparse() with the same arguments, except that it always -quotes metacharacters in the given suffixes. It is provided for -programmer compatibility with the Unix shell command basename(1). - -=item C<dirname> - -The dirname() routine returns the directory portion of the input file -specification. When using VMS or MacOS syntax, this is identical to the -second element of the list produced by calling fileparse() with the same -input file specification. (Under VMS, if there is no directory information -in the input file specification, then the current default device and -directory are returned.) When using Unix or MSDOS syntax, the return -value conforms to the behavior of the Unix shell command dirname(1). This -is usually the same as the behavior of fileparse(), but differs in some -cases. For example, for the input file specification F<lib/>, fileparse() -considers the directory name to be F<lib/>, while dirname() considers the -directory name to be F<.>). - -=back - -=cut - - -## use strict; -# A bit of juggling to insure that C<use re 'taint';> always works, since -# File::Basename is used during the Perl build, when the re extension may -# not be available. -BEGIN { - unless (eval { require re; }) - { eval ' sub re::import { $^H |= 0x00100000; } ' } - import re 'taint'; -} - - - -use 5.005_64; -our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase); -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(fileparse fileparse_set_fstype basename dirname); -$VERSION = "2.6"; - - -# fileparse_set_fstype() - specify OS-based rules used in future -# calls to routines in this package -# -# Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, os2, RISCOS -# Any other name uses Unix-style rules and is case-sensitive - -sub fileparse_set_fstype { - my @old = ($Fileparse_fstype, $Fileparse_igncase); - if (@_) { - $Fileparse_fstype = $_[0]; - $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i); - } - wantarray ? @old : $old[0]; -} - -# fileparse() - parse file specification -# -# Version 2.4 27-Sep-1996 Charles Bailey bailey@genetics.upenn.edu - - -sub fileparse { - my($fullname,@suffices) = @_; - my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase); - my($dirpath,$tail,$suffix,$basename); - my($taint) = substr($fullname,0,0); # Is $fullname tainted? - - if ($fstype =~ /^VMS/i) { - if ($fullname =~ m#/#) { $fstype = '' } # We're doing Unix emulation - else { - ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s); - $dirpath ||= ''; # should always be defined - } - } - if ($fstype =~ /^MS(DOS|Win32)/i) { - ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s); - $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/; - } - elsif ($fstype =~ /^MacOS/si) { - ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s); - } - elsif ($fstype =~ /^AmigaOS/i) { - ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s); - $dirpath = './' unless $dirpath; - } - elsif ($fstype !~ /^VMS/i) { # default to Unix - ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s); - if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) { - # dev:[000000] is top of VMS tree, similar to Unix '/' - ($basename,$dirpath) = ('',$fullname); - } - $dirpath = './' unless $dirpath; - } - - if (@suffices) { - $tail = ''; - foreach $suffix (@suffices) { - my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$"; - if ($basename =~ s/$pat//s) { - $taint .= substr($suffix,0,0); - $tail = $1 . $tail; - } - } - } - - $tail .= $taint if defined $tail; # avoid warning if $tail == undef - wantarray ? ($basename . $taint, $dirpath . $taint, $tail) - : $basename . $taint; -} - - -# basename() - returns first element of list returned by fileparse() - -sub basename { - my($name) = shift; - (fileparse($name, map("\Q$_\E",@_)))[0]; -} - - -# dirname() - returns device and directory portion of file specification -# Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS -# filespecs except for names ending with a separator, e.g., "/xx/yy/". -# This differs from the second element of the list returned -# by fileparse() in that the trailing '/' (Unix) or '\' (MSDOS) (and -# the last directory name if the filespec ends in a '/' or '\'), is lost. - -sub dirname { - my($basename,$dirname) = fileparse($_[0]); - my($fstype) = $Fileparse_fstype; - - if ($fstype =~ /VMS/i) { - if ($_[0] =~ m#/#) { $fstype = '' } - else { return $dirname || $ENV{DEFAULT} } - } - if ($fstype =~ /MacOS/i) { return $dirname } - elsif ($fstype =~ /MSDOS/i) { - $dirname =~ s/([^:])[\\\/]*\z/$1/; - unless( length($basename) ) { - ($basename,$dirname) = fileparse $dirname; - $dirname =~ s/([^:])[\\\/]*\z/$1/; - } - } - elsif ($fstype =~ /MSWin32/i) { - $dirname =~ s/([^:])[\\\/]*\z/$1/; - unless( length($basename) ) { - ($basename,$dirname) = fileparse $dirname; - $dirname =~ s/([^:])[\\\/]*\z/$1/; - } - } - elsif ($fstype =~ /AmigaOS/i) { - if ( $dirname =~ /:\z/) { return $dirname } - chop $dirname; - $dirname =~ s#[^:/]+\z## unless length($basename); - } - else { - $dirname =~ s:(.)/*\z:$1:s; - unless( length($basename) ) { - local($File::Basename::Fileparse_fstype) = $fstype; - ($basename,$dirname) = fileparse $dirname; - $dirname =~ s:(.)/*\z:$1:s; - } - } - - $dirname; -} - -fileparse_set_fstype $^O; - -1; diff --git a/contrib/perl5/lib/File/CheckTree.pm b/contrib/perl5/lib/File/CheckTree.pm deleted file mode 100644 index ae1877741bc99..0000000000000 --- a/contrib/perl5/lib/File/CheckTree.pm +++ /dev/null @@ -1,151 +0,0 @@ -package File::CheckTree; -require 5.000; -require Exporter; - -=head1 NAME - -validate - run many filetest checks on a tree - -=head1 SYNOPSIS - - use File::CheckTree; - - $warnings += validate( q{ - /vmunix -e || die - /boot -e || die - /bin cd - csh -ex - csh !-ug - sh -ex - sh !-ug - /usr -d || warn "What happened to $file?\n" - }); - -=head1 DESCRIPTION - -The validate() routine takes a single multiline string consisting of -lines containing a filename plus a file test to try on it. (The -file test may also be a "cd", causing subsequent relative filenames -to be interpreted relative to that directory.) After the file test -you may put C<|| die> to make it a fatal error if the file test fails. -The default is C<|| warn>. The file test may optionally have a "!' prepended -to test for the opposite condition. If you do a cd and then list some -relative filenames, you may want to indent them slightly for readability. -If you supply your own die() or warn() message, you can use $file to -interpolate the filename. - -Filetests may be bunched: "-rwx" tests for all of C<-r>, C<-w>, and C<-x>. -Only the first failed test of the bunch will produce a warning. - -The routine returns the number of warnings issued. - -=cut - -@ISA = qw(Exporter); -@EXPORT = qw(validate); - -# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $ - -# The validate routine takes a single multiline string consisting of -# lines containing a filename plus a file test to try on it. (The -# file test may also be a 'cd', causing subsequent relative filenames -# to be interpreted relative to that directory.) After the file test -# you may put '|| die' to make it a fatal error if the file test fails. -# The default is '|| warn'. The file test may optionally have a ! prepended -# to test for the opposite condition. If you do a cd and then list some -# relative filenames, you may want to indent them slightly for readability. -# If you supply your own "die" or "warn" message, you can use $file to -# interpolate the filename. - -# Filetests may be bunched: -rwx tests for all of -r, -w and -x. -# Only the first failed test of the bunch will produce a warning. - -# The routine returns the number of warnings issued. - -# Usage: -# use File::CheckTree; -# $warnings += validate(' -# /vmunix -e || die -# /boot -e || die -# /bin cd -# csh -ex -# csh !-ug -# sh -ex -# sh !-ug -# /usr -d || warn "What happened to $file?\n" -# '); - -sub validate { - local($file,$test,$warnings,$oldwarnings); - foreach $check (split(/\n/,$_[0])) { - next if $check =~ /^#/; - next if $check =~ /^$/; - ($file,$test) = split(' ',$check,2); - if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) { - $testlist = $2; - @testlist = split(//,$testlist); - } - else { - @testlist = ('Z'); - } - $oldwarnings = $warnings; - foreach $one (@testlist) { - $this = $test; - $this =~ s/(-\w\b)/$1 \$file/g; - $this =~ s/-Z/-$one/; - $this .= ' || warn' unless $this =~ /\|\|/; - $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || valmess('$2','$1')/; - $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g; - eval $this; - last if $warnings > $oldwarnings; - } - } - $warnings; -} - -sub valmess { - local($disposition,$this) = @_; - $file = $cwd . '/' . $file unless $file =~ m|^/|s; - if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) { - $neg = $1; - $tmp = $2; - $tmp eq 'r' && ($mess = "$file is not readable by uid $>."); - $tmp eq 'w' && ($mess = "$file is not writable by uid $>."); - $tmp eq 'x' && ($mess = "$file is not executable by uid $>."); - $tmp eq 'o' && ($mess = "$file is not owned by uid $>."); - $tmp eq 'R' && ($mess = "$file is not readable by you."); - $tmp eq 'W' && ($mess = "$file is not writable by you."); - $tmp eq 'X' && ($mess = "$file is not executable by you."); - $tmp eq 'O' && ($mess = "$file is not owned by you."); - $tmp eq 'e' && ($mess = "$file does not exist."); - $tmp eq 'z' && ($mess = "$file does not have zero size."); - $tmp eq 's' && ($mess = "$file does not have non-zero size."); - $tmp eq 'f' && ($mess = "$file is not a plain file."); - $tmp eq 'd' && ($mess = "$file is not a directory."); - $tmp eq 'l' && ($mess = "$file is not a symbolic link."); - $tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO)."); - $tmp eq 'S' && ($mess = "$file is not a socket."); - $tmp eq 'b' && ($mess = "$file is not a block special file."); - $tmp eq 'c' && ($mess = "$file is not a character special file."); - $tmp eq 'u' && ($mess = "$file does not have the setuid bit set."); - $tmp eq 'g' && ($mess = "$file does not have the setgid bit set."); - $tmp eq 'k' && ($mess = "$file does not have the sticky bit set."); - $tmp eq 'T' && ($mess = "$file is not a text file."); - $tmp eq 'B' && ($mess = "$file is not a binary file."); - if ($neg eq '!') { - $mess =~ s/ is not / should not be / || - $mess =~ s/ does not / should not / || - $mess =~ s/ not / /; - } - } - else { - $this =~ s/\$file/'$file'/g; - $mess = "Can't do $this.\n"; - } - die "$mess\n" if $disposition eq 'die'; - warn "$mess\n"; - ++$warnings; -} - -1; - diff --git a/contrib/perl5/lib/File/Compare.pm b/contrib/perl5/lib/File/Compare.pm deleted file mode 100644 index 667e7cb883123..0000000000000 --- a/contrib/perl5/lib/File/Compare.pm +++ /dev/null @@ -1,182 +0,0 @@ -package File::Compare; - -use 5.005_64; -use strict; -our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Too_Big); - -require Exporter; -use Carp; - -$VERSION = '1.1002'; -@ISA = qw(Exporter); -@EXPORT = qw(compare); -@EXPORT_OK = qw(cmp compare_text); - -$Too_Big = 1024 * 1024 * 2; - -sub VERSION { - # Version of File::Compare - return $File::Compare::VERSION; -} - -sub compare { - croak("Usage: compare( file1, file2 [, buffersize]) ") - unless(@_ == 2 || @_ == 3); - - my ($from,$to,$size) = @_; - my $text_mode = defined($size) && (ref($size) eq 'CODE' || $size < 0); - - my ($fromsize,$closefrom,$closeto); - local (*FROM, *TO); - - croak("from undefined") unless (defined $from); - croak("to undefined") unless (defined $to); - - if (ref($from) && - (UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) { - *FROM = *$from; - } elsif (ref(\$from) eq 'GLOB') { - *FROM = $from; - } else { - open(FROM,"<$from") or goto fail_open1; - unless ($text_mode) { - binmode FROM; - $fromsize = -s FROM; - } - $closefrom = 1; - } - - if (ref($to) && - (UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) { - *TO = *$to; - } elsif (ref(\$to) eq 'GLOB') { - *TO = $to; - } else { - open(TO,"<$to") or goto fail_open2; - binmode TO unless $text_mode; - $closeto = 1; - } - - if (!$text_mode && $closefrom && $closeto) { - # If both are opened files we know they differ if their size differ - goto fail_inner if $fromsize != -s TO; - } - - if ($text_mode) { - local $/ = "\n"; - my ($fline,$tline); - while (defined($fline = <FROM>)) { - goto fail_inner unless defined($tline = <TO>); - if (ref $size) { - # $size contains ref to comparison function - goto fail_inner if &$size($fline, $tline); - } else { - goto fail_inner if $fline ne $tline; - } - } - goto fail_inner if defined($tline = <TO>); - } - else { - unless (defined($size) && $size > 0) { - $size = $fromsize || -s TO || 0; - $size = 1024 if $size < 512; - $size = $Too_Big if $size > $Too_Big; - } - - my ($fr,$tr,$fbuf,$tbuf); - $fbuf = $tbuf = ''; - while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) { - unless (defined($tr = read(TO,$tbuf,$fr)) && $tbuf eq $fbuf) { - goto fail_inner; - } - } - goto fail_inner if defined($tr = read(TO,$tbuf,$size)) && $tr > 0; - } - - close(TO) || goto fail_open2 if $closeto; - close(FROM) || goto fail_open1 if $closefrom; - - return 0; - - # All of these contortions try to preserve error messages... - fail_inner: - close(TO) || goto fail_open2 if $closeto; - close(FROM) || goto fail_open1 if $closefrom; - - return 1; - - fail_open2: - if ($closefrom) { - my $status = $!; - $! = 0; - close FROM; - $! = $status unless $!; - } - fail_open1: - return -1; -} - -sub cmp; -*cmp = \&compare; - -sub compare_text { - my ($from,$to,$cmp) = @_; - croak("Usage: compare_text( file1, file2 [, cmp-function])") - unless @_ == 2 || @_ == 3; - croak("Third arg to compare_text() function must be a code reference") - if @_ == 3 && ref($cmp) ne 'CODE'; - - # Using a negative buffer size puts compare into text_mode too - $cmp = -1 unless defined $cmp; - compare($from, $to, $cmp); -} - -1; - -__END__ - -=head1 NAME - -File::Compare - Compare files or filehandles - -=head1 SYNOPSIS - - use File::Compare; - - if (compare("file1","file2") == 0) { - print "They're equal\n"; - } - -=head1 DESCRIPTION - -The File::Compare::compare function compares the contents of two -sources, each of which can be a file or a file handle. It is exported -from File::Compare by default. - -File::Compare::cmp is a synonym for File::Compare::compare. It is -exported from File::Compare only by request. - -File::Compare::compare_text does a line by line comparison of the two -files. It stops as soon as a difference is detected. compare_text() -accepts an optional third argument: This must be a CODE reference to -a line comparison function, which returns 0 when both lines are considered -equal. For example: - - compare_text($file1, $file2) - -is basically equivalent to - - compare_text($file1, $file2, sub {$_[0] ne $_[1]} ) - -=head1 RETURN - -File::Compare::compare return 0 if the files are equal, 1 if the -files are unequal, or -1 if an error was encountered. - -=head1 AUTHOR - -File::Compare was written by Nick Ing-Simmons. -Its original documentation was written by Chip Salzenberg. - -=cut - diff --git a/contrib/perl5/lib/File/Copy.pm b/contrib/perl5/lib/File/Copy.pm deleted file mode 100644 index e6cf78603423d..0000000000000 --- a/contrib/perl5/lib/File/Copy.pm +++ /dev/null @@ -1,353 +0,0 @@ -# File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This -# source code has been placed in the public domain by the author. -# Please be kind and preserve the documentation. -# -# Additions copyright 1996 by Charles Bailey. Permission is granted -# to distribute the revised code under the same terms as Perl itself. - -package File::Copy; - -use 5.005_64; -use strict; -use Carp; -our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy); -sub copy; -sub syscopy; -sub cp; -sub mv; - -# Note that this module implements only *part* of the API defined by -# the File/Copy.pm module of the File-Tools-2.0 package. However, that -# package has not yet been updated to work with Perl 5.004, and so it -# would be a Bad Thing for the CPAN module to grab it and replace this -# module. Therefore, we set this module's version higher than 2.0. -$VERSION = '2.03'; - -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(copy move); -@EXPORT_OK = qw(cp mv); - -$Too_Big = 1024 * 1024 * 2; - -sub _catname { # Will be replaced by File::Spec when it arrives - my($from, $to) = @_; - if (not defined &basename) { - require File::Basename; - import File::Basename 'basename'; - } - if ($^O eq 'VMS') { $to = VMS::Filespec::vmspath($to) . basename($from); } - elsif ($^O eq 'MacOS') { $to .= ':' . basename($from); } - elsif ($to =~ m|\\|) { $to .= '\\' . basename($from); } - else { $to .= '/' . basename($from); } -} - -sub copy { - croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ") - unless(@_ == 2 || @_ == 3); - - my $from = shift; - my $to = shift; - - my $from_a_handle = (ref($from) - ? (ref($from) eq 'GLOB' - || UNIVERSAL::isa($from, 'GLOB') - || UNIVERSAL::isa($from, 'IO::Handle')) - : (ref(\$from) eq 'GLOB')); - my $to_a_handle = (ref($to) - ? (ref($to) eq 'GLOB' - || UNIVERSAL::isa($to, 'GLOB') - || UNIVERSAL::isa($to, 'IO::Handle')) - : (ref(\$to) eq 'GLOB')); - - if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) { - $to = _catname($from, $to); - } - - if (defined &syscopy && !$Syscopy_is_copy - && !$to_a_handle - && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles - && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX. - && !($from_a_handle && $^O eq 'MSWin32') - ) - { - return syscopy($from, $to); - } - - my $closefrom = 0; - my $closeto = 0; - my ($size, $status, $r, $buf); - local(*FROM, *TO); - local($\) = ''; - - if ($from_a_handle) { - *FROM = *$from{FILEHANDLE}; - } else { - $from = "./$from" if $from =~ /^\s/s; - open(FROM, "< $from\0") or goto fail_open1; - binmode FROM or die "($!,$^E)"; - $closefrom = 1; - } - - if ($to_a_handle) { - *TO = *$to{FILEHANDLE}; - } else { - $to = "./$to" if $to =~ /^\s/s; - open(TO,"> $to\0") or goto fail_open2; - binmode TO or die "($!,$^E)"; - $closeto = 1; - } - - if (@_) { - $size = shift(@_) + 0; - croak("Bad buffer size for copy: $size\n") unless ($size > 0); - } else { - $size = -s FROM; - $size = 1024 if ($size < 512); - $size = $Too_Big if ($size > $Too_Big); - } - - $! = 0; - for (;;) { - my ($r, $w, $t); - defined($r = sysread(FROM, $buf, $size)) - or goto fail_inner; - last unless $r; - for ($w = 0; $w < $r; $w += $t) { - $t = syswrite(TO, $buf, $r - $w, $w) - or goto fail_inner; - } - } - - close(TO) || goto fail_open2 if $closeto; - close(FROM) || goto fail_open1 if $closefrom; - - # Use this idiom to avoid uninitialized value warning. - return 1; - - # All of these contortions try to preserve error messages... - fail_inner: - if ($closeto) { - $status = $!; - $! = 0; - close TO; - $! = $status unless $!; - } - fail_open2: - if ($closefrom) { - $status = $!; - $! = 0; - close FROM; - $! = $status unless $!; - } - fail_open1: - return 0; -} - -sub move { - my($from,$to) = @_; - my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts); - - if (-d $to && ! -d $from) { - $to = _catname($from, $to); - } - - ($tosz1,$tomt1) = (stat($to))[7,9]; - $fromsz = -s $from; - if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) { - # will not rename with overwrite - unlink $to; - } - return 1 if rename $from, $to; - - ($sts,$ossts) = ($! + 0, $^E + 0); - # Did rename return an error even though it succeeded, because $to - # is on a remote NFS file system, and NFS lost the server's ack? - return 1 if defined($fromsz) && !-e $from && # $from disappeared - (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there - ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed - $tosz2 == $fromsz; # it's all there - - ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something - return 1 if ($copied = copy($from,$to)) && unlink($from); - - ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1; - unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2; - ($!,$^E) = ($sts,$ossts); - return 0; -} - -*cp = \© -*mv = \&move; - -# &syscopy is an XSUB under OS/2 -unless (defined &syscopy) { - if ($^O eq 'VMS') { - *syscopy = \&rmscopy; - } elsif ($^O eq 'mpeix') { - *syscopy = sub { - return 0 unless @_ == 2; - # Use the MPE cp program in order to - # preserve MPE file attributes. - return system('/bin/cp', '-f', $_[0], $_[1]) == 0; - }; - } elsif ($^O eq 'MSWin32') { - *syscopy = sub { - return 0 unless @_ == 2; - return Win32::CopyFile(@_, 1); - }; - } else { - $Syscopy_is_copy = 1; - *syscopy = \© - } -} - -1; - -__END__ - -=head1 NAME - -File::Copy - Copy files or filehandles - -=head1 SYNOPSIS - - use File::Copy; - - copy("file1","file2"); - copy("Copy.pm",\*STDOUT);' - move("/dev1/fileA","/dev2/fileB"); - - use POSIX; - use File::Copy cp; - - $n=FileHandle->new("/dev/null","r"); - cp($n,"x");' - -=head1 DESCRIPTION - -The File::Copy module provides two basic functions, C<copy> and -C<move>, which are useful for getting the contents of a file from -one place to another. - -=over 4 - -=item * - -The C<copy> function takes two -parameters: a file to copy from and a file to copy to. Either -argument may be a string, a FileHandle reference or a FileHandle -glob. Obviously, if the first argument is a filehandle of some -sort, it will be read from, and if it is a file I<name> it will -be opened for reading. Likewise, the second argument will be -written to (and created if need be). - -B<Note that passing in -files as handles instead of names may lead to loss of information -on some operating systems; it is recommended that you use file -names whenever possible.> Files are opened in binary mode where -applicable. To get a consistent behaviour when copying from a -filehandle to a file, use C<binmode> on the filehandle. - -An optional third parameter can be used to specify the buffer -size used for copying. This is the number of bytes from the -first file, that wil be held in memory at any given time, before -being written to the second file. The default buffer size depends -upon the file, but will generally be the whole file (up to 2Mb), or -1k for filehandles that do not reference files (eg. sockets). - -You may use the syntax C<use File::Copy "cp"> to get at the -"cp" alias for this function. The syntax is I<exactly> the same. - -=item * - -The C<move> function also takes two parameters: the current name -and the intended name of the file to be moved. If the destination -already exists and is a directory, and the source is not a -directory, then the source file will be renamed into the directory -specified by the destination. - -If possible, move() will simply rename the file. Otherwise, it copies -the file to the new location and deletes the original. If an error occurs -during this copy-and-delete process, you may be left with a (possibly partial) -copy of the file under the destination name. - -You may use the "mv" alias for this function in the same way that -you may use the "cp" alias for C<copy>. - -=back - -File::Copy also provides the C<syscopy> routine, which copies the -file specified in the first parameter to the file specified in the -second parameter, preserving OS-specific attributes and file -structure. For Unix systems, this is equivalent to the simple -C<copy> routine. For 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>. - -=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32) - -If both arguments to C<copy> are not file handles, -then C<copy> will perform a "system copy" of -the input file to a new output file, in order to preserve file -attributes, indexed file structure, I<etc.> The buffer size -parameter is ignored. If either argument to C<copy> is a -handle to an opened file, then data is copied using Perl -operators, and no effort is made to preserve file attributes -or record structure. - -The system copy routine may also be called directly under VMS and OS/2 -as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which -is the routine that does the actual work for syscopy). - -=over 4 - -=item rmscopy($from,$to[,$date_flag]) - -The first and second arguments may be strings, typeglobs, typeglob -references, or objects inheriting from IO::Handle; -they are used in all cases to obtain the -I<filespec> of the input and output files, respectively. The -name and type of the input file are used as defaults for the -output file, if necessary. - -A new version of the output file is always created, which -inherits the structure and RMS attributes of the input file, -except for owner and protections (and possibly timestamps; -see below). All data from the input file is copied to the -output file; if either of the first two parameters to C<rmscopy> -is a file handle, its position is unchanged. (Note that this -means a file handle pointing to the output file will be -associated with an old version of that file after C<rmscopy> -returns, not the newly created version.) - -The third parameter is an integer flag, which tells C<rmscopy> -how to handle timestamps. If it is E<lt> 0, none of the input file's -timestamps are propagated to the output file. If it is E<gt> 0, then -it is interpreted as a bitmask: if bit 0 (the LSB) is set, then -timestamps other than the revision date are propagated; if bit 1 -is set, the revision date is propagated. If the third parameter -to C<rmscopy> is 0, then it behaves much like the DCL COPY command: -if the name or type of the output file was explicitly specified, -then no timestamps are propagated, but if they were taken implicitly -from the input filespec, then all timestamps other than the -revision date are propagated. If this parameter is not supplied, -it defaults to 0. - -Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs, -it sets C<$!>, deletes the output file, and returns 0. - -=back - -=head1 RETURN - -All functions return 1 on success, 0 on failure. -$! will be set if an error was encountered. - -=head1 AUTHOR - -File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995, -and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996. - -=cut - diff --git a/contrib/perl5/lib/File/DosGlob.pm b/contrib/perl5/lib/File/DosGlob.pm deleted file mode 100644 index d7dea7b46cf3a..0000000000000 --- a/contrib/perl5/lib/File/DosGlob.pm +++ /dev/null @@ -1,254 +0,0 @@ -#!perl -w - -# -# Documentation at the __END__ -# - -package File::DosGlob; - -sub doglob { - my $cond = shift; - my @retval = (); - #print "doglob: ", join('|', @_), "\n"; - OUTER: - for my $arg (@_) { - local $_ = $arg; - my @matched = (); - my @globdirs = (); - my $head = '.'; - my $sepchr = '/'; - next OUTER unless defined $_ and $_ ne ''; - # if arg is within quotes strip em and do no globbing - if (/^"(.*)"\z/s) { - $_ = $1; - if ($cond eq 'd') { push(@retval, $_) if -d $_ } - else { push(@retval, $_) if -e $_ } - next OUTER; - } - # wildcards with a drive prefix such as h:*.pm must be changed - # to h:./*.pm to expand correctly - if (m|^([A-Za-z]:)[^/\\]|s) { - substr($_,0,2) = $1 . "./"; - } - if (m|^(.*)([\\/])([^\\/]*)\z|s) { - my $tail; - ($head, $sepchr, $tail) = ($1,$2,$3); - #print "div: |$head|$sepchr|$tail|\n"; - push (@retval, $_), next OUTER if $tail eq ''; - if ($head =~ /[*?]/) { - @globdirs = doglob('d', $head); - push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)), - next OUTER if @globdirs; - } - $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:\z/s; - $_ = $tail; - } - # - # If file component has no wildcards, we can avoid opendir - unless (/[*?]/) { - $head = '' if $head eq '.'; - $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr; - $head .= $_; - if ($cond eq 'd') { push(@retval,$head) if -d $head } - else { push(@retval,$head) if -e $head } - next OUTER; - } - opendir(D, $head) or next OUTER; - my @leaves = readdir D; - closedir D; - $head = '' if $head eq '.'; - $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr; - - # escape regex metachars but not glob chars - s:([].+^\-\${}[|]):\\$1:g; - # and convert DOS-style wildcards to regex - s/\*/.*/g; - s/\?/.?/g; - - #print "regex: '$_', head: '$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 "$head$e"; - push(@matched, "$head$e"), next INNER if &$matchsub($e); - # - # [DOS compatibility special case] - # Failed, add a trailing dot and try again, but only - # if name does not have a dot in it *and* pattern - # has a dot *and* name is shorter than 9 chars. - # - if (index($e,'.') == -1 and length($e) < 9 - and index($_,'\\.') != -1) { - push(@matched, "$head$e"), next INNER if &$matchsub("$e."); - } - } - push @retval, @matched if @matched; - } - return @retval; -} - -# -# this can be used to override CORE::glob in a specific -# package by saying C<use File::DosGlob 'glob';> in that -# namespace. -# - -# context (keyed by second cxix arg provided by core) -my %iter; -my %entries; - -sub glob { - my $pat = shift; - my $cxix = shift; - my @pat; - - # glob without args defaults to $_ - $pat = $_ unless defined $pat; - - # extract patterns - if ($pat =~ /\s/) { - require Text::ParseWords; - @pat = Text::ParseWords::parse_line('\s+',0,$pat); - } - else { - push @pat, $pat; - } - - # assume global context if not provided one - $cxix = '_G_' unless defined $cxix; - $iter{$cxix} = 0 unless exists $iter{$cxix}; - - # if we're just beginning, do it all first - if ($iter{$cxix} == 0) { - $entries{$cxix} = [doglob(1,@pat)]; - } - - # chuck it all out, quick or slow - if (wantarray) { - delete $iter{$cxix}; - return @{delete $entries{$cxix}}; - } - else { - if ($iter{$cxix} = scalar @{$entries{$cxix}}) { - return shift @{$entries{$cxix}}; - } - else { - # return undef for EOL - delete $iter{$cxix}; - delete $entries{$cxix}; - return undef; - } - } -} - -sub import { - my $pkg = shift; - return unless @_; - my $sym = shift; - my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0)); - *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob'; -} - -1; - -__END__ - -=head1 NAME - -File::DosGlob - DOS like globbing and then some - -=head1 SYNOPSIS - - require 5.004; - - # override CORE::glob in current package - use File::DosGlob 'glob'; - - # override CORE::glob in ALL packages (use with extreme caution!) - use File::DosGlob 'GLOBAL_glob'; - - @perlfiles = glob "..\\pe?l/*.p?"; - print <..\\pe?l/*.p?>; - - # from the command line (overrides only in main::) - > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>" - -=head1 DESCRIPTION - -A module that implements DOS-like globbing with a few enhancements. -It is largely compatible with perlglob.exe (the M$ setargv.obj -version) in all but one respect--it understands wildcards in -directory components. - -For example, C<<..\\l*b\\file/*glob.p?>> will work as expected (in -that it will find something like '..\lib\File/DosGlob.pm' alright). -Note that all path components are case-insensitive, and that -backslashes and forward slashes are both accepted, and preserved. -You may have to double the backslashes if you are putting them in -literally, due to double-quotish parsing of the pattern by perl. - -Spaces in the argument delimit distinct patterns, so -C<glob('*.exe *.dll')> globs all filenames that end in C<.exe> -or C<.dll>. If you want to put in literal spaces in the glob -pattern, you can escape them with either double quotes, or backslashes. -e.g. C<glob('c:/"Program Files"/*/*.dll')>, or -C<glob('c:/Program\ Files/*/*.dll')>. The argument is tokenized using -C<Text::ParseWords::parse_line()>, so see L<Text::ParseWords> for details -of the quoting rules used. - -Extending it to csh patterns is left as an exercise to the reader. - -=head1 EXPORTS (by request only) - -glob() - -=head1 BUGS - -Should probably be built into the core, and needs to stop -pandering to DOS habits. Needs a dose of optimizium too. - -=head1 AUTHOR - -Gurusamy Sarathy <gsar@activestate.com> - -=head1 HISTORY - -=over 4 - -=item * - -Support for globally overriding glob() (GSAR 3-JUN-98) - -=item * - -Scalar context, independent iterator context fixes (GSAR 15-SEP-97) - -=item * - -A few dir-vs-file optimizations result in glob importation being -10 times faster than using perlglob.exe, and using perlglob.bat is -only twice as slow as perlglob.exe (GSAR 28-MAY-97) - -=item * - -Several cleanups prompted by lack of compatible perlglob.exe -under Borland (GSAR 27-MAY-97) - -=item * - -Initial version (GSAR 20-FEB-97) - -=back - -=head1 SEE ALSO - -perl - -perlglob.bat - -Text::ParseWords - -=cut - diff --git a/contrib/perl5/lib/File/Find.pm b/contrib/perl5/lib/File/Find.pm deleted file mode 100644 index ac73f1b5eb245..0000000000000 --- a/contrib/perl5/lib/File/Find.pm +++ /dev/null @@ -1,735 +0,0 @@ -package File::Find; -use 5.005_64; -require Exporter; -require Cwd; - -=head1 NAME - -find - traverse a file tree - -finddepth - traverse a directory structure depth-first - -=head1 SYNOPSIS - - use File::Find; - find(\&wanted, '/foo', '/bar'); - sub wanted { ... } - - use File::Find; - finddepth(\&wanted, '/foo', '/bar'); - sub wanted { ... } - - use File::Find; - find({ wanted => \&process, follow => 1 }, '.'); - -=head1 DESCRIPTION - -The first argument to find() is either a hash reference describing the -operations to be performed for each file, or a code reference. - -Here are the possible keys for the hash: - -=over 3 - -=item C<wanted> - -The value should be a code reference. This code reference is called -I<the wanted() function> below. - -=item C<bydepth> - -Reports the name of a directory only AFTER all its entries -have been reported. Entry point finddepth() is a shortcut for -specifying C<{ bydepth => 1 }> in the first argument of find(). - -=item C<follow> - -Causes symbolic links to be followed. Since directory trees with symbolic -links (followed) may contain files more than once and may even have -cycles, a hash has to be built up with an entry for each file. -This might be expensive both in space and time for a large -directory tree. See I<follow_fast> and I<follow_skip> below. -If either I<follow> or I<follow_fast> is in effect: - -=over 6 - -=item * - -It is guarantueed that an I<lstat> has been called before the user's -I<wanted()> function is called. This enables fast file checks involving S< _>. - -=item * - -There is a variable C<$File::Find::fullname> which holds the absolute -pathname of the file with all symbolic links resolved - -=back - -=item C<follow_fast> - -This is similar to I<follow> except that it may report some files -more than once. It does detect cycles however. -Since only symbolic links have to be hashed, this is -much cheaper both in space and time. -If processing a file more than once (by the user's I<wanted()> function) -is worse than just taking time, the option I<follow> should be used. - -=item C<follow_skip> - -C<follow_skip==1>, which is the default, causes all files which are -neither directories nor symbolic links to be ignored if they are about -to be processed a second time. If a directory or a symbolic link -are about to be processed a second time, File::Find dies. -C<follow_skip==0> causes File::Find to die if any file is about to be -processed a second time. -C<follow_skip==2> causes File::Find to ignore any duplicate files and -dirctories but to proceed normally otherwise. - - -=item C<no_chdir> - -Does not C<chdir()> to each directory as it recurses. The wanted() -function will need to be aware of this, of course. In this case, -C<$_> will be the same as C<$File::Find::name>. - -=item C<untaint> - -If find is used in taint-mode (-T command line switch or if EUID != UID -or if EGID != GID) then internally directory names have to be untainted -before they can be cd'ed to. Therefore they are checked against a regular -expression I<untaint_pattern>. Note, that all names passed to the -user's I<wanted()> function are still tainted. - -=item C<untaint_pattern> - -See above. This should be set using the C<qr> quoting operator. -The default is set to C<qr|^([-+@\w./]+)$|>. -Note that the paranthesis which are vital. - -=item C<untaint_skip> - -If set, directories (subtrees) which fail the I<untaint_pattern> -are skipped. The default is to 'die' in such a case. - -=back - -The wanted() function does whatever verifications you want. -C<$File::Find::dir> contains the current directory name, and C<$_> the -current filename within that directory. C<$File::Find::name> contains -the complete pathname to the file. You are chdir()'d to C<$File::Find::dir> when -the function is called, unless C<no_chdir> was specified. -When <follow> or <follow_fast> are in effect there is also a -C<$File::Find::fullname>. -The function may set C<$File::Find::prune> to prune the tree -unless C<bydepth> was specified. -Unless C<follow> or C<follow_fast> is specified, for compatibility -reasons (find.pl, find2perl) there are in addition the following globals -available: C<$File::Find::topdir>, C<$File::Find::topdev>, C<$File::Find::topino>, -C<$File::Find::topmode> and C<$File::Find::topnlink>. - -This library is useful for the C<find2perl> tool, which when fed, - - find2perl / -name .nfs\* -mtime +7 \ - -exec rm -f {} \; -o -fstype nfs -prune - -produces something like: - - sub wanted { - /^\.nfs.*\z/s && - (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && - int(-M _) > 7 && - unlink($_) - || - ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) && - $dev < 0 && - ($File::Find::prune = 1); - } - -Set the variable C<$File::Find::dont_use_nlink> if you're using AFS, -since AFS cheats. - - -Here's another interesting wanted function. It will find all symlinks -that don't resolve: - - sub wanted { - -l && !-e && print "bogus link: $File::Find::name\n"; - } - -See also the script C<pfind> on CPAN for a nice application of this -module. - -=head1 CAVEAT - -Be aware that the option to follow symblic links can be dangerous. -Depending on the structure of the directory tree (including symbolic -links to directories) you might traverse a given (physical) directory -more than once (only if C<follow_fast> is in effect). -Furthermore, deleting or changing files in a symbolically linked directory -might cause very unpleasant surprises, since you delete or change files -in an unknown directory. - - -=cut - -@ISA = qw(Exporter); -@EXPORT = qw(find finddepth); - - -use strict; -my $Is_VMS; - -require File::Basename; - -my %SLnkSeen; -my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, - $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat); - -sub contract_name { - my ($cdir,$fn) = @_; - - return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.'; - - $cdir = substr($cdir,0,rindex($cdir,'/')+1); - - $fn =~ s|^\./||; - - my $abs_name= $cdir . $fn; - - if (substr($fn,0,3) eq '../') { - do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|); - } - - return $abs_name; -} - - -sub PathCombine($$) { - my ($Base,$Name) = @_; - my $AbsName; - - if (substr($Name,0,1) eq '/') { - $AbsName= $Name; - } - else { - $AbsName= contract_name($Base,$Name); - } - - # (simple) check for recursion - my $newlen= length($AbsName); - if ($newlen <= length($Base)) { - if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/') - && $AbsName eq substr($Base,0,$newlen)) - { - return undef; - } - } - return $AbsName; -} - -sub Follow_SymLink($) { - my ($AbsName) = @_; - - my ($NewName,$DEV, $INO); - ($DEV, $INO)= lstat $AbsName; - - while (-l _) { - if ($SLnkSeen{$DEV, $INO}++) { - if ($follow_skip < 2) { - die "$AbsName is encountered a second time"; - } - else { - return undef; - } - } - $NewName= PathCombine($AbsName, readlink($AbsName)); - unless(defined $NewName) { - if ($follow_skip < 2) { - die "$AbsName is a recursive symbolic link"; - } - else { - return undef; - } - } - else { - $AbsName= $NewName; - } - ($DEV, $INO) = lstat($AbsName); - return undef unless defined $DEV; # dangling symbolic link - } - - if ($full_check && $SLnkSeen{$DEV, $INO}++) { - if ($follow_skip < 1) { - die "$AbsName encountered a second time"; - } - else { - return undef; - } - } - - return $AbsName; -} - -our($dir, $name, $fullname, $prune); -sub _find_dir_symlnk($$$); -sub _find_dir($$$); - -sub _find_opt { - my $wanted = shift; - die "invalid top directory" unless defined $_[0]; - - my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd(); - my $cwd_untainted = $cwd; - $wanted_callback = $wanted->{wanted}; - $bydepth = $wanted->{bydepth}; - $no_chdir = $wanted->{no_chdir}; - $full_check = $wanted->{follow}; - $follow = $full_check || $wanted->{follow_fast}; - $follow_skip = $wanted->{follow_skip}; - $untaint = $wanted->{untaint}; - $untaint_pat = $wanted->{untaint_pattern}; - $untaint_skip = $wanted->{untaint_skip}; - - # for compatability reasons (find.pl, find2perl) - our ($topdir, $topdev, $topino, $topmode, $topnlink); - - # a symbolic link to a directory doesn't increase the link count - $avoid_nlink = $follow || $File::Find::dont_use_nlink; - - if ( $untaint ) { - $cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|; - die "insecure cwd in find(depth)" unless defined($cwd_untainted); - } - - my ($abs_dir, $Is_Dir); - - Proc_Top_Item: - foreach my $TOP (@_) { - my $top_item = $TOP; - $top_item =~ s|/\z|| unless $top_item eq '/'; - $Is_Dir= 0; - - ($topdev,$topino,$topmode,$topnlink) = stat $top_item; - - if ($follow) { - if (substr($top_item,0,1) eq '/') { - $abs_dir = $top_item; - } - elsif ($top_item eq '.') { - $abs_dir = $cwd; - } - else { # care about any ../ - $abs_dir = contract_name("$cwd/",$top_item); - } - $abs_dir= Follow_SymLink($abs_dir); - unless (defined $abs_dir) { - warn "$top_item is a dangling symbolic link\n"; - next Proc_Top_Item; - } - if (-d _) { - _find_dir_symlnk($wanted, $abs_dir, $top_item); - $Is_Dir= 1; - } - } - else { # no follow - $topdir = $top_item; - unless (defined $topnlink) { - warn "Can't stat $top_item: $!\n"; - next Proc_Top_Item; - } - if (-d _) { - $top_item =~ s/\.dir\z// if $Is_VMS; - _find_dir($wanted, $top_item, $topnlink); - $Is_Dir= 1; - } - else { - $abs_dir= $top_item; - } - } - - unless ($Is_Dir) { - unless (($_,$dir) = File::Basename::fileparse($abs_dir)) { - ($dir,$_) = ('./', $top_item); - } - - $abs_dir = $dir; - if ($untaint) { - my $abs_dir_save = $abs_dir; - $abs_dir = $1 if $abs_dir =~ m|$untaint_pat|; - unless (defined $abs_dir) { - if ($untaint_skip == 0) { - die "directory $abs_dir_save is still tainted"; - } - else { - next Proc_Top_Item; - } - } - } - - unless ($no_chdir or chdir $abs_dir) { - warn "Couldn't chdir $abs_dir: $!\n"; - next Proc_Top_Item; - } - - $name = $abs_dir . $_; - - &$wanted_callback; - - } - - $no_chdir or chdir $cwd_untainted; - } -} - -# API: -# $wanted -# $p_dir : "parent directory" -# $nlink : what came back from the stat -# preconditions: -# chdir (if not no_chdir) to dir - -sub _find_dir($$$) { - my ($wanted, $p_dir, $nlink) = @_; - my ($CdLvl,$Level) = (0,0); - my @Stack; - my @filenames; - my ($subcount,$sub_nlink); - my $SE= []; - my $dir_name= $p_dir; - my $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" ); - my $dir_rel= '.'; # directory name relative to current directory - - local ($dir, $name, $prune, *DIR); - - unless ($no_chdir or $p_dir eq '.') { - my $udir = $p_dir; - if ($untaint) { - $udir = $1 if $p_dir =~ m|$untaint_pat|; - unless (defined $udir) { - if ($untaint_skip == 0) { - die "directory $p_dir is still tainted"; - } - else { - return; - } - } - } - unless (chdir $udir) { - warn "Can't cd to $udir: $!\n"; - return; - } - } - - push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; - - while (defined $SE) { - unless ($bydepth) { - $dir= $p_dir; - $name= $dir_name; - $_= ($no_chdir ? $dir_name : $dir_rel ); - # prune may happen here - $prune= 0; - &$wanted_callback; - next if $prune; - } - - # change to that directory - unless ($no_chdir or $dir_rel eq '.') { - my $udir= $dir_rel; - if ($untaint) { - $udir = $1 if $dir_rel =~ m|$untaint_pat|; - unless (defined $udir) { - if ($untaint_skip == 0) { - die "directory (" - . ($p_dir ne '/' ? $p_dir : '') - . "/) $dir_rel is still tainted"; - } - } - } - unless (chdir $udir) { - warn "Can't cd to (" - . ($p_dir ne '/' ? $p_dir : '') - . "/) $udir : $!\n"; - next; - } - $CdLvl++; - } - - $dir= $dir_name; - - # Get the list of files in the current directory. - unless (opendir DIR, ($no_chdir ? $dir_name : '.')) { - warn "Can't opendir($dir_name): $!\n"; - next; - } - @filenames = readdir DIR; - closedir(DIR); - - if ($nlink == 2 && !$avoid_nlink) { - # This dir has no subdirectories. - for my $FN (@filenames) { - next if $FN =~ /^\.{1,2}\z/; - - $name = $dir_pref . $FN; - $_ = ($no_chdir ? $name : $FN); - &$wanted_callback; - } - - } - else { - # This dir has subdirectories. - $subcount = $nlink - 2; - - for my $FN (@filenames) { - next if $FN =~ /^\.{1,2}\z/; - if ($subcount > 0 || $avoid_nlink) { - # Seen all the subdirs? - # check for directoriness. - # stat is faster for a file in the current directory - $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3]; - - if (-d _) { - --$subcount; - $FN =~ s/\.dir\z// if $Is_VMS; - push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink]; - } - else { - $name = $dir_pref . $FN; - $_= ($no_chdir ? $name : $FN); - &$wanted_callback; - } - } - else { - $name = $dir_pref . $FN; - $_= ($no_chdir ? $name : $FN); - &$wanted_callback; - } - } - } - } - continue { - while ( defined ($SE = pop @Stack) ) { - ($Level, $p_dir, $dir_rel, $nlink) = @$SE; - if ($CdLvl > $Level && !$no_chdir) { - my $tmp = join('/',('..') x ($CdLvl-$Level)); - die "Can't cd to $dir_name" . $tmp - unless chdir ($tmp); - $CdLvl = $Level; - } - $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); - $dir_pref = "$dir_name/"; - if ( $nlink < 0 ) { # must be finddepth, report dirname now - $name = $dir_name; - if ( substr($name,-2) eq '/.' ) { - $name =~ s|/\.$||; - } - $dir = $p_dir; - $_ = ($no_chdir ? $dir_name : $dir_rel ); - if ( substr($_,-2) eq '/.' ) { - s|/\.$||; - } - &$wanted_callback; - } else { - push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; - last; - } - } - } -} - - -# API: -# $wanted -# $dir_loc : absolute location of a dir -# $p_dir : "parent directory" -# preconditions: -# chdir (if not no_chdir) to dir - -sub _find_dir_symlnk($$$) { - my ($wanted, $dir_loc, $p_dir) = @_; - my @Stack; - my @filenames; - my $new_loc; - my $pdir_loc = $dir_loc; - my $SE = []; - my $dir_name = $p_dir; - my $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" ); - my $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" ); - my $dir_rel = '.'; # directory name relative to current directory - my $byd_flag; # flag for pending stack entry if $bydepth - - local ($dir, $name, $fullname, $prune, *DIR); - - unless ($no_chdir or $p_dir eq '.') { - my $udir = $dir_loc; - if ($untaint) { - $udir = $1 if $dir_loc =~ m|$untaint_pat|; - unless (defined $udir) { - if ($untaint_skip == 0) { - die "directory $dir_loc is still tainted"; - } - else { - return; - } - } - } - unless (chdir $udir) { - warn "Can't cd to $udir: $!\n"; - return; - } - } - - push @Stack,[$dir_loc,$pdir_loc,$p_dir,$dir_rel,-1] if $bydepth; - - while (defined $SE) { - - unless ($bydepth) { - $dir= $p_dir; - $name= $dir_name; - $_= ($no_chdir ? $dir_name : $dir_rel ); - $fullname= $dir_loc; - # prune may happen here - $prune= 0; - &$wanted_callback; - next if $prune; - } - - # change to that directory - unless ($no_chdir or $dir_rel eq '.') { - my $udir = $dir_loc; - if ($untaint) { - $udir = $1 if $dir_loc =~ m|$untaint_pat|; - unless (defined $udir ) { - if ($untaint_skip == 0) { - die "directory $dir_loc is still tainted"; - } - else { - next; - } - } - } - unless (chdir $udir) { - warn "Can't cd to $udir: $!\n"; - next; - } - } - - $dir = $dir_name; - - # Get the list of files in the current directory. - unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) { - warn "Can't opendir($dir_loc): $!\n"; - next; - } - @filenames = readdir DIR; - closedir(DIR); - - for my $FN (@filenames) { - next if $FN =~ /^\.{1,2}\z/; - - # follow symbolic links / do an lstat - $new_loc = Follow_SymLink($loc_pref.$FN); - - # ignore if invalid symlink - next unless defined $new_loc; - - if (-d _) { - push @Stack,[$new_loc,$dir_loc,$dir_name,$FN,1]; - } - else { - $fullname = $new_loc; - $name = $dir_pref . $FN; - $_ = ($no_chdir ? $name : $FN); - &$wanted_callback; - } - } - - } - continue { - while (defined($SE = pop @Stack)) { - ($dir_loc, $pdir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE; - $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 or $dir_rel eq '.') { - my $udir = $pdir_loc; - if ($untaint) { - $udir = $1 if $dir_loc =~ m|$untaint_pat|; - } - unless (chdir $udir) { - warn "Can't cd to $udir: $!\n"; - next; - } - } - $fullname = $dir_loc; - $name = $dir_name; - if ( substr($name,-2) eq '/.' ) { - $name =~ s|/\.$||; - } - $dir = $p_dir; - $_ = ($no_chdir ? $dir_name : $dir_rel); - if ( substr($_,-2) eq '/.' ) { - s|/\.$||; - } - - &$wanted_callback; - } else { - push @Stack,[$dir_loc, $pdir_loc, $p_dir, $dir_rel,-1] if $bydepth; - last; - } - } - } -} - - -sub wrap_wanted { - my $wanted = shift; - if ( ref($wanted) eq 'HASH' ) { - if ( $wanted->{follow} || $wanted->{follow_fast}) { - $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip}; - } - if ( $wanted->{untaint} ) { - $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$| - unless defined $wanted->{untaint_pattern}; - $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip}; - } - return $wanted; - } - else { - return { wanted => $wanted }; - } -} - -sub find { - my $wanted = shift; - _find_opt(wrap_wanted($wanted), @_); - %SLnkSeen= (); # free memory -} - -sub finddepth { - my $wanted = wrap_wanted(shift); - $wanted->{bydepth} = 1; - _find_opt($wanted, @_); - %SLnkSeen= (); # free memory -} - -# These are hard-coded for now, but may move to hint files. -if ($^O eq 'VMS') { - $Is_VMS = 1; - $File::Find::dont_use_nlink = 1; -} - -$File::Find::dont_use_nlink = 1 - if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; - -# Set dont_use_nlink in your hint file if your system's stat doesn't -# report the number of links in a directory as an indication -# of the number of files. -# See, e.g. hints/machten.sh for MachTen 2.2. -unless ($File::Find::dont_use_nlink) { - require Config; - $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); -} - -1; diff --git a/contrib/perl5/lib/File/Path.pm b/contrib/perl5/lib/File/Path.pm deleted file mode 100644 index 46f360a461595..0000000000000 --- a/contrib/perl5/lib/File/Path.pm +++ /dev/null @@ -1,238 +0,0 @@ -package File::Path; - -=head1 NAME - -File::Path - create or remove directory trees - -=head1 SYNOPSIS - - use File::Path; - - mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); - rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); - -=head1 DESCRIPTION - -The C<mkpath> function provides a convenient way to create directories, even -if your C<mkdir> kernel call won't create more than one level of directory at -a time. C<mkpath> takes three arguments: - -=over 4 - -=item * - -the name of the path to create, or a reference -to a list of paths to create, - -=item * - -a boolean value, which if TRUE will cause C<mkpath> -to print the name of each directory as it is created -(defaults to FALSE), and - -=item * - -the numeric mode to use when creating the directories -(defaults to 0777) - -=back - -It returns a list of all directories (including intermediates, determined -using the Unix '/' separator) created. - -Similarly, the C<rmtree> function provides a convenient way to delete a -subtree from the directory structure, much like the Unix command C<rm -r>. -C<rmtree> takes three arguments: - -=over 4 - -=item * - -the root of the subtree to delete, or a reference to -a list of roots. All of the files and directories -below each root, as well as the roots themselves, -will be deleted. - -=item * - -a boolean value, which if TRUE will cause C<rmtree> to -print a message each time it examines a file, giving the -name of the file, and indicating whether it's using C<rmdir> -or C<unlink> to remove it, or that it's skipping it. -(defaults to FALSE) - -=item * - -a boolean value, which if TRUE will cause C<rmtree> to -skip any files to which you do not have delete access -(if running under VMS) or write access (if running -under another OS). This will change in the future when -a criterion for 'delete permission' under OSs other -than VMS is settled. (defaults to FALSE) - -=back - -It returns the number of files successfully deleted. Symlinks are -simply deleted and not followed. - -B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure> -in the face of failure or interruption. Files and directories which -were not deleted may be left with permissions reset to allow world -read and write access. Note also that the occurrence of errors in -rmtree can be determined I<only> by trapping diagnostic messages -using C<$SIG{__WARN__}>; it is not apparent from the return value. -Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0> -in situations where security is an issue. - -=head1 AUTHORS - -Tim Bunce <F<Tim.Bunce@ig.co.uk>> and -Charles Bailey <F<bailey@newman.upenn.edu>> - -=cut - -use 5.005_64; -use Carp; -use File::Basename (); -use Exporter (); -use strict; - -our $VERSION = "1.0403"; -our @ISA = qw( Exporter ); -our @EXPORT = qw( mkpath rmtree ); - -my $Is_VMS = $^O eq 'VMS'; - -# These OSes complain if you want to remove a file that you have no -# write permission to: -my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' - || $^O eq 'amigaos'); - -sub mkpath { - my($paths, $verbose, $mode) = @_; - # $paths -- either a path string or ref to list of paths - # $verbose -- optional print "mkdir $path" for each directory created - # $mode -- optional permissions, defaults to 0777 - local($")="/"; - $mode = 0777 unless defined($mode); - $paths = [$paths] unless ref $paths; - my(@created,$path); - foreach $path (@$paths) { - $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT - next if -d $path; - # Logic wants Unix paths, so go with the flow. - $path = VMS::Filespec::unixify($path) if $Is_VMS; - my $parent = File::Basename::dirname($path); - # Allow for creation of new logical filesystems under VMS - if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) { - unless (-d $parent or $path eq $parent) { - push(@created,mkpath($parent, $verbose, $mode)); - } - } - print "mkdir $path\n" if $verbose; - unless (mkdir($path,$mode)) { - my $e = $!; - # allow for another process to have created it meanwhile - croak "mkdir $path: $e" unless -d $path; - } - push(@created, $path); - } - @created; -} - -sub rmtree { - my($roots, $verbose, $safe) = @_; - my(@files); - my($count) = 0; - $verbose ||= 0; - $safe ||= 0; - - if ( defined($roots) && length($roots) ) { - $roots = [$roots] unless ref $roots; - } - else { - carp "No root path(s) specified\n"; - return 0; - } - - my($root); - foreach $root (@{$roots}) { - $root =~ s#/\z##; - (undef, undef, my $rp) = lstat $root or next; - $rp &= 07777; # don't forget setuid, setgid, sticky bits - if ( -d _ ) { - # notabene: 0777 is for making readable in the first place, - # it's also intended to change it to writable in case we have - # to recurse in which case we are better than rm -rf for - # subtrees with strange permissions - chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) - or carp "Can't make directory $root read+writeable: $!" - unless $safe; - - if (opendir my $d, $root) { - @files = readdir $d; - closedir $d; - } - else { - carp "Can't read $root: $!"; - @files = (); - } - - # Deleting large numbers of files from VMS Files-11 filesystems - # is faster if done in reverse ASCIIbetical order - @files = reverse @files if $Is_VMS; - ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS; - @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files); - $count += rmtree(\@files,$verbose,$safe); - if ($safe && - ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { - print "skipped $root\n" if $verbose; - next; - } - chmod 0777, $root - or carp "Can't make directory $root writeable: $!" - if $force_writeable; - print "rmdir $root\n" if $verbose; - if (rmdir $root) { - ++$count; - } - else { - carp "Can't remove directory $root: $!"; - chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) - or carp("and can't restore permissions to " - . sprintf("0%o",$rp) . "\n"); - } - } - else { - if ($safe && - ($Is_VMS ? !&VMS::Filespec::candelete($root) - : !(-l $root || -w $root))) - { - print "skipped $root\n" if $verbose; - next; - } - chmod 0666, $root - or carp "Can't make file $root writeable: $!" - if $force_writeable; - print "unlink $root\n" if $verbose; - # delete all versions under VMS - for (;;) { - unless (unlink $root) { - carp "Can't unlink file $root: $!"; - if ($force_writeable) { - chmod $rp, $root - or carp("and can't restore permissions to " - . sprintf("0%o",$rp) . "\n"); - } - last; - } - ++$count; - last unless $Is_VMS && lstat $root; - } - } - } - - $count; -} - -1; diff --git a/contrib/perl5/lib/File/Spec.pm b/contrib/perl5/lib/File/Spec.pm deleted file mode 100644 index 40f5345140c7f..0000000000000 --- a/contrib/perl5/lib/File/Spec.pm +++ /dev/null @@ -1,92 +0,0 @@ -package File::Spec; - -use strict; -use vars qw(@ISA $VERSION); - -$VERSION = '0.8'; - -my %module = (MacOS => 'Mac', - MSWin32 => 'Win32', - os2 => 'OS2', - VMS => 'VMS'); - -my $module = $module{$^O} || 'Unix'; -require "File/Spec/$module.pm"; -@ISA = ("File::Spec::$module"); - -1; -__END__ - -=head1 NAME - -File::Spec - portably perform operations on file names - -=head1 SYNOPSIS - - use File::Spec; - - $x=File::Spec->catfile('a', 'b', 'c'); - -which returns 'a/b/c' under Unix. Or: - - use File::Spec::Functions; - - $x = catfile('a', 'b', 'c'); - -=head1 DESCRIPTION - -This module is designed to support operations commonly performed on file -specifications (usually called "file names", but not to be confused with the -contents of a file, or Perl's file handles), such as concatenating several -directory and file names into a single path, or determining whether a path -is rooted. It is based on code directly taken from MakeMaker 5.17, code -written by Andreas KE<ouml>nig, Andy Dougherty, Charles Bailey, Ilya -Zakharevich, Paul Schinder, and others. - -Since these functions are different for most operating systems, each set of -OS specific routines is available in a separate module, including: - - File::Spec::Unix - File::Spec::Mac - File::Spec::OS2 - File::Spec::Win32 - File::Spec::VMS - -The module appropriate for the current OS is automatically loaded by -File::Spec. Since some modules (like VMS) make use of facilities available -only under that OS, it may not be possible to load all modules under all -operating systems. - -Since File::Spec is object oriented, subroutines should not called directly, -as in: - - File::Spec::catfile('a','b'); - -but rather as class methods: - - File::Spec->catfile('a','b'); - -For simple uses, L<File::Spec::Functions> provides convenient functional -forms of these methods. - -For a list of available methods, please consult L<File::Spec::Unix>, -which contains the entire set, and which is inherited by the modules for -other platforms. For further information, please see L<File::Spec::Mac>, -L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>. - -=head1 SEE ALSO - -File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, File::Spec::Win32, -File::Spec::VMS, File::Spec::Functions, ExtUtils::MakeMaker - -=head1 AUTHORS - -Kenneth Albanowski <F<kjahds@kjahds.com>>, Andy Dougherty -<F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig -<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>. VMS -support by Charles Bailey <F<bailey@newman.upenn.edu>>. OS/2 support by -Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Mac support by Paul Schinder -<F<schinder@pobox.com>>. abs2rel() and rel2abs() written by -Shigio Yamaguchi <F<shigio@tamacom.com>>, modified by Barrie Slaymaker -<F<barries@slaysys.com>>. splitpath(), splitdir(), catpath() and catdir() -by Barrie Slaymaker. diff --git a/contrib/perl5/lib/File/Spec/Functions.pm b/contrib/perl5/lib/File/Spec/Functions.pm deleted file mode 100644 index 140738f443986..0000000000000 --- a/contrib/perl5/lib/File/Spec/Functions.pm +++ /dev/null @@ -1,95 +0,0 @@ -package File::Spec::Functions; - -use File::Spec; -use strict; - -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - -require Exporter; - -@ISA = qw(Exporter); - -@EXPORT = qw( - canonpath - catdir - catfile - curdir - rootdir - updir - no_upwards - file_name_is_absolute - path -); - -@EXPORT_OK = qw( - devnull - tmpdir - splitpath - splitdir - catpath - abs2rel - rel2abs -); - -%EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] ); - -foreach my $meth (@EXPORT, @EXPORT_OK) { - my $sub = File::Spec->can($meth); - no strict 'refs'; - *{$meth} = sub {&$sub('File::Spec', @_)}; -} - - -1; -__END__ - -=head1 NAME - -File::Spec::Functions - portably perform operations on file names - -=head1 SYNOPSIS - - use File::Spec::Functions; - $x = catfile('a','b'); - -=head1 DESCRIPTION - -This module exports convenience functions for all of the class methods -provided by File::Spec. - -For a reference of available functions, please consult L<File::Spec::Unix>, -which contains the entire set, and which is inherited by the modules for -other platforms. For further information, please see L<File::Spec::Mac>, -L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>. - -=head2 Exports - -The following functions are exported by default. - - canonpath - catdir - catfile - curdir - rootdir - updir - no_upwards - file_name_is_absolute - path - - -The following functions are exported only by request. - - devnull - tmpdir - splitpath - splitdir - catpath - abs2rel - rel2abs - -All the functions may be imported using the C<:ALL> tag. - -=head1 SEE ALSO - -File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, -File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker diff --git a/contrib/perl5/lib/File/Spec/Mac.pm b/contrib/perl5/lib/File/Spec/Mac.pm deleted file mode 100644 index 959e33d0cf3bc..0000000000000 --- a/contrib/perl5/lib/File/Spec/Mac.pm +++ /dev/null @@ -1,397 +0,0 @@ -package File::Spec::Mac; - -use strict; -use vars qw(@ISA); -require File::Spec::Unix; -@ISA = qw(File::Spec::Unix); - -=head1 NAME - -File::Spec::Mac - File::Spec for MacOS - -=head1 SYNOPSIS - - require File::Spec::Mac; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -Methods for manipulating file specifications. - -=head1 METHODS - -=over 2 - -=item canonpath - -On MacOS, there's nothing to be done. Returns what it's given. - -=cut - -sub canonpath { - my ($self,$path) = @_; - return $path; -} - -=item catdir - -Concatenate two or more directory names to form a complete path ending with -a directory. Put a trailing : on the end of the complete path if there -isn't one, because that's what's done in MacPerl's environment. - -The fundamental requirement of this routine is that - - File::Spec->catdir(split(":",$path)) eq $path - -But because of the nature of Macintosh paths, some additional -possibilities are allowed to make using this routine give reasonable results -for some common situations. Here are the rules that are used. Each -argument has its trailing ":" removed. Each argument, except the first, -has its leading ":" removed. They are then joined together by a ":". - -So - - File::Spec->catdir("a","b") = "a:b:" - File::Spec->catdir("a:",":b") = "a:b:" - File::Spec->catdir("a:","b") = "a:b:" - File::Spec->catdir("a",":b") = "a:b" - File::Spec->catdir("a","","b") = "a::b" - -etc. - -To get a relative path (one beginning with :), begin the first argument with : -or put a "" as the first argument. - -If you don't want to worry about these rules, never allow a ":" on the ends -of any of the arguments except at the beginning of the first. - -Under MacPerl, there is an additional ambiguity. Does the user intend that - - File::Spec->catfile("LWP","Protocol","http.pm") - -be relative or absolute? There's no way of telling except by checking for the -existence of LWP: or :LWP, and even there he may mean a dismounted volume or -a relative path in a different directory (like in @INC). So those checks -aren't done here. This routine will treat this as absolute. - -=cut - -sub catdir { - shift; - my @args = @_; - my $result = shift @args; - $result =~ s/:\z//; - foreach (@args) { - s/:\z//; - s/^://s; - $result .= ":$_"; - } - return "$result:"; -} - -=item catfile - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename. Since this uses catdir, the -same caveats apply. Note that the leading : is removed from the filename, -so that - - File::Spec->catfile($ENV{HOME},"file"); - -and - - File::Spec->catfile($ENV{HOME},":file"); - -give the same answer, as one might expect. - -=cut - -sub catfile { - my $self = shift; - my $file = pop @_; - return $file unless @_; - my $dir = $self->catdir(@_); - $file =~ s/^://s; - return $dir.$file; -} - -=item curdir - -Returns a string representing the current directory. - -=cut - -sub curdir { - return ":"; -} - -=item devnull - -Returns a string representing the null device. - -=cut - -sub devnull { - return "Dev:Null"; -} - -=item rootdir - -Returns a string representing the root directory. Under MacPerl, -returns the name of the startup volume, since that's the closest in -concept, although other volumes aren't rooted there. - -=cut - -sub rootdir { -# -# There's no real root directory on MacOS. The name of the startup -# volume is returned, since that's the closest in concept. -# - require Mac::Files; - my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, - &Mac::Files::kSystemFolderType); - $system =~ s/:.*\z/:/s; - return $system; -} - -=item tmpdir - -Returns a string representation of the first existing directory -from the following list or '' if none exist: - - $ENV{TMPDIR} - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR}; - $tmpdir = '' unless defined $tmpdir; - return $tmpdir; -} - -=item updir - -Returns a string representing the parent directory. - -=cut - -sub updir { - return "::"; -} - -=item file_name_is_absolute - -Takes as argument a path and returns true, if it is an absolute path. In -the case where a name can be either relative or absolute (for example, a -folder named "HD" in the current working directory on a drive named "HD"), -relative wins. Use ":" in the appropriate place in the path if you want to -distinguish unambiguously. - -=cut - -sub file_name_is_absolute { - my ($self,$file) = @_; - if ($file =~ /:/) { - return ($file !~ m/^:/s); - } else { - return (! -e ":$file"); - } -} - -=item path - -Returns the null list for the MacPerl application, since the concept is -usually meaningless under MacOS. But if you're using the MacPerl tool under -MPW, it gives back $ENV{Commands} suitably split, as is done in -:lib:ExtUtils:MM_Mac.pm. - -=cut - -sub path { -# -# The concept is meaningless under the MacPerl application. -# Under MPW, it has a meaning. -# - return unless exists $ENV{Commands}; - return split(/,/, $ENV{Commands}); -} - -=item splitpath - -=cut - -sub splitpath { - my ($self,$path, $nofile) = @_; - - my ($volume,$directory,$file) = ('','',''); - - if ( $nofile ) { - ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\z))?)(.*)@s; - } - else { - $path =~ - m@^( (?: [^:]+: )? ) - ( (?: .*: )? ) - ( .* ) - @xs; - $volume = $1; - $directory = $2; - $file = $3; - } - - # Make sure non-empty volumes and directories end in ':' - $volume .= ':' if $volume =~ m@[^:]\z@ ; - $directory .= ':' if $directory =~ m@[^:]\z@ ; - return ($volume,$directory,$file); -} - - -=item splitdir - -=cut - -sub splitdir { - my ($self,$directories) = @_ ; - # - # split() likes to forget about trailing null fields, so here we - # check to be sure that there will not be any before handling the - # simple case. - # - if ( $directories !~ m@:\z@ ) { - return split( m@:@, $directories ); - } - else { - # - # since there was a trailing separator, add a file name to the end, - # then do the split, then replace it with ''. - # - my( @directories )= split( m@:@, "${directories}dummy" ) ; - $directories[ $#directories ]= '' ; - return @directories ; - } -} - - -=item catpath - -=cut - -sub catpath { - my $self = shift ; - - my $result = shift ; - $result =~ s@^([^/])@/$1@s ; - - my $segment ; - for $segment ( @_ ) { - if ( $result =~ m@[^/]\z@ && $segment =~ m@^[^/]@s ) { - $result .= "/$segment" ; - } - elsif ( $result =~ m@/\z@ && $segment =~ m@^/@s ) { - $result =~ s@/+\z@/@; - $segment =~ s@^/+@@s; - $result .= "$segment" ; - } - else { - $result .= $segment ; - } - } - - return $result ; -} - -=item abs2rel - -=cut - -sub abs2rel { - my($self,$path,$base) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path ); - my @basechunks = $self->splitdir( $base ); - - while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) { - shift @pathchunks ; - shift @basechunks ; - } - - $path = join( ':', @pathchunks ); - - # @basechunks now contains the number of directories to climb out of. - $base = ':' x @basechunks ; - - return "$base:$path" ; -} - -=item rel2abs - -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; - -If $base is not present or '', then L<cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()>. - -On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $destination volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L</canonpath()>. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - -sub rel2abs($;$;) { - my ($self,$path,$base ) = @_; - - if ( ! $self->file_name_is_absolute( $path ) ) { - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - $path = $self->canonpath("$base$path") ; - } - - return $path ; -} - - -=back - -=head1 SEE ALSO - -L<File::Spec> - -=cut - -1; diff --git a/contrib/perl5/lib/File/Spec/OS2.pm b/contrib/perl5/lib/File/Spec/OS2.pm deleted file mode 100644 index 33370f06c1959..0000000000000 --- a/contrib/perl5/lib/File/Spec/OS2.pm +++ /dev/null @@ -1,59 +0,0 @@ -package File::Spec::OS2; - -use strict; -use vars qw(@ISA); -require File::Spec::Unix; -@ISA = qw(File::Spec::Unix); - -sub devnull { - return "/dev/nul"; -} - -sub case_tolerant { - return 1; -} - -sub file_name_is_absolute { - my ($self,$file) = @_; - return scalar($file =~ m{^([a-z]:)?[\\/]}is); -} - -sub path { - my $path = $ENV{PATH}; - $path =~ s:\\:/:g; - my @path = split(';',$path); - foreach (@path) { $_ = '.' if $_ eq '' } - return @path; -} - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - my $self = shift; - foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) { - next unless defined && -d; - $tmpdir = $_; - last; - } - $tmpdir = '' unless defined $tmpdir; - $tmpdir =~ s:\\:/:g; - $tmpdir = $self->canonpath($tmpdir); - return $tmpdir; -} - -1; -__END__ - -=head1 NAME - -File::Spec::OS2 - methods for OS/2 file specs - -=head1 SYNOPSIS - - require File::Spec::OS2; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See File::Spec::Unix for a documentation of the methods provided -there. This package overrides the implementation of these methods, not -the semantics. diff --git a/contrib/perl5/lib/File/Spec/Unix.pm b/contrib/perl5/lib/File/Spec/Unix.pm deleted file mode 100644 index 2305b75b761f8..0000000000000 --- a/contrib/perl5/lib/File/Spec/Unix.pm +++ /dev/null @@ -1,442 +0,0 @@ -package File::Spec::Unix; - -use strict; - -use Cwd; - -=head1 NAME - -File::Spec::Unix - methods used by File::Spec - -=head1 SYNOPSIS - - require File::Spec::Unix; # Done automatically by File::Spec - -=head1 DESCRIPTION - -Methods for manipulating file specifications. - -=head1 METHODS - -=over 2 - -=item canonpath - -No physical check on the filesystem, but a logical cleanup of a -path. On UNIX eliminated successive slashes and successive "/.". - - $cpath = File::Spec->canonpath( $path ) ; - -=cut - -sub canonpath { - my ($self,$path) = @_; - $path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx - $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx - $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx - $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx - $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx - return $path; -} - -=item catdir - -Concatenate two or more directory names to form a complete path ending -with a directory. But remove the trailing slash from the resulting -string, because it doesn't look good, isn't necessary and confuses -OS2. Of course, if this is the root directory, don't cut off the -trailing slash :-) - -=cut - -sub catdir { - my $self = shift; - my @args = @_; - foreach (@args) { - # append a slash to each argument unless it has one there - $_ .= "/" if $_ eq '' || substr($_,-1) ne "/"; - } - return $self->canonpath(join('', @args)); -} - -=item catfile - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename - -=cut - -sub catfile { - my $self = shift; - my $file = pop @_; - return $file unless @_; - my $dir = $self->catdir(@_); - $dir .= "/" unless substr($dir,-1) eq "/"; - return $dir.$file; -} - -=item curdir - -Returns a string representation of the current directory. "." on UNIX. - -=cut - -sub curdir { - return "."; -} - -=item devnull - -Returns a string representation of the null device. "/dev/null" on UNIX. - -=cut - -sub devnull { - return "/dev/null"; -} - -=item rootdir - -Returns a string representation of the root directory. "/" on UNIX. - -=cut - -sub rootdir { - return "/"; -} - -=item tmpdir - -Returns a string representation of the first writable directory -from the following list or "" if none are writable: - - $ENV{TMPDIR} - /tmp - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - foreach ($ENV{TMPDIR}, "/tmp") { - next unless defined && -d && -w _; - $tmpdir = $_; - last; - } - $tmpdir = '' unless defined $tmpdir; - return $tmpdir; -} - -=item updir - -Returns a string representation of the parent directory. ".." on UNIX. - -=cut - -sub updir { - return ".."; -} - -=item no_upwards - -Given a list of file names, strip out those that refer to a parent -directory. (Does not strip symlinks, only '.', '..', and equivalents.) - -=cut - -sub no_upwards { - my $self = shift; - return grep(!/^\.{1,2}\z/s, @_); -} - -=item case_tolerant - -Returns a true or false value indicating, respectively, that alphabetic -is not or is significant when comparing file specifications. - -=cut - -sub case_tolerant { - return 0; -} - -=item file_name_is_absolute - -Takes as argument a path and returns true, if it is an absolute path. - -=cut - -sub file_name_is_absolute { - my ($self,$file) = @_; - return scalar($file =~ m:^/:s); -} - -=item path - -Takes no argument, returns the environment variable PATH as an array. - -=cut - -sub path { - my @path = split(':', $ENV{PATH}); - foreach (@path) { $_ = '.' if $_ eq '' } - return @path; -} - -=item join - -join is the same as catfile. - -=cut - -sub join { - my $self = shift; - return $self->catfile(@_); -} - -=item splitpath - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -Splits a path in to volume, directory, and filename portions. On systems -with no concept of volume, returns undef for volume. - -For systems with no syntax differentiating filenames from directories, -assumes that the last file is a path unless $no_file is true or a -trailing separator or /. or /.. is present. On Unix this means that $no_file -true makes this return ( '', $path, '' ). - -The directory portion may or may not be returned with a trailing '/'. - -The results can be passed to L</catpath()> to get back a path equivalent to -(usually identical to) the original path. - -=cut - -sub splitpath { - my ($self,$path, $nofile) = @_; - - my ($volume,$directory,$file) = ('','',''); - - if ( $nofile ) { - $directory = $path; - } - else { - $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs; - $directory = $1; - $file = $2; - } - - return ($volume,$directory,$file); -} - - -=item splitdir - -The opposite of L</catdir()>. - - @dirs = File::Spec->splitdir( $directories ); - -$directories must be only the directory portion of the path on systems -that have the concept of a volume or that have path syntax that differentiates -files from directories. - -Unlike just splitting the directories on the separator, empty -directory names (C<''>) can be returned, because these are significant -on some OSs (e.g. MacOS). - -On Unix, - - File::Spec->splitdir( "/a/b//c/" ); - -Yields: - - ( '', 'a', 'b', '', 'c', '' ) - -=cut - -sub splitdir { - my ($self,$directories) = @_ ; - # - # split() likes to forget about trailing null fields, so here we - # check to be sure that there will not be any before handling the - # simple case. - # - if ( $directories !~ m|/\z| ) { - return split( m|/|, $directories ); - } - else { - # - # since there was a trailing separator, add a file name to the end, - # then do the split, then replace it with ''. - # - my( @directories )= split( m|/|, "${directories}dummy" ) ; - $directories[ $#directories ]= '' ; - return @directories ; - } -} - - -=item catpath - -Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and directory and file are catenated. A '/' is -inserted if need be. On other OSs, $volume is significant. - -=cut - -sub catpath { - my ($self,$volume,$directory,$file) = @_; - - if ( $directory ne '' && - $file ne '' && - substr( $directory, -1 ) ne '/' && - substr( $file, 0, 1 ) ne '/' - ) { - $directory .= "/$file" ; - } - else { - $directory .= $file ; - } - - return $directory ; -} - -=item abs2rel - -Takes a destination path and an optional base path returns a relative path -from the base path to the destination path: - - $rel_path = File::Spec->abs2rel( $destination ) ; - $rel_path = File::Spec->abs2rel( $destination, $base ) ; - -If $base is not present or '', then L<cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()>. - -On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is relative, it is converted to absolute form using L</rel2abs()>. -This means that it is taken to be relative to L<cwd()>. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - -sub abs2rel { - my($self,$path,$base) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - else { - $path = $self->canonpath( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path); - my @basechunks = $self->splitdir( $base); - - while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) { - shift @pathchunks ; - shift @basechunks ; - } - - $path = CORE::join( '/', @pathchunks ); - $base = CORE::join( '/', @basechunks ); - - # $base now contains the directories the resulting relative path - # must ascend out of before it can descend to $path_directory. So, - # replace all names with $parentDir - $base =~ s|[^/]+|..|g ; - - # Glue the two together, using a separator if necessary, and preventing an - # empty result. - if ( $path ne '' && $base ne '' ) { - $path = "$base/$path" ; - } else { - $path = "$base$path" ; - } - - return $self->canonpath( $path ) ; -} - -=item rel2abs - -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; - -If $base is not present or '', then L<cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()>. - -On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $destination volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L</canonpath()>. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - -sub rel2abs($;$;) { - my ($self,$path,$base ) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - # Glom them together - $path = $self->catdir( $base, $path ) ; - } - - return $self->canonpath( $path ) ; -} - - -=back - -=head1 SEE ALSO - -L<File::Spec> - -=cut - -1; diff --git a/contrib/perl5/lib/File/Spec/VMS.pm b/contrib/perl5/lib/File/Spec/VMS.pm deleted file mode 100644 index a2ac8cac0bb53..0000000000000 --- a/contrib/perl5/lib/File/Spec/VMS.pm +++ /dev/null @@ -1,492 +0,0 @@ -package File::Spec::VMS; - -use strict; -use vars qw(@ISA); -require File::Spec::Unix; -@ISA = qw(File::Spec::Unix); - -use Cwd; -use File::Basename; -use VMS::Filespec; - -=head1 NAME - -File::Spec::VMS - methods for VMS file specs - -=head1 SYNOPSIS - - require File::Spec::VMS; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See File::Spec::Unix for a documentation of the methods provided -there. This package overrides the implementation of these methods, not -the semantics. - -=over - -=item eliminate_macros - -Expands MM[KS]/Make macros in a text string, using the contents of -identically named elements of C<%$self>, and returns the result -as a file specification in Unix syntax. - -=cut - -sub eliminate_macros { - my($self,$path) = @_; - return '' unless $path; - $self = {} unless ref $self; - my($npath) = unixify($path); - my($complex) = 0; - my($head,$macro,$tail); - - # perform m##g in scalar context so it acts as an iterator - while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { - if ($self->{$2}) { - ($head,$macro,$tail) = ($1,$2,$3); - if (ref $self->{$macro}) { - if (ref $self->{$macro} eq 'ARRAY') { - $macro = join ' ', @{$self->{$macro}}; - } - else { - print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}), - "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n"; - $macro = "\cB$macro\cB"; - $complex = 1; - } - } - else { ($macro = unixify($self->{$macro})) =~ s#/\z##; } - $npath = "$head$macro$tail"; - } - } - if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; } - $npath; -} - -=item fixpath - -Catchall routine to clean up problem MM[SK]/Make macros. Expands macros -in any directory specification, in order to avoid juxtaposing two -VMS-syntax directories when MM[SK] is run. Also expands expressions which -are all macro, so that we can tell how long the expansion is, and avoid -overrunning DCL's command buffer when MM[KS] is running. - -If optional second argument has a TRUE value, then the return string is -a VMS-syntax directory specification, if it is FALSE, the return string -is a VMS-syntax file specification, and if it is not specified, fixpath() -checks to see whether it matches the name of a directory in the current -default directory, and returns a directory or file specification accordingly. - -=cut - -sub fixpath { - my($self,$path,$force_path) = @_; - return '' unless $path; - $self = bless {} unless ref $self; - my($fixedpath,$prefix,$name); - - if ($path =~ m#^\$\([^\)]+\)\z#s || $path =~ m#[/:>\]]#) { - if ($force_path or $path =~ /(?:DIR\)|\])\z/) { - $fixedpath = vmspath($self->eliminate_macros($path)); - } - else { - $fixedpath = vmsify($self->eliminate_macros($path)); - } - } - elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) { - my($vmspre) = $self->eliminate_macros("\$($prefix)"); - # is it a dir or just a name? - $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\z/) ? vmspath($vmspre) : ''; - $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; - $fixedpath = vmspath($fixedpath) if $force_path; - } - else { - $fixedpath = $path; - $fixedpath = vmspath($fixedpath) if $force_path; - } - # No hints, so we try to guess - if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) { - $fixedpath = vmspath($fixedpath) if -d $fixedpath; - } - - # Trim off root dirname if it's had other dirs inserted in front of it. - $fixedpath =~ s/\.000000([\]>])/$1/; - # Special case for VMS absolute directory specs: these will have had device - # prepended during trip through Unix syntax in eliminate_macros(), since - # Unix syntax has no way to express "absolute from the top of this device's - # directory tree". - if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; } - $fixedpath; -} - -=back - -=head2 Methods always loaded - -=over - -=item canonpath (override) - -Removes redundant portions of file specifications according to VMS syntax. - -=cut - -sub canonpath { - my($self,$path) = @_; - - if ($path =~ m|/|) { # Fake Unix - my $pathify = $path =~ m|/\z|; - $path = $self->SUPER::canonpath($path); - if ($pathify) { return vmspath($path); } - else { return vmsify($path); } - } - else { - $path =~ s-\]\[--g; $path =~ s/><//g; # foo.][bar ==> foo.bar - $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo - 1 while $path =~ s{([\[<-])\.-}{$1-}; # [.-.- ==> [-- - $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/; # bar.foo.-] ==> bar] - $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s - $path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g; # bar.-.foo ==> foo - $path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode - return $path; - } -} - -=item catdir - -Concatenates a list of file specifications, and returns the result as a -VMS-syntax directory specification. No check is made for "impossible" -cases (e.g. elements other than the first being absolute filespecs). - -=cut - -sub catdir { - my ($self,@dirs) = @_; - my $dir = pop @dirs; - @dirs = grep($_,@dirs); - my $rslt; - if (@dirs) { - my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); - my ($spath,$sdir) = ($path,$dir); - $spath =~ s/\.dir\z//; $sdir =~ s/\.dir\z//; - $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\z/s; - $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); - - # Special case for VMS absolute directory specs: these will have had device - # prepended during trip through Unix syntax in eliminate_macros(), since - # Unix syntax has no way to express "absolute from the top of this device's - # directory tree". - if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; } - } - else { - if (not defined $dir or not length $dir) { $rslt = ''; } - elsif ($dir =~ /^\$\([^\)]+\)\z/s) { $rslt = $dir; } - else { $rslt = vmspath($dir); } - } - return $self->canonpath($rslt); -} - -=item catfile - -Concatenates a list of file specifications, and returns the result as a -VMS-syntax file specification. - -=cut - -sub catfile { - my ($self,@files) = @_; - my $file = pop @files; - @files = grep($_,@files); - my $rslt; - if (@files) { - my $path = (@files == 1 ? $files[0] : $self->catdir(@files)); - my $spath = $path; - $spath =~ s/\.dir\z//; - if ($spath =~ /^[^\)\]\/:>]+\)\z/s && basename($file) eq $file) { - $rslt = "$spath$file"; - } - else { - $rslt = $self->eliminate_macros($spath); - $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file)); - } - } - else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; } - return $self->canonpath($rslt); -} - - -=item curdir (override) - -Returns a string representation of the current directory: '[]' - -=cut - -sub curdir { - return '[]'; -} - -=item devnull (override) - -Returns a string representation of the null device: '_NLA0:' - -=cut - -sub devnull { - return "_NLA0:"; -} - -=item rootdir (override) - -Returns a string representation of the root directory: 'SYS$DISK:[000000]' - -=cut - -sub rootdir { - return 'SYS$DISK:[000000]'; -} - -=item tmpdir (override) - -Returns a string representation of the first writable directory -from the following list or '' if none are writable: - - sys$scratch - $ENV{TMPDIR} - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - foreach ('sys$scratch', $ENV{TMPDIR}) { - next unless defined && -d && -w _; - $tmpdir = $_; - last; - } - $tmpdir = '' unless defined $tmpdir; - return $tmpdir; -} - -=item updir (override) - -Returns a string representation of the parent directory: '[-]' - -=cut - -sub updir { - return '[-]'; -} - -=item case_tolerant (override) - -VMS file specification syntax is case-tolerant. - -=cut - -sub case_tolerant { - return 1; -} - -=item path (override) - -Translate logical name DCL$PATH as a searchlist, rather than trying -to C<split> string value of C<$ENV{'PATH'}>. - -=cut - -sub path { - my (@dirs,$dir,$i); - while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } - return @dirs; -} - -=item file_name_is_absolute (override) - -Checks for VMS directory spec as well as Unix separators. - -=cut - -sub file_name_is_absolute { - my ($self,$file) = @_; - # If it's a logical name, expand it. - $file = $ENV{$file} while $file =~ /^[\w\$\-]+\z/s && $ENV{$file}; - return scalar($file =~ m!^/!s || - $file =~ m![<\[][^.\-\]>]! || - $file =~ /:[^<\[]/); -} - -=item splitpath (override) - -Splits using VMS syntax. - -=cut - -sub splitpath { - my($self,$path) = @_; - my($dev,$dir,$file) = ('','',''); - - vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s; - return ($1 || '',$2 || '',$3); -} - -=item splitdir (override) - -Split dirspec using VMS syntax. - -=cut - -sub splitdir { - my($self,$dirspec) = @_; - $dirspec =~ s/\]\[//g; $dirspec =~ s/\-\-/-.-/g; - $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal - my(@dirs) = split('\.', vmspath($dirspec)); - $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\z//s; - @dirs; -} - - -=item catpath (override) - -Construct a complete filespec using VMS syntax - -=cut - -sub catpath { - my($self,$dev,$dir,$file) = @_; - if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; } - else { $dev .= ':' unless $dev eq '' or $dev =~ /:\z/; } - if (length($dev) or length($dir)) { - $dir = "[$dir]" unless $dir =~ /[\[<\/]/; - $dir = vmspath($dir); - } - "$dev$dir$file"; -} - -=item abs2rel (override) - -Use VMS syntax when converting filespecs. - -=cut - -sub abs2rel { - my $self = shift; - - return vmspath(File::Spec::Unix::abs2rel( $self, @_ )) - if ( join( '', @_ ) =~ m{/} ) ; - - my($path,$base) = @_; - - # Note: we use '/' to glue things together here, then let canonpath() - # clean them up at the end. - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - else { - $path = $self->canonpath( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - # Split up paths - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path, 1 ) ; - - $path_directories = $1 - if $path_directories =~ /^\[(.*)\]\z/s ; - - my ( undef, $base_directories, undef ) = - $self->splitpath( $base, 1 ) ; - - $base_directories = $1 - if $base_directories =~ /^\[(.*)\]\z/s ; - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path_directories ); - my @basechunks = $self->splitdir( $base_directories ); - - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) - ) { - shift @pathchunks ; - shift @basechunks ; - } - - # @basechunks now contains the directories to climb out of, - # @pathchunks now has the directories to descend in to. - $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ; - $path_directories =~ s{\.\z}{} ; - return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ; -} - - -=item rel2abs (override) - -Use VMS syntax when converting filespecs. - -=cut - -sub rel2abs($;$;) { - my $self = shift ; - return vmspath(File::Spec::Unix::rel2abs( $self, @_ )) - if ( join( '', @_ ) =~ m{/} ) ; - - my ($path,$base ) = @_; - # Clean up and split up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - # Split up paths - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path ) ; - - my ( $base_volume, $base_directories, undef ) = - $self->splitpath( $base ) ; - - $path_directories = '' if $path_directories eq '[]' || - $path_directories eq '<>'; - my $sep = '' ; - $sep = '.' - if ( $base_directories =~ m{[^.\]>]\z} && - $path_directories =~ m{^[^.\[<]}s - ) ; - $base_directories = "$base_directories$sep$path_directories"; - $base_directories =~ s{\.?[\]>][\[<]\.?}{.}; - - $path = $self->catpath( $base_volume, $base_directories, $path_file ); - } - - return $self->canonpath( $path ) ; -} - - -=back - -=head1 SEE ALSO - -L<File::Spec> - -=cut - -1; diff --git a/contrib/perl5/lib/File/Spec/Win32.pm b/contrib/perl5/lib/File/Spec/Win32.pm deleted file mode 100644 index aa95fbde363e4..0000000000000 --- a/contrib/perl5/lib/File/Spec/Win32.pm +++ /dev/null @@ -1,405 +0,0 @@ -package File::Spec::Win32; - -use strict; -use Cwd; -use vars qw(@ISA); -require File::Spec::Unix; -@ISA = qw(File::Spec::Unix); - -=head1 NAME - -File::Spec::Win32 - methods for Win32 file specs - -=head1 SYNOPSIS - - require File::Spec::Win32; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See File::Spec::Unix for a documentation of the methods provided -there. This package overrides the implementation of these methods, not -the semantics. - -=over - -=item devnull - -Returns a string representation of the null device. - -=cut - -sub devnull { - return "nul"; -} - -=item tmpdir - -Returns a string representation of the first existing directory -from the following list: - - $ENV{TMPDIR} - $ENV{TEMP} - $ENV{TMP} - /tmp - / - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - my $self = shift; - foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) { - next unless defined && -d; - $tmpdir = $_; - last; - } - $tmpdir = '' unless defined $tmpdir; - $tmpdir = $self->canonpath($tmpdir); - return $tmpdir; -} - -sub case_tolerant { - return 1; -} - -sub file_name_is_absolute { - my ($self,$file) = @_; - return scalar($file =~ m{^([a-z]:)?[\\/]}is); -} - -=item catfile - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename - -=cut - -sub catfile { - my $self = shift; - my $file = pop @_; - return $file unless @_; - my $dir = $self->catdir(@_); - $dir .= "\\" unless substr($dir,-1) eq "\\"; - return $dir.$file; -} - -sub path { - my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; - my @path = split(';',$path); - foreach (@path) { $_ = '.' if $_ eq '' } - return @path; -} - -=item canonpath - -No physical check on the filesystem, but a logical cleanup of a -path. On UNIX eliminated successive slashes and successive "/.". - -=cut - -sub canonpath { - my ($self,$path) = @_; - $path =~ s/^([a-z]:)/\u$1/s; - $path =~ s|/|\\|g; - $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx - $path =~ s|(\\\.)+\\|\\|g; # xx/././xx -> xx/xx - $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # ./xx -> xx - $path =~ s|\\\z|| - unless $path =~ m#^([A-Z]:)?\\\z#s; # xx/ -> xx - return $path; -} - -=item splitpath - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -Splits a path in to volume, directory, and filename portions. Assumes that -the last file is a path unless the path ends in '\\', '\\.', '\\..' -or $no_file is true. On Win32 this means that $no_file true makes this return -( $volume, $path, undef ). - -Separators accepted are \ and /. - -Volumes can be drive letters or UNC sharenames (\\server\share). - -The results can be passed to L</catpath> to get back a path equivalent to -(usually identical to) the original path. - -=cut - -sub splitpath { - my ($self,$path, $nofile) = @_; - my ($volume,$directory,$file) = ('','',''); - if ( $nofile ) { - $path =~ - m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - } - else { - $path =~ - m{^ ( (?: [a-zA-Z]: | - (?:\\\\|//)[^\\/]+[\\/][^\\/]+ - )? - ) - ( (?:.*[\\\\/](?:\.\.?\z)?)? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - $file = $3; - } - - return ($volume,$directory,$file); -} - - -=item splitdir - -The opposite of L</catdir()>. - - @dirs = File::Spec->splitdir( $directories ); - -$directories must be only the directory portion of the path on systems -that have the concept of a volume or that have path syntax that differentiates -files from directories. - -Unlike just splitting the directories on the separator, leading empty and -trailing directory entries can be returned, because these are significant -on some OSs. So, - - File::Spec->splitdir( "/a/b/c" ); - -Yields: - - ( '', 'a', 'b', '', 'c', '' ) - -=cut - -sub splitdir { - my ($self,$directories) = @_ ; - # - # split() likes to forget about trailing null fields, so here we - # check to be sure that there will not be any before handling the - # simple case. - # - if ( $directories !~ m|[\\/]\z| ) { - return split( m|[\\/]|, $directories ); - } - else { - # - # since there was a trailing separator, add a file name to the end, - # then do the split, then replace it with ''. - # - my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ; - $directories[ $#directories ]= '' ; - return @directories ; - } -} - - -=item catpath - -Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and this is just like catfile(). On other OSs, -the $volume become significant. - -=cut - -sub catpath { - my ($self,$volume,$directory,$file) = @_; - - # If it's UNC, make sure the glue separator is there, reusing - # whatever separator is first in the $volume - $volume .= $1 - if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s && - $directory =~ m@^[^\\/]@s - ) ; - - $volume .= $directory ; - - # If the volume is not just A:, make sure the glue separator is - # there, reusing whatever separator is first in the $volume if possible. - if ( $volume !~ m@^[a-zA-Z]:\z@s && - $volume =~ m@[^\\/]\z@ && - $file =~ m@[^\\/]@ - ) { - $volume =~ m@([\\/])@ ; - my $sep = $1 ? $1 : '\\' ; - $volume .= $sep ; - } - - $volume .= $file ; - - return $volume ; -} - - -=item abs2rel - -Takes a destination path and an optional base path returns a relative path -from the base path to the destination path: - - $rel_path = File::Spec->abs2rel( $destination ) ; - $rel_path = File::Spec->abs2rel( $destination, $base ) ; - -If $base is not present or '', then L</cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()>. - -On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is relative, it is converted to absolute form using L</rel2abs()>. -This means that it is taken to be relative to L</cwd()>. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - -sub abs2rel { - my($self,$path,$base) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - else { - $path = $self->canonpath( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - elsif ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - else { - $base = $self->canonpath( $base ) ; - } - - # Split up paths - my ( $path_volume, $path_directories, $path_file ) = - $self->splitpath( $path, 1 ) ; - - my ( undef, $base_directories, undef ) = - $self->splitpath( $base, 1 ) ; - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path_directories ); - my @basechunks = $self->splitdir( $base_directories ); - - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) - ) { - shift @pathchunks ; - shift @basechunks ; - } - - # No need to catdir, we know these are well formed. - $path_directories = CORE::join( '\\', @pathchunks ); - $base_directories = CORE::join( '\\', @basechunks ); - - # $base_directories now contains the directories the resulting relative - # path must ascend out of before it can descend to $path_directory. So, - # replace all names with $parentDir - - #FA Need to replace between backslashes... - $base_directories =~ s|[^\\]+|..|g ; - - # Glue the two together, using a separator if necessary, and preventing an - # empty result. - - #FA Must check that new directories are not empty. - if ( $path_directories ne '' && $base_directories ne '' ) { - $path_directories = "$base_directories\\$path_directories" ; - } else { - $path_directories = "$base_directories$path_directories" ; - } - - # It makes no sense to add a relative path to a UNC volume - $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ; - - return $self->canonpath( - $self->catpath($path_volume, $path_directories, $path_file ) - ) ; -} - -=item rel2abs - -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; - -If $base is not present or '', then L<cwd()> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L</cwd()>. - -Assumes that both paths are on the $base volume, and ignores the -$destination volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L</canonpath()>. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - -sub rel2abs($;$;) { - my ($self,$path,$base ) = @_; - - if ( ! $self->file_name_is_absolute( $path ) ) { - - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path, 1 ) ; - - my ( $base_volume, $base_directories, undef ) = - $self->splitpath( $base, 1 ) ; - - $path = $self->catpath( - $base_volume, - $self->catdir( $base_directories, $path_directories ), - $path_file - ) ; - } - - return $self->canonpath( $path ) ; -} - -=back - -=head1 SEE ALSO - -L<File::Spec> - -=cut - -1; diff --git a/contrib/perl5/lib/File/stat.pm b/contrib/perl5/lib/File/stat.pm deleted file mode 100644 index 0cf7a0b7aa82d..0000000000000 --- a/contrib/perl5/lib/File/stat.pm +++ /dev/null @@ -1,115 +0,0 @@ -package File::stat; -use strict; - -use 5.005_64; -our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); - -BEGIN { - use Exporter (); - @EXPORT = qw(stat lstat); - @EXPORT_OK = qw( $st_dev $st_ino $st_mode - $st_nlink $st_uid $st_gid - $st_rdev $st_size - $st_atime $st_mtime $st_ctime - $st_blksize $st_blocks - ); - %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); -} -use vars @EXPORT_OK; - -# Class::Struct forbids use of @ISA -sub import { goto &Exporter::import } - -use Class::Struct qw(struct); -struct 'File::stat' => [ - map { $_ => '$' } qw{ - dev ino mode nlink uid gid rdev size - atime mtime ctime blksize blocks - } -]; - -sub populate (@) { - return unless @_; - my $stob = new(); - @$stob = ( - $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev, - $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) - = @_; - return $stob; -} - -sub lstat ($) { populate(CORE::lstat(shift)) } - -sub stat ($) { - my $arg = shift; - my $st = populate(CORE::stat $arg); - return $st if $st; - no strict 'refs'; - require Symbol; - return populate(CORE::stat \*{Symbol::qualify($arg)}); -} - -1; -__END__ - -=head1 NAME - -File::stat - by-name interface to Perl's built-in stat() functions - -=head1 SYNOPSIS - - use File::stat; - $st = stat($file) or die "No $file: $!"; - if ( ($st->mode & 0111) && $st->nlink > 1) ) { - print "$file is executable with lotsa links\n"; - } - - use File::stat qw(:FIELDS); - stat($file) or die "No $file: $!"; - if ( ($st_mode & 0111) && $st_nlink > 1) ) { - print "$file is executable with lotsa links\n"; - } - -=head1 DESCRIPTION - -This module's default exports override the core stat() -and lstat() functions, replacing them with versions that return -"File::stat" objects. This object has methods that -return the similarly named structure field name from the -stat(2) function; namely, -dev, -ino, -mode, -nlink, -uid, -gid, -rdev, -size, -atime, -mtime, -ctime, -blksize, -and -blocks. - -You may also import all the structure fields directly into your namespace -as regular variables using the :FIELDS import tag. (Note that this still -overrides your stat() and lstat() functions.) Access these fields as -variables named with a preceding C<st_> in front their method names. -Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import -the fields. - -To access this functionality without the core overrides, -pass the C<use> an empty import list, and then access -function functions with their full qualified names. -On the other hand, the built-ins are still available -via the C<CORE::> pseudo-package. - -=head1 NOTE - -While this class is currently implemented using the Class::Struct -module to build a struct-like class, you shouldn't rely upon this. - -=head1 AUTHOR - -Tom Christiansen |