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__
support by Charles Bailey <F<bailey@newman.upenn.edu>>. OS/2 support by
Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Mac support by Paul Schinder
<F<schinder@pobox.com>>.
-
-=cut
-
-
-1;
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
=head1 SYNOPSIS
-C<require File::Spec::Mac;>
+ require File::Spec::Mac; # Done internally by File::Spec if needed
=head1 DESCRIPTION
=cut
sub canonpath {
- my($self,$path) = @_;
- $path;
+ my ($self,$path) = @_;
+ return $path;
}
=item catdir
=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
=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
=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");
}
}
# 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
=cut
1;
-__END__
-
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;
=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
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
=head1 SYNOPSIS
-C<require File::Spec::Unix;>
+ require File::Spec::Unix; # Done automatically by File::Spec
=head1 DESCRIPTION
=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
=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
=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
=item rootdir
-Returns a string representing of the root directory. "/" on UNIX.
+Returns a string representation of the root directory. "/" on UNIX.
=cut
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
=cut
sub no_upwards {
- my($self) = shift;
+ my $self = shift;
return grep(!/^\.{1,2}$/, @_);
}
=cut
sub file_name_is_absolute {
- my($self,$file) = @_;
- $file =~ m:^/: ;
+ my ($self,$file) = @_;
+ return scalar($file =~ m:^/:);
}
=item path
=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
=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
=cut
1;
-__END__
-
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
=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
=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
=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
=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
=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)
=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<File::Spec>
+
+=cut
+
+1;
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
=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
=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
=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<File::Spec>
+=cut
+
+1;
projects / p5sagit/p5-mst-13.2.git / commitdiff