summaryrefslogtreecommitdiff
path: root/cpan/dist/File-Spec/lib/File
diff options
context:
space:
mode:
authorfukachan <fukachan>2003-09-17 04:14:53 +0000
committerfukachan <fukachan>2003-09-17 04:14:53 +0000
commit9ee1a11ec93a89feb054ac0a9b1999d29708dcfe (patch)
treebac6c747a0294145109be9efd81621099d05288b /cpan/dist/File-Spec/lib/File
parent0db4bf5bef9912092c3f5188b9de45b773663de1 (diff)
downloadfml8-9ee1a11ec93a89feb054ac0a9b1999d29708dcfe.tar.gz
fml8-9ee1a11ec93a89feb054ac0a9b1999d29708dcfe.tar.bz2
fml8-9ee1a11ec93a89feb054ac0a9b1999d29708dcfe.zip
Initial revision
Diffstat (limited to 'cpan/dist/File-Spec/lib/File')
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec.pm302
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/Cygwin.pm87
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/Epoc.pm70
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/Functions.pm99
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/Mac.pm774
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/OS2.pm266
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/Unix.pm462
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/VMS.pm499
-rw-r--r--cpan/dist/File-Spec/lib/File/Spec/Win32.pm376
9 files changed, 2935 insertions, 0 deletions
diff --git a/cpan/dist/File-Spec/lib/File/Spec.pm b/cpan/dist/File-Spec/lib/File/Spec.pm
new file mode 100644
index 00000000..a911fa29
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec.pm
@@ -0,0 +1,302 @@
+package File::Spec;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+$VERSION = '0.85_03';
+
+my %module = (MacOS => 'Mac',
+ MSWin32 => 'Win32',
+ os2 => 'OS2',
+ VMS => 'VMS',
+ epoc => 'Epoc',
+ NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
+ dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP.
+ cygwin => 'Cygwin');
+
+
+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 be 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.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path.
+
+ $cpath = File::Spec->canonpath( $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 :-)
+
+ $path = File::Spec->catdir( @directories );
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+ $path = File::Spec->catfile( @directories, $filename );
+
+=item curdir
+
+Returns a string representation of the current directory.
+
+ $curdir = File::Spec->curdir();
+
+=item devnull
+
+Returns a string representation of the null device.
+
+ $devnull = File::Spec->devnull();
+
+=item rootdir
+
+Returns a string representation of the root directory.
+
+ $rootdir = File::Spec->rootdir();
+
+=item tmpdir
+
+Returns a string representation of the first writable directory from a
+list of possible temporary directories. Returns the current directory
+if no writable temporary directories are found. The list of directories
+checked depends on the platform; e.g. File::Spec::Unix checks $ENV{TMPDIR}
+(unless taint is on) and /tmp.
+
+ $tmpdir = File::Spec->tmpdir();
+
+=item updir
+
+Returns a string representation of the parent directory.
+
+ $updir = File::Spec->updir();
+
+=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.)
+
+ @paths = File::Spec->no_upwards( @paths );
+
+=item case_tolerant
+
+Returns a true or false value indicating, respectively, that alphabetic
+is not or is significant when comparing file specifications.
+
+ $is_case_tolerant = File::Spec->case_tolerant();
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true if it is an absolute path.
+
+ $is_absolute = File::Spec->file_name_is_absolute( $path );
+
+This does not consult the local filesystem on Unix, Win32, OS/2, or
+Mac OS (Classic). It does consult the working environment for VMS
+(see L<File::Spec::VMS/file_name_is_absolute>).
+
+=item path
+
+Takes no argument, returns the environment variable PATH (or the local
+platform's equivalent) as a list.
+
+ @PATH = File::Spec->path();
+
+=item join
+
+join is the same as catfile.
+
+=item splitpath
+
+Splits a path in to volume, directory, and filename portions. On systems
+with no concept of volume, returns '' for volume.
+
+ ($volume,$directories,$file) = File::Spec->splitpath( $path );
+ ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+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.
+
+=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.
+
+=item catpath()
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and directory and file are concatenated. A '/' is
+inserted if need be. On other OSs, $volume is significant.
+
+ $full_path = File::Spec->catpath( $volume, $directory, $file );
+
+=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( $path ) ;
+ $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()|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()|Cwd>.
+
+On systems with the concept of volume, if $path and $base appear to be
+on two different volumes, we will not attempt to resolve the two
+paths, and we will instead simply return $path. Note that previous
+versions of this module ignored the volume of $base, which resulted in
+garbage results part of the time.
+
+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()|Cwd>.
+
+No checks against the filesystem are made. On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=item rel2abs()
+
+Converts a relative path to an absolute path.
+
+ $abs_path = File::Spec->rel2abs( $path ) ;
+ $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()|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()|Cwd>.
+
+On systems with the concept of volume, if $path and $base appear to be
+on two different volumes, we will not attempt to resolve the two
+paths, and we will instead simply return $path. Note that previous
+versions of this module ignored the volume of $base, which resulted in
+garbage results part of the time.
+
+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()>.
+
+No checks against the filesystem are made. On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=back
+
+For further information, please see L<File::Spec::Unix>,
+L<File::Spec::Mac>, L<File::Spec::OS2>, L<File::Spec::Win32>, or
+L<File::Spec::VMS>.
+
+=head1 SEE ALSO
+
+L<File::Spec::Unix>, L<File::Spec::Mac>, L<File::Spec::OS2>,
+L<File::Spec::Win32>, L<File::Spec::VMS>, L<File::Spec::Functions>,
+L<ExtUtils::MakeMaker>
+
+=head1 AUTHORS
+
+Kenneth Albanowski <kjahds@kjahds.com>, Andy Dougherty
+<doughera@lafayette.edu>, Andreas KE<ouml>nig
+<A.Koenig@franz.ww.TU-Berlin.DE>, Tim Bunce <Tim.Bunce@ig.co.uk.
+VMS support by Charles Bailey <bailey@newman.upenn.edu>.
+OS/2 support by Ilya Zakharevich <ilya@math.ohio-state.edu>.
+Mac support by Paul Schinder <schinder@pobox.com>, and Thomas Wegner
+<wegner_thomas@yahoo.com>. abs2rel() and rel2abs() written by Shigio
+Yamaguchi <shigio@tamacom.com>, modified by Barrie Slaymaker
+<barries@slaysys.com>. splitpath(), splitdir(), catpath() and
+catdir() by Barrie Slaymaker.
+
+=cut
diff --git a/cpan/dist/File-Spec/lib/File/Spec/Cygwin.pm b/cpan/dist/File-Spec/lib/File/Spec/Cygwin.pm
new file mode 100644
index 00000000..0712add8
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/Cygwin.pm
@@ -0,0 +1,87 @@
+package File::Spec::Cygwin;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.1';
+
+@ISA = qw(File::Spec::Unix);
+
+=head1 NAME
+
+File::Spec::Cygwin - methods for Cygwin file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::Cygwin; # Done internally by File::Spec if needed
+
+=head1 DESCRIPTION
+
+See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
+implementation of these methods, not the semantics.
+
+This module is still in beta. Cygwin-knowledgeable folks are invited
+to offer patches and suggestions.
+
+=cut
+
+=pod
+
+=over 4
+
+=item canonpath
+
+Any C<\> (backslashes) are converted to C</> (forward slashes),
+and then File::Spec::Unix canonpath() is called on the result.
+
+=cut
+
+sub canonpath {
+ my($self,$path) = @_;
+ $path =~ s|\\|/|g;
+ return $self->SUPER::canonpath($path);
+}
+
+=pod
+
+=item file_name_is_absolute
+
+True is returned if the file name begins with C<drive_letter:>,
+and if not, File::Spec::Unix file_name_is_absolute() is called.
+
+=cut
+
+
+sub file_name_is_absolute {
+ my ($self,$file) = @_;
+ return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
+ return $self->SUPER::file_name_is_absolute($file);
+}
+
+=item tmpdir (override)
+
+Returns a string representation of the first existing directory
+from the following list:
+
+ $ENV{TMPDIR}
+ /tmp
+ C:/temp
+
+Since Perl 5.8.0, if running under taint mode, and if the environment
+variables are tainted, they are not used.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+ return $tmpdir if defined $tmpdir;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' );
+}
+
+=back
+
+=cut
+
+1;
diff --git a/cpan/dist/File-Spec/lib/File/Spec/Epoc.pm b/cpan/dist/File-Spec/lib/File/Spec/Epoc.pm
new file mode 100644
index 00000000..89ca0b99
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/Epoc.pm
@@ -0,0 +1,70 @@
+package File::Spec::Epoc;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.1';
+
+require File::Spec::Unix;
+@ISA = qw(File::Spec::Unix);
+
+=head1 NAME
+
+File::Spec::Epoc - methods for Epoc file specs
+
+=head1 SYNOPSIS
+
+ require File::Spec::Epoc; # 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.
+
+This package is still work in progress ;-)
+
+=head1 AUTHORS
+
+o.flebbe@gmx.de
+
+=cut
+
+sub case_tolerant {
+ return 1;
+}
+
+=pod
+
+=over 4
+
+=item canonpath()
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+=back
+
+=cut
+
+sub canonpath {
+ my ($self,$path) = @_;
+
+ $path =~ s|/+|/|g; # 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(?!\n)|| unless $path eq "/"; # xx/ -> xx
+ return $path;
+}
+
+=pod
+
+=head1 SEE ALSO
+
+See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
+implementation of these methods, not the semantics.
+
+=cut
+
+1;
diff --git a/cpan/dist/File-Spec/lib/File/Spec/Functions.pm b/cpan/dist/File-Spec/lib/File/Spec/Functions.pm
new file mode 100644
index 00000000..1c36e8b9
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/Functions.pm
@@ -0,0 +1,99 @@
+package File::Spec::Functions;
+
+use File::Spec;
+use strict;
+
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+
+$VERSION = '1.3';
+
+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
+ case_tolerant
+);
+
+%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
+ case_tolerant
+
+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/cpan/dist/File-Spec/lib/File/Spec/Mac.pm b/cpan/dist/File-Spec/lib/File/Spec/Mac.pm
new file mode 100644
index 00000000..34a7a015
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/Mac.pm
@@ -0,0 +1,774 @@
+package File::Spec::Mac;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.4';
+
+@ISA = qw(File::Spec::Unix);
+
+my $macfiles;
+if ($^O eq 'MacOS') {
+ $macfiles = eval { require Mac::Files };
+}
+
+sub case_tolerant { 1 }
+
+
+=head1 NAME
+
+File::Spec::Mac - File::Spec for Mac OS (Classic)
+
+=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 Mac OS, 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 path separated by colons
+(":") ending with a directory. Resulting paths are B<relative> by default,
+but can be forced to be absolute (but avoid this, see below). Automatically
+puts a trailing ":" on the end of the complete path, because that's what's
+done in MacPerl's environment and helps to distinguish a file path from a
+directory path.
+
+B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
+path is relative by default and I<not> absolute. This descision was made due
+to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
+on all other operating systems, it will now also follow this convention on Mac
+OS. Note that this may break some existing scripts.
+
+The intended purpose of this routine is to concatenate I<directory names>.
+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. In other words, you are also allowed to concatenate
+I<paths> instead of directory names (strictly speaking, a string like ":a"
+is a path, but not a name, since it contains a punctuation character ":").
+
+So, beside calls like
+
+ catdir("a") = ":a:"
+ catdir("a","b") = ":a:b:"
+ catdir() = "" (special case)
+
+calls like the following
+
+ catdir(":a:") = ":a:"
+ catdir(":a","b") = ":a:b:"
+ catdir(":a:","b") = ":a:b:"
+ catdir(":a:",":b:") = ":a:b:"
+ catdir(":") = ":"
+
+are allowed.
+
+Here are the rules that are used in C<catdir()>; note that we try to be as
+compatible as possible to Unix:
+
+=over 2
+
+=item 1.
+
+The resulting path is relative by default, i.e. the resulting path will have a
+leading colon.
+
+=item 2.
+
+A trailing colon is added automatically to the resulting path, to denote a
+directory.
+
+=item 3.
+
+Generally, each argument has one leading ":" and one trailing ":"
+removed (if any). They are then joined together by a ":". Special
+treatment applies for arguments denoting updir paths like "::lib:",
+see (4), or arguments consisting solely of colons ("colon paths"),
+see (5).
+
+=item 4.
+
+When an updir path like ":::lib::" is passed as argument, the number
+of directories to climb up is handled correctly, not removing leading
+or trailing colons when necessary. E.g.
+
+ catdir(":::a","::b","c") = ":::a::b:c:"
+ catdir(":::a::","::b","c") = ":::a:::b:c:"
+
+=item 5.
+
+Adding a colon ":" or empty string "" to a path at I<any> position
+doesn't alter the path, i.e. these arguments are ignored. (When a ""
+is passed as the first argument, it has a special meaning, see
+(6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
+while an empty string "" is generally ignored (see
+C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
+(updir), and a ":::" is handled like a "../.." etc. E.g.
+
+ catdir("a",":",":","b") = ":a:b:"
+ catdir("a",":","::",":b") = ":a::b:"
+
+=item 6.
+
+If the first argument is an empty string "" or is a volume name, i.e. matches
+the pattern /^[^:]+:/, the resulting path is B<absolute>.
+
+=item 7.
+
+Passing an empty string "" as the first argument to C<catdir()> is
+like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e.
+
+ catdir("","a","b") is the same as
+
+ catdir(rootdir(),"a","b").
+
+This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
+C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
+volume, which is the closest in concept to Unix' "/". This should help
+to run existing scripts originally written for Unix.
+
+=item 8.
+
+For absolute paths, some cleanup is done, to ensure that the volume
+name isn't immediately followed by updirs. This is invalid, because
+this would go beyond "root". Generally, these cases are handled like
+their Unix counterparts:
+
+ Unix:
+ Unix->catdir("","") = "/"
+ Unix->catdir("",".") = "/"
+ Unix->catdir("","..") = "/" # can't go beyond root
+ Unix->catdir("",".","..","..","a") = "/a"
+ Mac:
+ Mac->catdir("","") = rootdir() # (e.g. "HD:")
+ Mac->catdir("",":") = rootdir()
+ Mac->catdir("","::") = rootdir() # can't go beyond root
+ Mac->catdir("",":","::","::","a") = rootdir() . "a:" # (e.g. "HD:a:")
+
+However, this approach is limited to the first arguments following
+"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
+arguments that move up the directory tree, an invalid path going
+beyond root can be created.
+
+=back
+
+As you've seen, you can force C<catdir()> to create an absolute path
+by passing either an empty string or a path that begins with a volume
+name as the first argument. However, you are strongly encouraged not
+to do so, since this is done only for backward compatibility. Newer
+versions of File::Spec come with a method called C<catpath()> (see
+below), that is designed to offer a portable solution for the creation
+of absolute paths. It takes volume, directory and file portions and
+returns an entire path. While C<catdir()> is still suitable for the
+concatenation of I<directory names>, you are encouraged to use
+C<catpath()> to concatenate I<volume names> and I<directory
+paths>. E.g.
+
+ $dir = File::Spec->catdir("tmp","sources");
+ $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
+
+yields
+
+ "MacintoshHD:tmp:sources:" .
+
+=cut
+
+sub catdir {
+ my $self = shift;
+ return '' unless @_;
+ my @args = @_;
+ my $first_arg;
+ my $relative;
+
+ # take care of the first argument
+
+ if ($args[0] eq '') { # absolute path, rootdir
+ shift @args;
+ $relative = 0;
+ $first_arg = $self->rootdir;
+
+ } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
+ $relative = 0;
+ $first_arg = shift @args;
+ # add a trailing ':' if need be (may be it's a path like HD:dir)
+ $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
+
+ } else { # relative path
+ $relative = 1;
+ if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
+ # updir colon path ('::', ':::' etc.), don't shift
+ $first_arg = ':';
+ } elsif ($args[0] eq ':') {
+ $first_arg = shift @args;
+ } else {
+ # add a trailing ':' if need be
+ $first_arg = shift @args;
+ $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
+ }
+ }
+
+ # For all other arguments,
+ # (a) ignore arguments that equal ':' or '',
+ # (b) handle updir paths specially:
+ # '::' -> concatenate '::'
+ # '::' . '::' -> concatenate ':::' etc.
+ # (c) add a trailing ':' if need be
+
+ my $result = $first_arg;
+ while (@args) {
+ my $arg = shift @args;
+ unless (($arg eq '') || ($arg eq ':')) {
+ if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
+ my $updir_count = length($arg) - 1;
+ while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
+ $arg = shift @args;
+ $updir_count += (length($arg) - 1);
+ }
+ $arg = (':' x $updir_count);
+ } else {
+ $arg =~ s/^://s; # remove a leading ':' if any
+ $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
+ }
+ $result .= $arg;
+ }#unless
+ }
+
+ if ( ($relative) && ($result !~ /^:/) ) {
+ # add a leading colon if need be
+ $result = ":$result";
+ }
+
+ unless ($relative) {
+ # remove updirs immediately following the volume name
+ $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
+ }
+
+ return $result;
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename. Resulting paths are B<relative>
+by default, but can be forced to be absolute (but avoid this).
+
+B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
+resulting path is relative by default and I<not> absolute. This
+descision was made due to portability reasons. Since
+C<File::Spec-E<gt>catfile()> returns relative paths on all other
+operating systems, it will now also follow this convention on Mac OS.
+Note that this may break some existing scripts.
+
+The last argument is always considered to be the file portion. Since
+C<catfile()> uses C<catdir()> (see above) for the concatenation of the
+directory portions (if any), the following with regard to relative and
+absolute paths is true:
+
+ catfile("") = ""
+ catfile("file") = "file"
+
+but
+
+ catfile("","") = rootdir() # (e.g. "HD:")
+ catfile("","file") = rootdir() . file # (e.g. "HD:file")
+ catfile("HD:","file") = "HD:file"
+
+This means that C<catdir()> is called only when there are two or more
+arguments, as one might expect.
+
+Note that the leading ":" is removed from the filename, so that
+
+ catfile("a","b","file") = ":a:b:file" and
+
+ catfile("a","b",":file") = ":a:b:file"
+
+give the same answer.
+
+To concatenate I<volume names>, I<directory paths> and I<filenames>,
+you are encouraged to use C<catpath()> (see below).
+
+=cut
+
+sub catfile {
+ my $self = shift;
+ return '' unless @_;
+ 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. On Mac OS, this is ":".
+
+=cut
+
+sub curdir {
+ return ":";
+}
+
+=item devnull
+
+Returns a string representing the null device. On Mac OS, this is "Dev:Null".
+
+=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. The name has a
+trailing ":", because that's the correct specification for a volume
+name on Mac OS.
+
+If Mac::Files could not be loaded, the empty string is returned.
+
+=cut
+
+sub rootdir {
+#
+# There's no real root directory on Mac OS. The name of the startup
+# volume is returned, since that's the closest in concept.
+#
+ return '' unless $macfiles;
+ my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
+ &Mac::Files::kSystemFolderType);
+ $system =~ s/:.*\Z(?!\n)/:/s;
+ return $system;
+}
+
+=item tmpdir
+
+Returns the contents of $ENV{TMPDIR}, if that directory exits or the
+current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
+contain a path like "MacintoshHD:Temporary Items:", which is a hidden
+directory on your startup volume.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+ return $tmpdir if defined $tmpdir;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
+}
+
+=item updir
+
+Returns a string representing the parent directory. On Mac OS, this is "::".
+
+=cut
+
+sub updir {
+ return "::";
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true, if it is an absolute path.
+If the path has a leading ":", it's a relative path. Otherwise, it's an
+absolute path, unless the path doesn't contain any colons, i.e. it's a name
+like "a". In this particular case, the path is considered to be relative
+(i.e. it is considered to be a filename). Use ":" in the appropriate place
+in the path if you want to distinguish unambiguously. As a special case,
+the filename '' is always considered to be absolute. Note that with version
+1.2 of File::Spec::Mac, this does no longer consult the local filesystem.
+
+E.g.
+
+ File::Spec->file_name_is_absolute("a"); # false (relative)
+ File::Spec->file_name_is_absolute(":a:b:"); # false (relative)
+ File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute)
+ File::Spec->file_name_is_absolute(""); # true (absolute)
+
+
+=cut
+
+sub file_name_is_absolute {
+ my ($self,$file) = @_;
+ if ($file =~ /:/) {
+ return (! ($file =~ m/^:/s) );
+ } elsif ( $file eq '' ) {
+ return 1 ;
+ } else {
+ return 0; # i.e. a file like "a"
+ }
+}
+
+=item path
+
+Returns the null list for the MacPerl application, since the concept is
+usually meaningless under Mac OS. 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
+
+ ($volume,$directories,$file) = File::Spec->splitpath( $path );
+ ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path into volume, directory, and filename portions.
+
+On Mac OS, assumes that the last part of the path is a filename unless
+$no_file is true or a trailing separator ":" is present.
+
+The volume portion is always returned with a trailing ":". The directory portion
+is always returned with a leading (to denote a relative path) and a trailing ":"
+(to denote a directory). The file portion is always returned I<without> a leading ":".
+Empty portions are returned as empty string ''.
+
+The results can be passed to C<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 ) {
+ ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
+ }
+ else {
+ $path =~
+ m|^( (?: [^:]+: )? )
+ ( (?: .*: )? )
+ ( .* )
+ |xs;
+ $volume = $1;
+ $directory = $2;
+ $file = $3;
+ }
+
+ $volume = '' unless defined($volume);
+ $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
+ if ($directory) {
+ # Make sure non-empty directories begin and end in ':'
+ $directory .= ':' unless (substr($directory,-1) eq ':');
+ $directory = ":$directory" unless (substr($directory,0,1) eq ':');
+ } else {
+ $directory = '';
+ }
+ $file = '' unless defined($file);
+
+ return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of C<catdir()>.
+
+ @dirs = File::Spec->splitdir( $directories );
+
+$directories should 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. Consider using C<splitpath()> otherwise.
+
+Unlike just splitting the directories on the separator, empty directory names
+(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
+colon to distinguish a directory path from a file path, a single trailing colon
+will be ignored, i.e. there's no empty directory name after it.
+
+Hence, on Mac OS, both
+
+ File::Spec->splitdir( ":a:b::c:" ); and
+ File::Spec->splitdir( ":a:b::c" );
+
+yield:
+
+ ( "a", "b", "::", "c")
+
+while
+
+ File::Spec->splitdir( ":a:b::c::" );
+
+yields:
+
+ ( "a", "b", "::", "c", "::")
+
+
+=cut
+
+sub splitdir {
+ my ($self, $path) = @_;
+ my @result = ();
+ my ($head, $sep, $tail, $volume, $directories);
+
+ return ('') if ( (!defined($path)) || ($path eq '') );
+ return (':') if ($path eq ':');
+
+ ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
+
+ # deprecated, but handle it correctly
+ if ($volume) {
+ push (@result, $volume);
+ $sep .= ':';
+ }
+
+ while ($sep || $directories) {
+ if (length($sep) > 1) {
+ my $updir_count = length($sep) - 1;
+ for (my $i=0; $i<$updir_count; $i++) {
+ # push '::' updir_count times;
+ # simulate Unix '..' updirs
+ push (@result, '::');
+ }
+ }
+ $sep = '';
+ if ($directories) {
+ ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
+ push (@result, $head);
+ $directories = $tail;
+ }
+ }
+ return @result;
+}
+
+
+=item catpath
+
+ $path = File::Spec->catpath($volume,$directory,$file);
+
+Takes volume, directory and file portions and returns an entire path. On Mac OS,
+$volume, $directory and $file are concatenated. A ':' is inserted if need be. You
+may pass an empty string for each portion. If all portions are empty, the empty
+string is returned. If $volume is empty, the result will be a relative path,
+beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
+is removed form $file and the remainder is returned. If $file is empty, the
+resulting path will have a trailing ':'.
+
+
+=cut
+
+sub catpath {
+ my ($self,$volume,$directory,$file) = @_;
+
+ if ( (! $volume) && (! $directory) ) {
+ $file =~ s/^:// if $file;
+ return $file ;
+ }
+
+ # We look for a volume in $volume, then in $directory, but not both
+
+ my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
+
+ $volume = $dir_volume unless length $volume;
+ my $path = $volume; # may be ''
+ $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
+
+ if ($directory) {
+ $directory = $dir_dirs if $volume;
+ $directory =~ s/^://; # remove leading ':' if any
+ $path .= $directory;
+ $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
+ }
+
+ if ($file) {
+ $file =~ s/^://; # remove leading ':' if any
+ $path .= $file;
+ }
+
+ return $path;
+}
+
+=item abs2rel
+
+Takes a destination path and an optional base path and returns a relative path
+from the base path to the destination path:
+
+ $rel_path = File::Spec->abs2rel( $path ) ;
+ $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+Note that both paths are assumed to have a notation that distinguishes a
+directory path (with trailing ':') from a file path (without trailing ':').
+
+If $base is not present or '', then the current working directory is used.
+If $base is relative, then it is converted to absolute form using C<rel2abs()>.
+This means that it is taken to be relative to the current working directory.
+
+If $path and $base appear to be on two different volumes, we will not
+attempt to resolve the two paths, and we will instead simply return
+$path. Note that previous versions of this module ignored the volume
+of $base, which resulted in garbage results part of the time.
+
+If $base doesn't have a trailing colon, the last element of $base is
+assumed to be a filename. This filename is ignored. Otherwise all path
+components are assumed to be directories.
+
+If $path is relative, it is converted to absolute form using C<rel2abs()>.
+This means that it is taken to be relative to the current working directory.
+
+Based on code written by Shigio Yamaguchi.
+
+
+=cut
+
+# maybe this should be done in canonpath() ?
+sub _resolve_updirs {
+ my $path = shift @_;
+ my $proceed;
+
+ # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
+ do {
+ $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
+ } while ($proceed);
+
+ return $path;
+}
+
+
+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 = $self->_cwd();
+ }
+ elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ $base = _resolve_updirs( $base ); # resolve updirs in $base
+ }
+ else {
+ $base = _resolve_updirs( $base );
+ }
+
+ # Split up paths - ignore $base's file
+ my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path );
+ my ( $base_vol, $base_dirs ) = $self->splitpath( $base );
+
+ return $path unless lc( $path_vol ) eq lc( $base_vol );
+
+ # Now, remove all leading components that are the same
+ my @pathchunks = $self->splitdir( $path_dirs );
+ my @basechunks = $self->splitdir( $base_dirs );
+
+ while ( @pathchunks &&
+ @basechunks &&
+ lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
+ shift @pathchunks ;
+ shift @basechunks ;
+ }
+
+ # @pathchunks now has the directories to descend in to.
+ # ensure relative path, even if @pathchunks is empty
+ $path_dirs = $self->catdir( ':', @pathchunks );
+
+ # @basechunks now contains the number of directories to climb out of.
+ $base_dirs = (':' x @basechunks) . ':' ;
+
+ return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
+}
+
+=item rel2abs
+
+Converts a relative path to an absolute path:
+
+ $abs_path = File::Spec->rel2abs( $path ) ;
+ $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+Note that both paths are assumed to have a notation that distinguishes a
+directory path (with trailing ':') from a file path (without trailing ':').
+
+If $base is not present or '', then $base is set to the current working
+directory. If $base is relative, then it is converted to absolute form
+using C<rel2abs()>. This means that it is taken to be relative to the
+current working directory.
+
+If $base doesn't have a trailing colon, the last element of $base is
+assumed to be a filename. This filename is ignored. Otherwise all path
+components are assumed to be directories.
+
+If $path is already absolute, it is returned and $base is ignored.
+
+Based on code written by Shigio Yamaguchi.
+
+=cut
+
+sub rel2abs {
+ my ($self,$path,$base) = @_;
+
+ if ( ! $self->file_name_is_absolute($path) ) {
+ # Figure out the effective $base and clean it up.
+ if ( !defined( $base ) || $base eq '' ) {
+ $base = $self->_cwd();
+ }
+ elsif ( ! $self->file_name_is_absolute($base) ) {
+ $base = $self->rel2abs($base) ;
+ }
+
+ # Split up paths
+
+ # igonore $path's volume
+ my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
+
+ # ignore $base's file part
+ my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
+
+ # Glom them together
+ $path_dirs = ':' if ($path_dirs eq '');
+ $base_dirs =~ s/:$//; # remove trailing ':', if any
+ $base_dirs = $base_dirs . $path_dirs;
+
+ $path = $self->catpath( $base_vol, $base_dirs, $path_file );
+ }
+ return $path;
+}
+
+
+=back
+
+=head1 AUTHORS
+
+See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
+<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
+
+=head1 SEE ALSO
+
+See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
+implementation of these methods, not the semantics.
+
+=cut
+
+1;
diff --git a/cpan/dist/File-Spec/lib/File/Spec/OS2.pm b/cpan/dist/File-Spec/lib/File/Spec/OS2.pm
new file mode 100644
index 00000000..47dc0a6a
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/OS2.pm
@@ -0,0 +1,266 @@
+package File::Spec::OS2;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.2';
+
+@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;
+}
+
+sub _cwd {
+ # In OS/2 the "require Cwd" is unnecessary bloat.
+ return Cwd::sys_cwd();
+}
+
+my $tmpdir;
+sub tmpdir {
+ return $tmpdir if defined $tmpdir;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
+ '/tmp',
+ '/' );
+}
+
+sub catdir {
+ my $self = shift;
+ my @args = @_;
+ foreach (@args) {
+ tr[\\][/];
+ # append a backslash to each argument unless it has one there
+ $_ .= "/" unless m{/$};
+ }
+ return $self->canonpath(join('', @args));
+}
+
+sub canonpath {
+ my ($self,$path) = @_;
+ $path =~ s/^([a-z]:)/\l$1/s;
+ $path =~ s|\\|/|g;
+ $path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx
+ $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
+ $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx
+ $path =~ s|/\Z(?!\n)||
+ unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx
+ $path =~ s{^/\.\.$}{/}; # /.. -> /
+ 1 while $path =~ s{^/\.\.}{}; # /../xx -> /xx
+ return $path;
+}
+
+
+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(?!\n))?)? )
+ (.*)
+ }xs;
+ $volume = $1;
+ $directory = $2;
+ $file = $3;
+ }
+
+ return ($volume,$directory,$file);
+}
+
+
+sub splitdir {
+ my ($self,$directories) = @_ ;
+ split m|[\\/]|, $directories, -1;
+}
+
+
+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(?!\n)@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(?!\n)@s &&
+ $volume =~ m@[^\\/]\Z(?!\n)@ &&
+ $file =~ m@[^\\/]@
+ ) {
+ $volume =~ m@([\\/])@ ;
+ my $sep = $1 ? $1 : '/' ;
+ $volume .= $sep ;
+ }
+
+ $volume .= $file ;
+
+ return $volume ;
+}
+
+
+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 = $self->_cwd();
+ } elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ } else {
+ $base = $self->canonpath( $base ) ;
+ }
+
+ # Split up paths
+ my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ;
+ my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ;
+ return $path unless $path_volume eq $base_volume;
+
+ # 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" ;
+ }
+
+ return $self->canonpath(
+ $self->catpath( "", $path_directories, $path_file )
+ ) ;
+}
+
+
+sub rel2abs {
+ my ($self,$path,$base ) = @_;
+
+ if ( ! $self->file_name_is_absolute( $path ) ) {
+
+ if ( !defined( $base ) || $base eq '' ) {
+ $base = $self->_cwd();
+ }
+ elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ }
+ else {
+ $base = $self->canonpath( $base ) ;
+ }
+
+ my ( $path_directories, $path_file ) =
+ ($self->splitpath( $path, 1 ))[1,2] ;
+
+ my ( $base_volume, $base_directories ) =
+ $self->splitpath( $base, 1 ) ;
+
+ $path = $self->catpath(
+ $base_volume,
+ $self->catdir( $base_directories, $path_directories ),
+ $path_file
+ ) ;
+ }
+
+ return $self->canonpath( $path ) ;
+}
+
+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 L<File::Spec> and L<File::Spec::Unix>. This package overrides the
+implementation of these methods, not the semantics.
+
+Amongst the changes made for OS/2 are...
+
+=over 4
+
+=item tmpdir
+
+Modifies the list of places temp directory information is looked for.
+
+ $ENV{TMPDIR}
+ $ENV{TEMP}
+ $ENV{TMP}
+ /tmp
+ /
+
+=item splitpath
+
+Volumes can be drive letters or UNC sharenames (\\server\share).
+
+=back
+
+=cut
diff --git a/cpan/dist/File-Spec/lib/File/Spec/Unix.pm b/cpan/dist/File-Spec/lib/File/Spec/Unix.pm
new file mode 100644
index 00000000..349757b6
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/Unix.pm
@@ -0,0 +1,462 @@
+package File::Spec::Unix;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '1.5';
+
+=head1 NAME
+
+File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
+
+=head1 SYNOPSIS
+
+ require File::Spec::Unix; # Done automatically by File::Spec
+
+=head1 DESCRIPTION
+
+Methods for manipulating file specifications. Other File::Spec
+modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
+override specific methods.
+
+=head1 METHODS
+
+=over 2
+
+=item canonpath()
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminates successive slashes and successive "/.".
+
+ $cpath = File::Spec->canonpath( $path ) ;
+
+=cut
+
+sub canonpath {
+ my ($self,$path) = @_;
+
+ # Handle POSIX-style node names beginning with double slash (qnx, nto)
+ # Handle network path names beginning with double slash (cygwin)
+ # (POSIX says: "a pathname that begins with two successive slashes
+ # may be interpreted in an implementation-defined manner, although
+ # more than two leading slashes shall be treated as a single slash.")
+ my $node = '';
+ if ( $^O =~ m/^(?:qnx|nto|cygwin)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) {
+ $node = $1;
+ }
+ # This used to be
+ # $path =~ s|/+|/|g unless($^O eq 'cygwin');
+ # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
+ # (Mainly because trailing "" directories didn't get stripped).
+ # Why would cygwin avoid collapsing multiple slashes into one? --jhi
+ $path =~ s|/+|/|g; # xx////xx -> xx/xx
+ $path =~ s@(/\.)+(/|\Z(?!\n))@/@g; # xx/././xx -> xx/xx
+ $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
+ $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
+ $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
+ return "$node$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;
+
+ $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
+}
+
+=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 = $self->canonpath(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 () { '.' }
+
+=item devnull
+
+Returns a string representation of the null device. "/dev/null" on UNIX.
+
+=cut
+
+sub devnull () { '/dev/null' }
+
+=item rootdir
+
+Returns a string representation of the root directory. "/" on UNIX.
+
+=cut
+
+sub rootdir () { '/' }
+
+=item tmpdir
+
+Returns a string representation of the first writable directory from
+the following list or the current directory if none from the list are
+writable:
+
+ $ENV{TMPDIR}
+ /tmp
+
+Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
+is tainted, it is not used.
+
+=cut
+
+my $tmpdir;
+sub _tmpdir {
+ return $tmpdir if defined $tmpdir;
+ my $self = shift;
+ my @dirlist = @_;
+ {
+ no strict 'refs';
+ if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
+ require Scalar::Util;
+ @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
+ }
+ }
+ foreach (@dirlist) {
+ next unless defined && -d && -w _;
+ $tmpdir = $_;
+ last;
+ }
+ $tmpdir = $self->curdir unless defined $tmpdir;
+ $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
+ return $tmpdir;
+}
+
+sub tmpdir {
+ return $tmpdir if defined $tmpdir;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp" );
+}
+
+=item updir
+
+Returns a string representation of the parent directory. ".." on UNIX.
+
+=cut
+
+sub updir () { '..' }
+
+=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(?!\n)/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 () { 0 }
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true if it is an absolute path.
+
+This does not consult the local filesystem on Unix, Win32, OS/2 or Mac
+OS (Classic). It does consult the working environment for VMS (see
+L<File::Spec::VMS/file_name_is_absolute>).
+
+=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 {
+ return () unless exists $ENV{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 into volume, directory, and filename portions. On systems
+with no concept of volume, returns '' 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(?!\n) )? )? ) ([^/]*) |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.
+
+On Unix,
+
+ File::Spec->splitdir( "/a/b//c/" );
+
+Yields:
+
+ ( '', 'a', 'b', '', 'c', '' )
+
+=cut
+
+sub splitdir {
+ return split m|/|, $_[1], -1; # Preserve trailing fields
+}
+
+
+=item catpath()
+
+Takes volume, directory and file portions and returns an entire path. Under
+Unix, $volume is ignored, and directory and file are concatenated. A '/' is
+inserted if needed (though if the directory portion doesn't start with
+'/' it is not added). 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( $path ) ;
+ $rel_path = File::Spec->abs2rel( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()|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()|Cwd>.
+
+On systems that have a grammar that indicates filenames, this ignores the
+$base filename. 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()|Cwd>.
+
+No checks against the filesystem are made. On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=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 = $self->_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( $path ) ;
+ $abs_path = File::Spec->rel2abs( $path, $base ) ;
+
+If $base is not present or '', then L<cwd()|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()|Cwd>.
+
+On systems that have a grammar that indicates filenames, this ignores
+the $base filename. Otherwise all path components are assumed to be
+directories.
+
+If $path is absolute, it is cleaned up and returned using L</canonpath()>.
+
+No checks against the filesystem are made. On VMS, there is
+interaction with the working environment, as logicals and
+macros are expanded.
+
+Based on code written by Shigio Yamaguchi.
+
+=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 = $self->_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
+
+# Internal routine to File::Spec, no point in making this public since
+# it is the standard Cwd interface. Most of the platform-specific
+# File::Spec subclasses use this.
+sub _cwd {
+ require Cwd;
+ Cwd::cwd();
+}
+
+1;
diff --git a/cpan/dist/File-Spec/lib/File/Spec/VMS.pm b/cpan/dist/File-Spec/lib/File/Spec/VMS.pm
new file mode 100644
index 00000000..362cdaa2
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/VMS.pm
@@ -0,0 +1,499 @@
+package File::Spec::VMS;
+
+use strict;
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.4';
+
+@ISA = qw(File::Spec::Unix);
+
+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 4
+
+=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;
+
+ if ($path =~ /\s/) {
+ return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+ }
+
+ 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(?!\n)##; }
+ $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 =~ /\s/) {
+ return join ' ',
+ map { $self->fixpath($_,$force_path) }
+ split /\s+/, $path;
+ }
+
+ if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
+ if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
+ $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(?!\n)/) ? 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 4
+
+=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(?!\n)|;
+ $path = $self->SUPER::canonpath($path);
+ if ($pathify) { return vmspath($path); }
+ else { return vmsify($path); }
+ }
+ else {
+ $path =~ s/([\[<])000000\./$1/g; # [000000.foo ==> [foo
+ $path =~ s/([^-]+)\.(\]\[|><)?000000([\]\>])/$1$3/g; # foo.000000] ==> foo]
+ $path =~ s-\]\[--g; $path =~ s/><//g; # foo.][bar ==> foo.bar
+ 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
+ $path =~ s/^[\[<\]>]{2}//; # []foo ==> foo
+ 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(?!\n)//; $sdir =~ s/\.dir\Z(?!\n)//;
+ $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/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(?!\n)/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 = $self->canonpath(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(?!\n)//;
+ if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/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}
+
+Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
+is tainted, it is not used.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+ return $tmpdir if defined $tmpdir;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{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(?!\n)/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(?!\n)//s;
+ @dirs;
+}
+
+
+=item catpath (override)
+
+Construct a complete filespec using VMS syntax
+
+=cut
+
+sub catpath {
+ my($self,$dev,$dir,$file) = @_;
+
+ # We look for a volume in $dev, then in $dir, but not both
+ my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir);
+ $dev = $dir_volume unless length $dev;
+ $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir;
+
+ if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
+ else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
+ 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 grep m{/}, @_;
+
+ my($path,$base) = @_;
+ $base = $self->_cwd() unless defined $base and length $base;
+
+ for ($path, $base) { $_ = $self->canonpath($_) }
+
+ # Are we even starting $path on the same (node::)device as $base? Note that
+ # logical paths or nodename differences may be on the "same device"
+ # but the comparison that ignores device differences so as to concatenate
+ # [---] up directory specs is not even a good idea in cases where there is
+ # a logical path difference between $path and $base nodename and/or device.
+ # Hence we fall back to returning the absolute $path spec
+ # if there is a case blind device (or node) difference of any sort
+ # and we do not even try to call $parse() or consult %ENV for $trnlnm()
+ # (this module needs to run on non VMS platforms after all).
+
+ my ($path_volume, $path_directories, $path_file) = $self->splitpath($path);
+ my ($base_volume, $base_directories, $base_file) = $self->splitpath($base);
+ return $path unless lc($path_volume) eq lc($base_volume);
+
+ for ($path, $base) { $_ = $self->rel2abs($_) }
+
+ # Now, remove all leading components that are the same
+ my @pathchunks = $self->splitdir( $path_directories );
+ unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
+ my @basechunks = $self->splitdir( $base_directories );
+ unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
+
+ 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 = join '.', ('-' x @basechunks, @pathchunks) ;
+ 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 = $self->_cwd;
+ }
+ elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ }
+ else {
+ $base = $self->canonpath( $base ) ;
+ }
+
+ # Split up paths
+ my ( $path_directories, $path_file ) =
+ ($self->splitpath( $path ))[1,2] ;
+
+ my ( $base_volume, $base_directories ) =
+ $self->splitpath( $base ) ;
+
+ $path_directories = '' if $path_directories eq '[]' ||
+ $path_directories eq '<>';
+ my $sep = '' ;
+ $sep = '.'
+ if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
+ $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
+
+See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
+implementation of these methods, not the semantics.
+
+An explanation of VMS file specs can be found at
+L<"http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files">.
+
+=cut
+
+1;
diff --git a/cpan/dist/File-Spec/lib/File/Spec/Win32.pm b/cpan/dist/File-Spec/lib/File/Spec/Win32.pm
new file mode 100644
index 00000000..1a91b95a
--- /dev/null
+++ b/cpan/dist/File-Spec/lib/File/Spec/Win32.pm
@@ -0,0 +1,376 @@
+package File::Spec::Win32;
+
+use strict;
+
+use vars qw(@ISA $VERSION);
+require File::Spec::Unix;
+
+$VERSION = '1.4';
+
+@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 4
+
+=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}
+ SYS:/temp
+ C:/temp
+ /tmp
+ /
+
+The SYS:/temp is preferred in Novell NetWare (the File::Spec::Win32
+is used also for NetWare).
+
+Since Perl 5.8.0, if running under taint mode, and if the environment
+variables are tainted, they are not used.
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+ return $tmpdir if defined $tmpdir;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
+ 'SYS:/temp',
+ 'C:/temp',
+ '/tmp',
+ '/' );
+}
+
+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 = $self->canonpath(pop @_);
+ return $file unless @_;
+ my $dir = $self->catdir(@_);
+ $dir .= "\\" unless substr($dir,-1) eq "\\";
+ return $dir.$file;
+}
+
+sub catdir {
+ my $self = shift;
+ my @args = @_;
+ foreach (@args) {
+ tr[/][\\];
+ # append a backslash to each argument unless it has one there
+ $_ .= "\\" unless m{\\$};
+ }
+ return $self->canonpath(join('', @args));
+}
+
+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 "/.".
+On Win32 makes
+
+ dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
+ dir1\dir2\dir3\...\dir4 -> \dir\dir4
+
+=cut
+
+sub canonpath {
+ my ($self,$path) = @_;
+ my $orig_path = $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(?!\n)||
+ unless $path =~ m{^([A-Z]:)?\\\Z(?!\n)}s; # xx\ -> xx
+ # xx1/xx2/xx3/../../xx -> xx1/xx
+ $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
+ $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
+ return $path if $path =~ m|^\.\.|; # skip relative paths
+ return $path unless $path =~ /\.\./; # too few .'s to cleanup
+ return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
+ $path =~ s{^\\\.\.$}{\\}; # \.. -> \
+ 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
+
+ my ($vol,$dirs,$file) = $self->splitpath($path);
+ my @dirs = $self->splitdir($dirs);
+ my (@base_dirs, @path_dirs);
+ my $dest = \@base_dirs;
+ for my $dir (@dirs){
+ $dest = \@path_dirs if $dir eq $self->updir;
+ push @$dest, $dir;
+ }
+ # for each .. in @path_dirs pop one item from
+ # @base_dirs
+ while (my $dir = shift @path_dirs){
+ unless ($dir eq $self->updir){
+ unshift @path_dirs, $dir;
+ last;
+ }
+ pop @base_dirs;
+ }
+ $path = $self->catpath(
+ $vol,
+ $self->catdir(@base_dirs, @path_dirs),
+ $file
+ );
+ return $path;
+}
+
+=item splitpath
+
+ ($volume,$directories,$file) = File::Spec->splitpath( $path );
+ ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Splits a path into 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, '' ).
+
+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(?!\n))?)? )
+ (.*)
+ }xs;
+ $volume = $1;
+ $directory = $2;
+ $file = $3;
+ }
+
+ return ($volume,$directory,$file);
+}
+
+
+=item splitdir
+
+The opposite of L<catdir()|File::Spec/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(?!\n)| ) {
+ 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(?!\n)@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(?!\n)@s &&
+ $volume =~ m@[^\\/]\Z(?!\n)@ &&
+ $file =~ m@[^\\/]@
+ ) {
+ $volume =~ m@([\\/])@ ;
+ my $sep = $1 ? $1 : '\\' ;
+ $volume .= $sep ;
+ }
+
+ $volume .= $file ;
+
+ return $volume ;
+}
+
+
+sub abs2rel {
+ my($self,$path,$base) = @_;
+ $base = $self->_cwd() unless defined $base and length $base;
+
+ for ($path, $base) { $_ = $self->canonpath($_) }
+
+ my ($path_volume) = $self->splitpath($path, 1);
+ my ($base_volume) = $self->splitpath($base, 1);
+
+ # Can't relativize across volumes
+ return $path unless $path_volume eq $base_volume;
+
+ for ($path, $base) { $_ = $self->rel2abs($_) }
+
+ my $path_directories = ($self->splitpath($path, 1))[1];
+ my $base_directories = ($self->splitpath($base, 1))[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 ;
+ }
+
+ my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
+
+ return $self->canonpath( $self->catpath('', $result_dirs, '') );
+}
+
+
+sub rel2abs {
+ my ($self,$path,$base ) = @_;
+
+ if ( ! $self->file_name_is_absolute( $path ) ) {
+
+ if ( !defined( $base ) || $base eq '' ) {
+ $base = $self->_cwd() ;
+ }
+ elsif ( ! $self->file_name_is_absolute( $base ) ) {
+ $base = $self->rel2abs( $base ) ;
+ }
+ else {
+ $base = $self->canonpath( $base ) ;
+ }
+
+ my ( $path_directories, $path_file ) =
+ ($self->splitpath( $path, 1 ))[1,2] ;
+
+ my ( $base_volume, $base_directories ) =
+ $self->splitpath( $base, 1 ) ;
+
+ $path = $self->catpath(
+ $base_volume,
+ $self->catdir( $base_directories, $path_directories ),
+ $path_file
+ ) ;
+ }
+
+ return $self->canonpath( $path ) ;
+}
+
+=back
+
+=head2 Note For File::Spec::Win32 Maintainers
+
+Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
+
+=head1 SEE ALSO
+
+See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
+implementation of these methods, not the semantics.
+
+=cut
+
+1;