summaryrefslogtreecommitdiff
path: root/cpan/lib/File/Spec/VMS.pm
diff options
context:
space:
mode:
Diffstat (limited to 'cpan/lib/File/Spec/VMS.pm')
-rw-r--r--cpan/lib/File/Spec/VMS.pm441
1 files changed, 255 insertions, 186 deletions
diff --git a/cpan/lib/File/Spec/VMS.pm b/cpan/lib/File/Spec/VMS.pm
index 362cdaa2..600c49fa 100644
--- a/cpan/lib/File/Spec/VMS.pm
+++ b/cpan/lib/File/Spec/VMS.pm
@@ -4,7 +4,8 @@ use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '1.4';
+$VERSION = '3.62';
+$VERSION =~ tr/_//d;
@ISA = qw(File::Spec::Unix);
@@ -25,239 +26,238 @@ 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
+The default behavior is to allow either VMS or Unix syntax on input and to
+return VMS syntax on output unless Unix syntax has been explicitly requested
+via the C<DECC$FILENAME_UNIX_REPORT> CRTL feature.
-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.
+=over 4
=cut
-sub eliminate_macros {
- my($self,$path) = @_;
- return '' unless $path;
- $self = {} unless ref $self;
+# Need to look up the feature settings. The preferred way is to use the
+# VMS::Feature module, but that may not be available to dual life modules.
- if ($path =~ /\s/) {
- return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+my $use_feature;
+BEGIN {
+ if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+ $use_feature = 1;
}
-
- 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;
+# Need to look up the UNIX report mode. This may become a dynamic mode
+# in the future.
+sub _unix_rpt {
+ my $unix_rpt;
+ if ($use_feature) {
+ $unix_rpt = VMS::Feature::current("filename_unix_report");
+ } else {
+ my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
}
-
- # 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;
+ return $unix_rpt;
}
-=back
-
-=head2 Methods always loaded
-
-=over 4
-
=item canonpath (override)
-Removes redundant portions of file specifications according to VMS syntax.
+Removes redundant portions of file specifications and returns results
+in native syntax unless Unix filename reporting has been enabled.
=cut
+
sub canonpath {
my($self,$path) = @_;
- if ($path =~ m|/|) { # Fake Unix
+ return undef unless defined $path;
+
+ my $unix_rpt = $self->_unix_rpt;
+
+ if ($path =~ m|/|) {
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;
+
+ return $path if $unix_rpt;
+ $path = $pathify ? vmspath($path) : vmsify($path);
}
+
+ $path =~ s/(?<!\^)</[/; # < and > ==> [ and ]
+ $path =~ s/(?<!\^)>/]/;
+ $path =~ s/(?<!\^)\]\[\./\.\]\[/g; # ][. ==> .][
+ $path =~ s/(?<!\^)\[000000\.\]\[/\[/g; # [000000.][ ==> [
+ $path =~ s/(?<!\^)\[000000\./\[/g; # [000000. ==> [
+ $path =~ s/(?<!\^)\.\]\[000000\]/\]/g; # .][000000] ==> ]
+ $path =~ s/(?<!\^)\.\]\[/\./g; # foo.][bar ==> foo.bar
+ 1 while ($path =~ s/(?<!\^)([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/);
+ # That loop does the following
+ # with any amount of dashes:
+ # .-.-. ==> .--.
+ # [-.-. ==> [--.
+ # .-.-] ==> .--]
+ # [-.-] ==> [--]
+ 1 while ($path =~ s/(?<!\^)([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
+ # That loop does the following
+ # with any amount (minimum 2)
+ # of dashes:
+ # .foo.--. ==> .-.
+ # .foo.--] ==> .-]
+ # [foo.--. ==> [-.
+ # [foo.--] ==> [-]
+ #
+ # And then, the remaining cases
+ $path =~ s/(?<!\^)\[\.-/[-/; # [.- ==> [-
+ $path =~ s/(?<!\^)\.[^\]\.]+\.-\./\./g; # .foo.-. ==> .
+ $path =~ s/(?<!\^)\[[^\]\.]+\.-\./\[/g; # [foo.-. ==> [
+ $path =~ s/(?<!\^)\.[^\]\.]+\.-\]/\]/g; # .foo.-] ==> ]
+ # [foo.-] ==> [000000]
+ $path =~ s/(?<!\^)\[[^\]\.]+\.-\]/\[000000\]/g;
+ # [] ==>
+ $path =~ s/(?<!\^)\[\]// unless $path eq '[]';
+ return $unix_rpt ? unixify($path) : $path;
}
-=item catdir
+=item catdir (override)
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).
+native directory specification unless the Unix filename reporting feature
+has been enabled. 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 $self = shift;
+ my $dir = pop;
+
+ my $unix_rpt = $self->_unix_rpt;
+
+ my @dirs = grep {defined() && length()} @_;
+
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".
+ $spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i;
+
+ if ($unix_rpt) {
+ $spath = unixify($spath) unless $spath =~ m#/#;
+ $sdir= unixify($sdir) unless $sdir =~ m#/#;
+ return $self->SUPER::catdir($spath, $sdir)
+ }
+
+ $rslt = vmspath( unixify($spath) . '/' . unixify($sdir));
+
+ # 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); }
+
+ } else {
+ # Single directory. Return an empty string on null input; otherwise
+ # just return a canonical path.
+
+ if (not defined $dir or not length $dir) {
+ $rslt = '';
+ } else {
+ $rslt = $unix_rpt ? $dir : vmspath($dir);
+ }
}
return $self->canonpath($rslt);
}
-=item catfile
+=item catfile (override)
-Concatenates a list of file specifications, and returns the result as a
-VMS-syntax file specification.
+Concatenates a list of directory specifications with a filename specification
+to build a path.
=cut
sub catfile {
- my ($self,@files) = @_;
- my $file = $self->canonpath(pop @files);
- @files = grep($_,@files);
+ my $self = shift;
+ my $tfile = pop();
+ my $file = $self->canonpath($tfile);
+ my @files = grep {defined() && length()} @_;
+
+ my $unix_rpt = $self->_unix_rpt;
+
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) {
+
+ # Something building a VMS path in pieces may try to pass a
+ # directory name in filename format, so normalize it.
+ $spath =~ s/\.dir\Z(?!\n)//i;
+
+ # If the spath ends with a directory delimiter and the file is bare,
+ # then just concatenate them.
+ 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 = unixify($spath);
+ $rslt .= (defined($rslt) && length($rslt) ? '/' : '') . unixify($file);
+ $rslt = vmsify($rslt) unless $unix_rpt;
}
}
- else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; }
- return $self->canonpath($rslt);
+ else {
+ # Only passed a single file?
+ my $xfile = (defined($file) && length($file)) ? $file : '';
+
+ $rslt = $unix_rpt ? $xfile : vmsify($xfile);
+ }
+ return $self->canonpath($rslt) unless $unix_rpt;
+
+ # In Unix report mode, do not strip off redundant path information.
+ return $rslt;
}
=item curdir (override)
-Returns a string representation of the current directory: '[]'
+Returns a string representation of the current directory: '[]' or '.'
=cut
sub curdir {
+ my $self = shift @_;
+ return '.' if ($self->_unix_rpt);
return '[]';
}
=item devnull (override)
-Returns a string representation of the null device: '_NLA0:'
+Returns a string representation of the null device: '_NLA0:' or '/dev/null'
=cut
sub devnull {
+ my $self = shift @_;
+ return '/dev/null' if ($self->_unix_rpt);
return "_NLA0:";
}
=item rootdir (override)
Returns a string representation of the root directory: 'SYS$DISK:[000000]'
+or '/'
=cut
sub rootdir {
+ my $self = shift @_;
+ if ($self->_unix_rpt) {
+ # Root may exist, try it first.
+ my $try = '/';
+ my ($dev1, $ino1) = stat('/');
+ my ($dev2, $ino2) = stat('.');
+
+ # Perl falls back to '.' if it can not determine '/'
+ if (($dev1 != $dev2) || ($ino1 != $ino2)) {
+ return $try;
+ }
+ # Fall back to UNIX format sys$disk.
+ return '/sys$disk/';
+ }
return 'SYS$DISK:[000000]';
}
@@ -266,28 +266,37 @@ sub rootdir {
Returns a string representation of the first writable directory
from the following list or '' if none are writable:
+ /tmp if C<DECC$FILENAME_UNIX_REPORT> is enabled.
sys$scratch:
$ENV{TMPDIR}
-Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
+If running under taint mode, and if $ENV{TMPDIR}
is tainted, it is not used.
=cut
-my $tmpdir;
sub tmpdir {
+ my $self = shift @_;
+ my $tmpdir = $self->_cached_tmpdir('TMPDIR');
return $tmpdir if defined $tmpdir;
- my $self = shift;
- $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
+ if ($self->_unix_rpt) {
+ $tmpdir = $self->_tmpdir('/tmp', '/sys$scratch', $ENV{TMPDIR});
+ }
+ else {
+ $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
+ }
+ $self->_cache_tmpdir($tmpdir, 'TMPDIR');
}
=item updir (override)
-Returns a string representation of the parent directory: '[-]'
+Returns a string representation of the parent directory: '[-]' or '..'
=cut
sub updir {
+ my $self = shift @_;
+ return '..' if ($self->_unix_rpt);
return '[-]';
}
@@ -326,34 +335,71 @@ sub file_name_is_absolute {
$file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
return scalar($file =~ m!^/!s ||
$file =~ m![<\[][^.\-\]>]! ||
- $file =~ /:[^<\[]/);
+ $file =~ /^[A-Za-z0-9_\$\-\~]+(?<!\^):/);
}
=item splitpath (override)
-Splits using VMS syntax.
+ ($volume,$directories,$file) = File::Spec->splitpath( $path );
+ ($volume,$directories,$file) = File::Spec->splitpath( $path,
+ $no_file );
+
+Passing a true value for C<$no_file> indicates that the path being
+split only contains directory components, even on systems where you
+can usually (when not supporting a foreign syntax) tell the difference
+between directories and files at a glance.
=cut
sub splitpath {
- my($self,$path) = @_;
- my($dev,$dir,$file) = ('','','');
-
- vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
- return ($1 || '',$2 || '',$3);
+ my($self,$path, $nofile) = @_;
+ my($dev,$dir,$file) = ('','','');
+ my $vmsify_path = vmsify($path);
+
+ if ( $nofile ) {
+ #vmsify('d1/d2/d3') returns '[.d1.d2]d3'
+ #vmsify('/d1/d2/d3') returns 'd1:[d2]d3'
+ if( $vmsify_path =~ /(.*)\](.+)/ ){
+ $vmsify_path = $1.'.'.$2.']';
+ }
+ $vmsify_path =~ /(.+:)?(.*)/s;
+ $dir = defined $2 ? $2 : ''; # dir can be '0'
+ return ($1 || '',$dir,$file);
+ }
+ else {
+ $vmsify_path =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
+ return ($1 || '',$2 || '',$3);
+ }
}
=item splitdir (override)
-Split dirspec using VMS syntax.
+Split a directory specification into the components.
=cut
sub splitdir {
my($self,$dirspec) = @_;
- $dirspec =~ s/\]\[//g; $dirspec =~ s/\-\-/-.-/g;
- $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal
- my(@dirs) = split('\.', vmspath($dirspec));
+ my @dirs = ();
+ return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) );
+
+ $dirspec =~ s/(?<!\^)</[/; # < and > ==> [ and ]
+ $dirspec =~ s/(?<!\^)>/]/;
+ $dirspec =~ s/(?<!\^)\]\[\./\.\]\[/g; # ][. ==> .][
+ $dirspec =~ s/(?<!\^)\[000000\.\]\[/\[/g; # [000000.][ ==> [
+ $dirspec =~ s/(?<!\^)\[000000\./\[/g; # [000000. ==> [
+ $dirspec =~ s/(?<!\^)\.\]\[000000\]/\]/g; # .][000000] ==> ]
+ $dirspec =~ s/(?<!\^)\.\]\[/\./g; # foo.][bar ==> foo.bar
+ while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {}
+ # That loop does the following
+ # with any amount of dashes:
+ # .--. ==> .-.-.
+ # [--. ==> [-.-.
+ # .--] ==> .-.-]
+ # [--] ==> [-.-]
+ $dirspec = "[$dirspec]" unless $dirspec =~ /(?<!\^)[\[<]/; # make legal
+ $dirspec =~ s/^(\[|<)\./$1/;
+ @dirs = split /(?<!\^)\./, vmspath($dirspec);
$dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
@dirs;
}
@@ -361,7 +407,7 @@ sub splitdir {
=item catpath (override)
-Construct a complete filespec using VMS syntax
+Construct a complete filespec.
=cut
@@ -373,30 +419,35 @@ sub catpath {
$dev = $dir_volume unless length $dev;
$dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir;
- if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
+ 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);
+ $dir = "[$dir]" unless $dir =~ /(?<!\^)[\[<\/]/;
+ $dir = vmspath($dir);
}
+ $dir = '' if length($dev) && ($dir eq '[]' || $dir eq '<>');
"$dev$dir$file";
}
=item abs2rel (override)
-Use VMS syntax when converting filespecs.
+Attempt to convert an absolute file specification to a relative specification.
=cut
sub abs2rel {
my $self = shift;
return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
- if grep m{/}, @_;
+ if ((grep m{/}, @_) && !(grep m{(?<!\^)[\[<:]}, @_));
my($path,$base) = @_;
$base = $self->_cwd() unless defined $base and length $base;
- for ($path, $base) { $_ = $self->canonpath($_) }
+ # If there is no device or directory syntax on $base, make sure it
+ # is treated as a directory.
+ $base = VMS::Filespec::vmspath($base) unless $base =~ m{(?<!\^)[\[<:]};
+
+ for ($path, $base) { $_ = $self->rel2abs($_) }
# 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"
@@ -412,12 +463,12 @@ sub abs2rel {
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 );
+ my $pathchunks = @pathchunks;
unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
my @basechunks = $self->splitdir( $base_directories );
+ my $basechunks = @basechunks;
unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
while ( @pathchunks &&
@@ -430,23 +481,34 @@ sub abs2rel {
# @basechunks now contains the directories to climb out of,
# @pathchunks now has the directories to descend in to.
- $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
+ if ((@basechunks > 0) || ($basechunks != $pathchunks)) {
+ $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
+ }
+ else {
+ $path_directories = join '.', @pathchunks;
+ }
+ $path_directories = '['.$path_directories.']';
return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
}
=item rel2abs (override)
-Use VMS syntax when converting filespecs.
+Return an absolute file specification from a relative one.
=cut
sub rel2abs {
my $self = shift ;
- return vmspath(File::Spec::Unix::rel2abs( $self, @_ ))
- if ( join( '', @_ ) =~ m{/} ) ;
-
my ($path,$base ) = @_;
+ return undef unless defined $path;
+ if ($path =~ m/\//) {
+ $path = ( -d $path || $path =~ m/\/\z/ # educated guessing about
+ ? vmspath($path) # whether it's a directory
+ : vmsify($path) );
+ }
+ $base = vmspath($base) if defined $base && $base =~ m/\//;
+
# Clean up and split up $path
if ( ! $self->file_name_is_absolute( $path ) ) {
# Figure out the effective $base and clean it up.
@@ -486,13 +548,20 @@ sub rel2abs {
=back
+=head1 COPYRIGHT
+
+Copyright (c) 2004-14 by the Perl 5 Porters. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
=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">.
+L<http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files>.
=cut
generated by cgit v1.2.1 (git 2.18.0) at 2026-09-07 03:14:07 +0000