From 4fcbc3669aa997848e15198cc9fb856287a6788c Mon Sep 17 00:00:00 2001 From: markm Date: Wed, 9 Sep 1998 07:00:04 +0000 Subject: Initial import of Perl5. The king is dead; long live the king! --- contrib/perl5/lib/File/Spec/Mac.pm | 230 +++++++++++++++++++++++++++++++++++ contrib/perl5/lib/File/Spec/OS2.pm | 51 ++++++++ contrib/perl5/lib/File/Spec/Unix.pm | 197 ++++++++++++++++++++++++++++++ contrib/perl5/lib/File/Spec/VMS.pm | 148 ++++++++++++++++++++++ contrib/perl5/lib/File/Spec/Win32.pm | 104 ++++++++++++++++ 5 files changed, 730 insertions(+) create mode 100644 contrib/perl5/lib/File/Spec/Mac.pm create mode 100644 contrib/perl5/lib/File/Spec/OS2.pm create mode 100644 contrib/perl5/lib/File/Spec/Unix.pm create mode 100644 contrib/perl5/lib/File/Spec/VMS.pm create mode 100644 contrib/perl5/lib/File/Spec/Win32.pm (limited to 'contrib/perl5/lib/File/Spec') diff --git a/contrib/perl5/lib/File/Spec/Mac.pm b/contrib/perl5/lib/File/Spec/Mac.pm new file mode 100644 index 0000000..4968e24 --- /dev/null +++ b/contrib/perl5/lib/File/Spec/Mac.pm @@ -0,0 +1,230 @@ +package File::Spec::Mac; + +use Exporter (); +use Config; +use strict; +use File::Spec; +use vars qw(@ISA $VERSION $Is_Mac); + +$VERSION = '1.0'; + +@ISA = qw(File::Spec::Unix); +$Is_Mac = $^O eq 'MacOS'; + +Exporter::import('File::Spec', '$Verbose'); + + +=head1 NAME + +File::Spec::Mac - File::Spec for MacOS + +=head1 SYNOPSIS + +C + +=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) = @_; + $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 resonable 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 +existance 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 = @_; + $args[0] =~ s/:$//; + my $result = shift @args; + for (@args) { + s/:$//; + s/^://; + $result .= ":$_"; + } + $result .= ":"; + $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/^://; + return $dir.$file; +} + +=item curdir + +Returns a string representing of the current directory. + +=cut + +sub curdir { + return ":" ; +} + +=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. On any other +platform returns '', since there's no common way to indicate "root +directory" across all Macs. + +=cut + +sub rootdir { +# +# There's no real root directory on MacOS. If you're using MacPerl, +# the name of the startup volume is returned, since that's the closest in +# concept. On other platforms, simply return '', because nothing better +# can be done. +# + if($Is_Mac) { + require Mac::Files; + my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, + &Mac::Files::kSystemFolderType); + $system =~ s/:.*$/:/; + return $system; + } else { + return ''; + } +} + +=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/^:/); + } 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. +# + my($self) = @_; + my @path; + if(exists $ENV{Commands}) { + @path = split /,/,$ENV{Commands}; + } else { + @path = (); + } + @path; +} + +=back + +=head1 SEE ALSO + +L + +=cut + +1; +__END__ + diff --git a/contrib/perl5/lib/File/Spec/OS2.pm b/contrib/perl5/lib/File/Spec/OS2.pm new file mode 100644 index 0000000..d602617 --- /dev/null +++ b/contrib/perl5/lib/File/Spec/OS2.pm @@ -0,0 +1,51 @@ +package File::Spec::OS2; + +#use Config; +#use Cwd; +#use File::Basename; +use strict; +require Exporter; + +use File::Spec; +use vars qw(@ISA); + +Exporter::import('File::Spec', + qw( $Verbose)); + +@ISA = qw(File::Spec::Unix); + +$ENV{EMXSHELL} = 'sh'; # to run `commands` + +sub file_name_is_absolute { + my($self,$file) = @_; + $file =~ m{^([a-z]:)?[\\/]}i ; +} + +sub path { + my($self) = @_; + my $path_sep = ";"; + my $path = $ENV{PATH}; + $path =~ s:\\:/:g; + my @path = split $path_sep, $path; + foreach(@path) { $_ = '.' if $_ eq '' } + @path; +} + +1; +__END__ + +=head1 NAME + +File::Spec::OS2 - methods for OS/2 file specs + +=head1 SYNOPSIS + + use 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. + +=cut diff --git a/contrib/perl5/lib/File/Spec/Unix.pm b/contrib/perl5/lib/File/Spec/Unix.pm new file mode 100644 index 0000000..77de73a --- /dev/null +++ b/contrib/perl5/lib/File/Spec/Unix.pm @@ -0,0 +1,197 @@ +package File::Spec::Unix; + +use Exporter (); +use Config; +use File::Basename qw(basename dirname fileparse); +use DirHandle; +use strict; +use vars qw(@ISA $Is_Mac $Is_OS2 $Is_VMS $Is_Win32); +use File::Spec; + +Exporter::import('File::Spec', '$Verbose'); + +$Is_OS2 = $^O eq 'os2'; +$Is_Mac = $^O eq 'MacOS'; +$Is_Win32 = $^O eq 'MSWin32'; + +if ($Is_VMS = $^O eq 'VMS') { + require VMS::Filespec; + import VMS::Filespec qw( &vmsify ); +} + +=head1 NAME + +File::Spec::Unix - methods used by File::Spec + +=head1 SYNOPSIS + +C + +=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 "/.". + +=cut + +sub canonpath { + my($self,$path) = @_; + $path =~ s|/+|/|g ; # xx////xx -> xx/xx + $path =~ s|(/\.)+/|/|g ; # xx/././xx -> xx/xx + $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx + $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx + $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 { + shift; + my @args = @_; + for (@args) { + # append a slash to each argument unless it has one there + $_ .= "/" if $_ eq '' or substr($_,-1) ne "/"; + } + my $result = join('', @args); + # remove a trailing slash unless we are root + substr($result,-1) = "" + if length($result) > 1 && substr($result,-1) eq "/"; + $result; +} + +=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(@_); + for ($dir) { + $_ .= "/" unless substr($_,length($_)-1,1) eq "/"; + } + return $dir.$file; +} + +=item curdir + +Returns a string representing of the current directory. "." on UNIX. + +=cut + +sub curdir { + return "." ; +} + +=item rootdir + +Returns a string representing of the root directory. "/" on UNIX. + +=cut + +sub rootdir { + return "/"; +} + +=item updir + +Returns a string representing 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}$/, @_); +} + +=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) = @_; + $file =~ m:^/: ; +} + +=item path + +Takes no argument, returns the environment variable PATH as an array. + +=cut + +sub path { + my($self) = @_; + my $path_sep = ":"; + my $path = $ENV{PATH}; + my @path = split $path_sep, $path; + foreach(@path) { $_ = '.' if $_ eq '' } + @path; +} + +=item join + +join is the same as catfile. + +=cut + +sub join { + my($self) = shift @_; + $self->catfile(@_); +} + +=item nativename + +TBW. + +=cut + +sub nativename { + my($self,$name) = shift @_; + $name; +} + +=back + +=head1 SEE ALSO + +L + +=cut + +1; +__END__ diff --git a/contrib/perl5/lib/File/Spec/VMS.pm b/contrib/perl5/lib/File/Spec/VMS.pm new file mode 100644 index 0000000..c5269fd --- /dev/null +++ b/contrib/perl5/lib/File/Spec/VMS.pm @@ -0,0 +1,148 @@ + +package File::Spec::VMS; + +use Carp qw( &carp ); +use Config; +require Exporter; +use VMS::Filespec; +use File::Basename; + +use File::Spec; +use vars qw($Revision); +$Revision = '5.3901 (6-Mar-1997)'; + +@ISA = qw(File::Spec::Unix); + +Exporter::import('File::Spec', '$Verbose'); + +=head1 NAME + +File::Spec::VMS - methods for VMS file specs + +=head1 SYNOPSIS + + use 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. + +=head2 Methods always loaded + +=over + +=item catdir + +Concatenates a list of file specifications, and returns the result as a +VMS-syntax directory specification. + +=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$//; $sdir =~ s/.dir$//; + $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/; + $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); + } + else { + if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; } + else { $rslt = vmspath($dir); } + } + print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; + $rslt; +} + +=item catfile + +Concatenates a list of file specifications, and returns the result as a +VMS-syntax directory 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$//; + if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; } + else { + $rslt = $self->eliminate_macros($spath); + $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file)); + } + } + else { $rslt = vmsify($file); } + print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; + $rslt; +} + +=item curdir (override) + +Returns a string representing of the current directory. + +=cut + +sub curdir { + return '[]'; +} + +=item rootdir (override) + +Returns a string representing of the root directory. + +=cut + +sub rootdir { + return ''; +} + +=item updir (override) + +Returns a string representing of the parent directory. + +=cut + +sub updir { + return '[-]'; +} + +=item path (override) + +Translate logical name DCL$PATH as a searchlist, rather than trying +to C string value of C<$ENV{'PATH'}>. + +=cut + +sub path { + my(@dirs,$dir,$i); + while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } + @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\$\-]+$/ and $ENV{$file}; + $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/; +} + +1; +__END__ + diff --git a/contrib/perl5/lib/File/Spec/Win32.pm b/contrib/perl5/lib/File/Spec/Win32.pm new file mode 100644 index 0000000..034a0cb --- /dev/null +++ b/contrib/perl5/lib/File/Spec/Win32.pm @@ -0,0 +1,104 @@ +package File::Spec::Win32; + +=head1 NAME + +File::Spec::Win32 - methods for Win32 file specs + +=head1 SYNOPSIS + + use 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 + +=cut + +#use Config; +#use Cwd; +use File::Basename; +require Exporter; +use strict; + +use vars qw(@ISA); + +use File::Spec; +Exporter::import('File::Spec', qw( $Verbose)); + +@ISA = qw(File::Spec::Unix); + +$ENV{EMXSHELL} = 'sh'; # to run `commands` + +sub file_name_is_absolute { + my($self,$file) = @_; + $file =~ m{^([a-z]:)?[\\/]}i ; +} + +sub catdir { + my $self = shift; + my @args = @_; + for (@args) { + # append a slash to each argument unless it has one there + $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\"; + } + my $result = $self->canonpath(join('', @args)); + $result; +} + +=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 =~ s/(\\\.)$//; + $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\"; + return $dir.$file; +} + +sub path { + local $^W = 1; + my($self) = @_; + my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; + my @path = split(';',$path); + foreach(@path) { $_ = '.' if $_ eq '' } + @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/; + $path =~ s|/|\\|g; + $path =~ s|\\+|\\|g ; # xx////xx -> xx/xx + $path =~ s|(\\\.)+\\|\\|g ; # xx/././xx -> xx/xx + $path =~ s|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx + $path =~ s|\\$|| + unless $path =~ m#^([a-z]:)?\\#; # xx/ -> xx + $path .= '.' if $path =~ m#\\$#; + $path; +} + +1; +__END__ + +=back + +=cut + -- cgit v1.1