From: Jan Dubois Date: Sat, 6 Feb 1999 01:06:29 +0000 (+0100) Subject: back out change#2751, apply updated version X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cbc7acb08556fe93b6145fc8865b65a348dd7935;p=p5sagit%2Fp5-mst-13.2.git back out change#2751, apply updated version Message-ID: <36bc844c.18763049@smtp1.ibm.net> Subject: [PATCH] Cleanup of File::Spec module p4raw-link: @2751 on //depot/perl: 99804bbbf0b24ddc3b565419ea53f59e7410d1f4 p4raw-id: //depot/perl@2916 --- diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 616dcbc..9de9a80 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -1,47 +1,18 @@ package File::Spec; -require Exporter; - -@ISA = qw(Exporter); -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. -@EXPORT = qw( - -); -@EXPORT_OK = qw($Verbose); - use strict; -use vars qw(@ISA $VERSION $Verbose); +use vars qw(@ISA $VERSION); $VERSION = '0.6'; -$Verbose = 0; - -require File::Spec::Unix; - - -sub load { - my($class,$OS) = @_; - if ($OS eq 'VMS') { - require File::Spec::VMS; - require VMS::Filespec; - 'File::Spec::VMS' - } elsif ($OS eq 'os2') { - require File::Spec::OS2; - 'File::Spec::OS2' - } elsif ($OS eq 'MacOS') { - require File::Spec::Mac; - 'File::Spec::Mac' - } elsif ($OS eq 'MSWin32') { - require File::Spec::Win32; - 'File::Spec::Win32' - } else { - 'File::Spec::Unix' - } -} - -@ISA = load('File::Spec', $^O); +my %module = (MacOS => 'Mac', + MSWin32 => 'Win32', + os2 => 'OS2', + VMS => 'VMS'); + +my $module = $module{$^O} || 'Unix'; +require "File/Spec/$module.pm"; +@ISA = ("File::Spec::$module"); 1; __END__ @@ -109,8 +80,3 @@ Kenneth Albanowski >, Andy Dougherty support by Charles Bailey >. OS/2 support by Ilya Zakharevich >. Mac support by Paul Schinder >. - -=cut - - -1; diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index 63a9e12..e1f3c17 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -1,18 +1,9 @@ package File::Spec::Mac; -use Exporter (); -use Config; use strict; -use File::Spec; -use vars qw(@ISA $VERSION $Is_Mac); - -$VERSION = '1.0'; - +use vars qw(@ISA); +require File::Spec::Unix; @ISA = qw(File::Spec::Unix); -$Is_Mac = $^O eq 'MacOS'; - -Exporter::import('File::Spec', '$Verbose'); - =head1 NAME @@ -20,7 +11,7 @@ File::Spec::Mac - File::Spec for MacOS =head1 SYNOPSIS -C + require File::Spec::Mac; # Done internally by File::Spec if needed =head1 DESCRIPTION @@ -37,8 +28,8 @@ On MacOS, there's nothing to be done. Returns what it's given. =cut sub canonpath { - my($self,$path) = @_; - $path; + my ($self,$path) = @_; + return $path; } =item catdir @@ -84,20 +75,17 @@ 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 .= ":$_"; + my $result = shift @args; + $result =~ s/:$//; + foreach (@args) { + s/:$//; + s/^://; + $result .= ":$_"; } - $result .= ":"; - $result; + return "$result:"; } =item catfile @@ -118,50 +106,69 @@ give the same answer, as one might expect. =cut sub catfile { - my $self = shift @_; + my $self = shift; my $file = pop @_; return $file unless @_; my $dir = $self->catdir(@_); - $file =~ s/^://; + $file =~ s/^://; return $dir.$file; } =item curdir -Returns a string representing of the current directory. +Returns a string representing the current directory. =cut sub curdir { - return ":" ; + return ":"; +} + +=item devnull + +Returns a string representing the null device. + +=cut + +sub devnull { + return "Dev:Null"; } =item rootdir Returns a string representing the root directory. Under MacPerl, returns the name of the startup volume, since that's the closest in -concept, although other volumes aren't rooted there. On any other -platform returns '', since there's no common way to indicate "root -directory" across all Macs. +concept, although other volumes aren't rooted there. =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. +# There's no real root directory on MacOS. The name of the startup +# volume is returned, since that's the closest in concept. # - if($Is_Mac) { - require Mac::Files; - my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, - &Mac::Files::kSystemFolderType); - $system =~ s/:.*$/:/; - return $system; - } else { - return ''; - } + require Mac::Files; + my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, + &Mac::Files::kSystemFolderType); + $system =~ s/:.*$/:/; + return $system; +} + +=item tmpdir + +Returns a string representation of the first existing directory +from the following list or '' if none exist: + + $ENV{TMPDIR} + +=cut + +my $tmpdir; +sub tmpdir { + return $tmpdir if defined $tmpdir; + $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR}; + $tmpdir = '' unless defined $tmpdir; + return $tmpdir; } =item updir @@ -185,11 +192,11 @@ distinguish unambiguously. =cut sub file_name_is_absolute { - my($self,$file) = @_; - if ($file =~ /:/) { - return ($file !~ m/^:/); - } else { - return (! -e ":$file"); + my ($self,$file) = @_; + if ($file =~ /:/) { + return ($file !~ m/^:/); + } else { + return (! -e ":$file"); } } @@ -207,14 +214,8 @@ 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; + return unless exists $ENV{Commands}; + return split(/,/, $ENV{Commands}); } =back @@ -226,5 +227,3 @@ L =cut 1; -__END__ - diff --git a/lib/File/Spec/OS2.pm b/lib/File/Spec/OS2.pm index ee7b331..985c411 100644 --- a/lib/File/Spec/OS2.pm +++ b/lib/File/Spec/OS2.pm @@ -1,38 +1,40 @@ 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)); - +require File::Spec::Unix; @ISA = qw(File::Spec::Unix); -$ENV{EMXSHELL} = 'sh'; # to run `commands` +sub devnull { + return "/dev/nul"; +} sub file_name_is_absolute { - my($self,$file) = @_; - $file =~ m{^([a-z]:)?[\\/]}i ; + my ($self,$file) = @_; + return scalar($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; + my @path = split(';',$path); + foreach (@path) { $_ = '.' if $_ eq '' } + return @path; } -sub devnull { - return "/dev/nul"; +my $tmpdir; +sub tmpdir { + return $tmpdir if defined $tmpdir; + my $self = shift; + foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) { + next unless defined && -d; + $tmpdir = $_; + last; + } + $tmpdir = '' unless defined $tmpdir; + $tmpdir =~ s:\\:/:g; + $tmpdir = $self->canonpath($tmpdir); + return $tmpdir; } 1; @@ -44,12 +46,10 @@ File::Spec::OS2 - methods for OS/2 file specs =head1 SYNOPSIS - use File::Spec::OS2; # Done internally by File::Spec if needed + require File::Spec::OS2; # Done internally by File::Spec if needed =head1 DESCRIPTION See File::Spec::Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. - -=cut diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index ae3546e..420075d 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -1,23 +1,6 @@ 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 @@ -25,7 +8,7 @@ File::Spec::Unix - methods used by File::Spec =head1 SYNOPSIS -C + require File::Spec::Unix; # Done automatically by File::Spec =head1 DESCRIPTION @@ -43,12 +26,12 @@ 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 + 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; + return $path; } =item catdir @@ -61,20 +44,14 @@ trailing slash :-) =cut -# '; - sub catdir { - shift; + my $self = shift; my @args = @_; - for (@args) { + foreach (@args) { # append a slash to each argument unless it has one there - $_ .= "/" if $_ eq '' or substr($_,-1) ne "/"; + $_ .= "/" if $_ eq '' || 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; + return $self->canonpath(join('', @args)); } =item catfile @@ -85,29 +62,27 @@ complete path ending with a filename =cut sub catfile { - my $self = shift @_; + my $self = shift; my $file = pop @_; return $file unless @_; my $dir = $self->catdir(@_); - for ($dir) { - $_ .= "/" unless substr($_,length($_)-1,1) eq "/"; - } + $dir .= "/" unless substr($dir,-1) eq "/"; return $dir.$file; } =item curdir -Returns a string representing of the current directory. "." on UNIX. +Returns a string representation of the current directory. "." on UNIX. =cut sub curdir { - return "." ; + return "."; } =item devnull -Returns the name of the null device (bit bucket). "/dev/null" on UNIX. +Returns a string representation of the null device. "/dev/null" on UNIX. =cut @@ -117,7 +92,7 @@ sub devnull { =item rootdir -Returns a string representing of the root directory. "/" on UNIX. +Returns a string representation of the root directory. "/" on UNIX. =cut @@ -125,9 +100,31 @@ sub rootdir { return "/"; } +=item tmpdir + +Returns a string representation of the first writable directory +from the following list or "" if none are writable: + + $ENV{TMPDIR} + /tmp + +=cut + +my $tmpdir; +sub tmpdir { + return $tmpdir if defined $tmpdir; + foreach ($ENV{TMPDIR}, "/tmp") { + next unless defined && -d && -w _; + $tmpdir = $_; + last; + } + $tmpdir = '' unless defined $tmpdir; + return $tmpdir; +} + =item updir -Returns a string representing of the parent directory. ".." on UNIX. +Returns a string representation of the parent directory. ".." on UNIX. =cut @@ -143,7 +140,7 @@ directory. (Does not strip symlinks, only '.', '..', and equivalents.) =cut sub no_upwards { - my($self) = shift; + my $self = shift; return grep(!/^\.{1,2}$/, @_); } @@ -154,8 +151,8 @@ 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:^/: ; + my ($self,$file) = @_; + return scalar($file =~ m:^/:); } =item path @@ -165,12 +162,9 @@ 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; + my @path = split(':', $ENV{PATH}); + foreach (@path) { $_ = '.' if $_ eq '' } + return @path; } =item join @@ -180,19 +174,8 @@ 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; + my $self = shift; + return $self->catfile(@_); } =back @@ -204,4 +187,3 @@ L =cut 1; -__END__ diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 2084505..30440c2 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -1,19 +1,12 @@ - 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)'; - +use strict; +use vars qw(@ISA); +require File::Spec::Unix; @ISA = qw(File::Spec::Unix); -Exporter::import('File::Spec', '$Verbose'); +use File::Basename; +use VMS::Filespec; =head1 NAME @@ -21,7 +14,7 @@ File::Spec::VMS - methods for VMS file specs =head1 SYNOPSIS - use File::Spec::VMS; # Done internally by File::Spec if needed + require File::Spec::VMS; # Done internally by File::Spec if needed =head1 DESCRIPTION @@ -41,23 +34,22 @@ VMS-syntax directory specification. =cut sub catdir { - my($self,@dirs) = @_; - my($dir) = pop @dirs; + my ($self,@dirs) = @_; + my $dir = pop @dirs; @dirs = grep($_,@dirs); - my($rslt); + 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); + 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); } + else { + if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; } + else { $rslt = vmspath($dir); } } - print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; - $rslt; + return $rslt; } =item catfile @@ -68,28 +60,29 @@ VMS-syntax directory specification. =cut sub catfile { - my($self,@files) = @_; - my($file) = pop @files; + my ($self,@files) = @_; + my $file = pop @files; @files = grep($_,@files); - my($rslt); + 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)); - } + 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; + return $rslt; } =item curdir (override) -Returns a string representing of the current directory. +Returns a string representation of the current directory: '[]' =cut @@ -99,27 +92,49 @@ sub curdir { =item devnull (override) -Returns a string representing the null device. +Returns a string representation of the null device: '_NLA0:' =cut sub devnull { - return 'NL:'; + return "_NLA0:"; } =item rootdir (override) -Returns a string representing of the root directory. +Returns a string representation of the root directory: 'SYS$DISK:[000000]' =cut sub rootdir { - return ''; + return 'SYS$DISK:[000000]'; +} + +=item tmpdir (override) + +Returns a string representation of the first writable directory +from the following list or '' if none are writable: + + /sys$scratch + $ENV{TMPDIR} + +=cut + +my $tmpdir; +sub tmpdir { + return $tmpdir if defined $tmpdir; + foreach ('/sys$scratch', $ENV{TMPDIR}) { + next unless defined && -d && -w _; + $tmpdir = $_; + last; + } + $tmpdir = '' unless defined $tmpdir; + return $tmpdir; } =item updir (override) -Returns a string representing of the parent directory. +Returns a string representation of the parent directory: '[-]' =cut @@ -135,9 +150,9 @@ to C string value of C<$ENV{'PATH'}>. =cut sub path { - my(@dirs,$dir,$i); + my (@dirs,$dir,$i); while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } - @dirs; + return @dirs; } =item file_name_is_absolute (override) @@ -147,12 +162,20 @@ Checks for VMS directory spec as well as Unix separators. =cut sub file_name_is_absolute { - my($self,$file) = @_; + 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 =~ /:[^<\[]/; + $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ && $ENV{$file}; + return scalar($file =~ m!^/! || + $file =~ m![<\[][^.\-\]>]! || + $file =~ /:[^<\[]/); } -1; -__END__ +=back +=head1 SEE ALSO + +L + +=cut + +1; diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index 3af8bcf..5d998b9 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -1,12 +1,17 @@ package File::Spec::Win32; +use strict; +use vars qw(@ISA); +require File::Spec::Unix; +@ISA = qw(File::Spec::Unix); + =head1 NAME File::Spec::Win32 - methods for Win32 file specs =head1 SYNOPSIS - use File::Spec::Win32; # Done internally by File::Spec if needed + require File::Spec::Win32; # Done internally by File::Spec if needed =head1 DESCRIPTION @@ -16,37 +21,46 @@ the semantics. =over -=cut +=item devnull -#use Config; -#use Cwd; -use File::Basename; -require Exporter; -use strict; +Returns a string representation of the null device. -use vars qw(@ISA); +=cut -use File::Spec; -Exporter::import('File::Spec', qw( $Verbose)); +sub devnull { + return "nul"; +} -@ISA = qw(File::Spec::Unix); +=item tmpdir -$ENV{EMXSHELL} = 'sh'; # to run `commands` +Returns a string representation of the first existing directory +from the following list: -sub file_name_is_absolute { - my($self,$file) = @_; - $file =~ m{^([a-z]:)?[\\/]}i ; -} + $ENV{TMPDIR} + $ENV{TEMP} + $ENV{TMP} + /tmp + / + +=cut -sub catdir { +my $tmpdir; +sub tmpdir { + return $tmpdir if defined $tmpdir; my $self = shift; - my @args = @_; - for (@args) { - # append a slash to each argument unless it has one there - $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\"; + foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) { + next unless defined && -d; + $tmpdir = $_; + last; } - my $result = $self->canonpath(join('', @args)); - $result; + $tmpdir = '' unless defined $tmpdir; + $tmpdir = $self->canonpath($tmpdir); + return $tmpdir; +} + +sub file_name_is_absolute { + my ($self,$file) = @_; + return scalar($file =~ m{^([a-z]:)?[\\/]}i); } =item catfile @@ -57,26 +71,20 @@ complete path ending with a filename =cut sub catfile { - my $self = shift @_; + my $self = shift; my $file = pop @_; return $file unless @_; my $dir = $self->catdir(@_); - $dir =~ s/(\\\.)$//; - $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\"; + $dir .= "\\" unless substr($dir,-1) eq "\\"; return $dir.$file; } -sub devnull { - return "nul"; -} - sub path { local $^W = 1; - my($self) = @_; my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; my @path = split(';',$path); - foreach(@path) { $_ = '.' if $_ eq '' } - @path; + foreach (@path) { $_ = '.' if $_ eq '' } + return @path; } =item canonpath @@ -87,22 +95,23 @@ path. On UNIX eliminated successive slashes and successive "/.". =cut sub canonpath { - my($self,$path) = @_; + 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|([^\\])\\+|\1\\|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; + $path =~ s|\\$|| + unless $path =~ m#^([A-Z]:)?\\#; # xx/ -> xx + return $path; } -1; -__END__ - =back -=cut +=head1 SEE ALSO + +L +=cut + +1;