Upgrade to version.pm 0.48
[p5sagit/p5-mst-13.2.git] / vms / ext / Filespec.pm
index 3ce67aa..e0a179b 100644 (file)
@@ -1,8 +1,8 @@
 #   Perl hooks into the routines in vms.c for interconversion
 #   of VMS and Unix file specification syntax.
 #
-#   Version:  1.1
-#   Author:   Charles Bailey  bailey@genetics.upenn.edu
+#   Version:  see $VERSION below
+#   Author:   Charles Bailey  bailey@newman.upenn.edu
 #   Revised:  08-Mar-1995
 
 =head1 NAME
@@ -12,6 +12,7 @@ VMS::Filespec - convert between VMS and Unix file specification syntax
 =head1 SYNOPSIS
 
 use VMS::Filespec;
+$fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']);
 $vmsspec = vmsify('/my/Unix/file/specification');
 $unixspec = unixify('my:[VMS]file.specification');
 $path = pathify('my:[VMS.or.Unix.directory]specification.dir');
@@ -61,6 +62,16 @@ subroutine call, which bypasses prototype checking).
 
 The routines provided are:
 
+=head2 rmsexpand
+
+Uses the RMS $PARSE and $SEARCH services to expand the input
+specification to its fully qualified form, except that a null type
+or version is not added unless it was present in either the original
+file specification or the default specification passed to C<rmsexpand>.
+(If the file does not exist, the input specification is expanded as much
+as possible.)  If an error occurs, returns C<undef> and sets C<$!>
+and C<$^E>.
+
 =head2 vmsify
 
 Converts a file specification to VMS syntax.
@@ -117,6 +128,7 @@ This document was last revised 22-Feb-1996, for Perl 5.002.
 package VMS::Filespec;
 require 5.002;
 
+our $VERSION = '1.11';
 
 # If you want to use this package on a non-VMS system,
 # uncomment the following line.
@@ -124,10 +136,9 @@ require 5.002;
 require Exporter;
 
 @ISA = qw( Exporter );
-@EXPORT = qw( &vmsify &unixify &pathify  &fileify
-              &vmspath &unixpath &candelete);
+@EXPORT = qw( &vmsify &unixify &pathify &fileify
+              &vmspath &unixpath &candelete &rmsexpand );
 
-@EXPORT_OK = qw( &rmsexpand );
 1;
 
 
@@ -142,7 +153,7 @@ __END__
 # should be adequate for most purposes.
 
 # A sort-of sys$parse() replacement
-sub rmsexpand {
+sub rmsexpand ($;$) {
   my($fspec,$defaults) = @_;
   if (!$fspec) { return undef }
   my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
@@ -169,6 +180,7 @@ sub rmsexpand {
   ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
      /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
   foreach ((@$defaults,$ENV{'DEFAULT'})) {
+    next unless defined;
     last if $node && $ver && $type && $dev && $dir && $name;
     ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
        /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
@@ -256,6 +268,7 @@ sub fileify ($) {
   my($path) = @_;
 
   if (!$path) { return undef }
+  if ($path eq '/') { return 'sys$disk:[000000]'; }
   if ($path =~ /(.+)\.([^:>\]]*)$/) {
     $path = $1;
     if ($2 !~ /^dir(?:;1)?$/i) { return undef }
@@ -327,7 +340,7 @@ sub candelete ($) {
   return '' unless -w $fspec;
   $fspec =~ s#/$##;
   if ($fspec =~ m#/#) {
-    ($parent = $fspec) =~ s#/[^/]+$#;
+    ($parent = $fspec) =~ s#/[^/]+$##;
     return (-w $parent);
   }
   elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms