perl 5.004_04

4 files changed, 63 insertions, 47 deletions

diff --git a/gnu/usr.bin/perl/vms/ext/Filespec.pm b/gnu/usr.bin/perl/vms/ext/Filespec.pm
index 3ce67aafdab..db3283c5713 100644
--- a/gnu/usr.bin/perl/vms/ext/Filespec.pm
+++ b/gnu/usr.bin/perl/vms/ext/Filespec.pm
@@ -12,6 +12,7 @@ VMS::Filespec - convert between VMS and Unix file specification syntax
 =head1 SYNOPSIS
 
 use VMS::Filespec;
+$fullspec = rmsexpand('[.VMS]file.specification');
 $vmsspec = vmsify('/my/Unix/file/specification');
 $unixspec = unixify('my:[VMS]file.specification');
 $path = pathify('my:[VMS.or.Unix.directory]specification.dir');
@@ -61,6 +62,14 @@ 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.  (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.
@@ -124,10 +133,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 +150,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);
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
index f87631a32aa..218c406fa44 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
@@ -1,8 +1,8 @@
 #   VMS::Stdio - VMS extensions to Perl's stdio calls
 #
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
-#   Version: 2.0
-#   Revised: 28-Feb-1996
+#   Version: 2.02
+#   Revised: 15-Feb-1997
 
 package VMS::Stdio;
 
@@ -12,8 +12,8 @@ use Carp '&croak';
 use DynaLoader ();
 use Exporter ();
  
-$VERSION = '2.0';
-@ISA = qw( Exporter DynaLoader FileHandle );
+$VERSION = '2.02';
+@ISA = qw( Exporter DynaLoader IO::File );
 @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY &O_NOWAIT
               &O_RDONLY &O_RDWR  &O_TRUNC &O_WRONLY );
 @EXPORT_OK = qw( &flush &getname &remove &rewind &sync &tmpnam
@@ -32,12 +32,13 @@ sub AUTOLOAD {
     if ($constname =~ /^O_/) {
       my($val) = constant($constname);
       defined $val or croak("Unknown VMS::Stdio constant $constname");
-      *$AUTOLOAD = sub { $val };
+      *$AUTOLOAD = sub { val; }
     }
-    else { # We don't know about it; hand off to FileHandle
-      require FileHandle;
-      my($obj) = shift(@_);
-      $obj->FileHandle::$constname(@_);
+    else { # We don't know about it; hand off to IO::File
+      require IO::File;
+
+      *$AUTOLOAD = eval "sub { shift->IO::File::$constname(\@_) }";
+      croak "Error autoloading IO::File::$constname: $@" if $@;
     }
     goto &$AUTOLOAD;
 }
@@ -75,7 +76,7 @@ __END__
 
 =head1 NAME
 
-VMS::Stdio
+VMS::Stdio - standard I/O functions via VMS extensions
 
 =head1 SYNOPSIS
 
@@ -98,7 +99,7 @@ remove("another.file");
 
 =head1 DESCRIPTION
 
-This package gives Perl scripts access to VMS extensions to several
+This package gives Perl scripts access via VMS extensions to several
 C stdio operations not available through Perl's CORE I/O functions.
 The specific routines are described below.  These functions are
 prototyped as unary operators, with the exception of C<vmsopen>
@@ -124,12 +125,12 @@ easily choose what you'd like to import:
 Of course, you can also choose to import specific functions by
 name, as usual.
 
-This package C<ISA> FileHandle, so that you can call FileHandle
+This package C<ISA> IO::File, so that you can call IO::File
 methods on the handles returned by C<vmsopen> and C<vmssysopen>.
-The FileHandle package is not initialized, however, until you
+The IO::File package is not initialized, however, until you
 actually call a method that VMS::Stdio doesn't provide.  This
 is doen to save startup time for users who don't wish to use
-the FileHandle methods.
+the IO::File methods.
 
 B<Note:>  In order to conform to naming conventions for Perl
 extensions and functions, the name of this package has been
@@ -140,6 +141,8 @@ VMS::Stdio function.  This compatibility interface will be
 removed in a future release of this extension, so please
 update your code to use the new routines.
 
+=over
+
 =item flush
 
 This function causes the contents of stdio buffers for the specified
@@ -152,7 +155,7 @@ returns a true value if successful, and C<undef> if not.
 =item getname
 
 The C<getname> function returns the file specification associated
-with a Perl FileHandle.  If an error occurs, it returns C<undef>.
+with a Perl I/O handle.  If an error occurs, it returns C<undef>.
 
 =item remove
 
@@ -187,23 +190,23 @@ reason, it is unable to generate a name, it returns C<undef>.
 =item vmsopen
 
 The C<vmsopen> function enables you to specify optional RMS arguments
-to the VMS CRTL when opening a file.  It is similar to the built-in
+to the VMS CRTL when opening a file.  Its operation is similar to the built-in
 Perl C<open> function (see L<perlfunc> for a complete description),
-but will only open normal files; it cannot open pipes or duplicate
-existing FileHandles.  Up to 8 optional arguments may follow the
+but it will only open normal files; it cannot open pipes or duplicate
+existing I/O handles.  Up to 8 optional arguments may follow the
 file name.  These arguments should be strings which specify
 optional file characteristics as allowed by the CRTL. (See the
 CRTL reference manual description of creat() and fopen() for details.)
 If successful, C<vmsopen> returns a VMS::Stdio file handle; if an
 error occurs, it returns C<undef>.
 
-You can use the file handle returned by C<vmsfopen> just as you
+You can use the file handle returned by C<vmsopen> just as you
 would any other Perl file handle.  The class VMS::Stdio ISA
-FileHandle, so you can call FileHandle methods using the handle
+IO::File, so you can call IO::File methods using the handle
 returned by C<vmsopen>.  However, C<use>ing VMS::Stdio does not
-automatically C<use> FileHandle; you must do so explicitly in
-your program if you want to call FileHandle methods.  This is
-done to avoid the overhead of initializing the FileHandle package
+automatically C<use> IO::File; you must do so explicitly in
+your program if you want to call IO::File methods.  This is
+done to avoid the overhead of initializing the IO::File package
 in programs which intend to use the handle returned by C<vmsopen>
 as a normal Perl file handle only.  When the scalar containing
 a VMS::Stdio file handle is overwritten, C<undef>d, or goes
@@ -230,6 +233,6 @@ task by calling the CRTL routine fwait().
 
 =head1 REVISION
 
-This document was last revised on 28-Jan-1996, for Perl 5.002.
+This document was last revised on 10-Dec-1996, for Perl 5.004.
 
 =cut
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
index 79eb95335e4..b10fec0d485 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
@@ -1,8 +1,8 @@
 /* VMS::Stdio - VMS extensions to stdio routines 
  *
- * Version:  2.0
+ * Version:  2.02
  * Author:   Charles Bailey  bailey@genetics.upenn.edu
- * Revised:  28-Feb-1996
+ * Revised:  15-Feb-1997
  *
  */
 
@@ -79,8 +79,8 @@ IV *pval;
 
 static SV *
 newFH(FILE *fp, char type) {
-    SV *rv, *gv = NEWSV(0,0);
-    GV **stashp;
+    SV *rv;
+    GV **stashp, *gv = (GV *)NEWSV(0,0);
     HV *stash;
     IO *io;
 
@@ -100,9 +100,9 @@ newFH(FILE *fp, char type) {
     gv_init(gv,stash,"__FH__",6,0);
     io = GvIOp(gv) = newIO();
     IoIFP(io) = fp;
-    if (type != '>') IoOFP(io) = fp;
+    if (type != '<') IoOFP(io) = fp;
     IoTYPE(io) = type;
-    rv = newRV(gv);
+    rv = newRV((SV *)gv);
     SvREFCNT_dec(gv);
     return sv_bless(rv,stash);
 }
@@ -127,7 +127,8 @@ flush(sv)
 	CODE:
 	    FILE *fp = Nullfp;
 	    if (SvOK(sv)) fp = IoIFP(sv_2io(sv));
-	    ST(0) = fflush(fp) ? &sv_undef : &sv_yes;
+	    if (fflush(fp)) { ST(0) = &sv_undef; }
+	    else            { clearerr(fp); ST(0) = &sv_yes; }
 
 char *
 getname(fp)
@@ -157,7 +158,8 @@ sync(fp)
 	FILE *	fp
 	PROTOTYPE: $
 	CODE:
-	    ST(0) = fsync(fileno(fp)) ? &sv_undef : &sv_yes;
+	    if (fsync(fileno(fp))) { ST(0) = &sv_undef; }
+	    else                   { clearerr(fp); ST(0) = &sv_yes; }
 
 char *
 tmpnam()
@@ -225,7 +227,7 @@ vmsopen(spec,...)
 	        break;
 	    }
 	    if (fp != Nullfp) {
-	      SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : '>')));
+	      SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>'))));
 	      ST(0) = (fh ? sv_2mortal(fh) : &sv_undef);
 	    }
 	    else { ST(0) = &sv_undef; }
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/test.pl b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
index 12e508aa1f7..0b50d63e3aa 100644
--- a/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
@@ -1,8 +1,8 @@
-# Tests for VMS::Stdio v2.0
+# Tests for VMS::Stdio v2.01
 use VMS::Stdio;
 import VMS::Stdio qw(&flush &getname &rewind &sync);
 
-print "1..13\n";
+print "1..14\n";
 print +(defined(&getname) ? '' : 'not '), "ok 1\n";
 
 $name = "test$$";
@@ -16,26 +16,29 @@ print +(sync($fh) ? '' : 'not '),"ok 4\n";
 $time = (stat("$name.tmp"))[9];
 print +($time ? '' : 'not '), "ok 5\n";
 
-print 'not ' unless print $fh scalar(localtime($time)),"\n";
+$fh->autoflush;  # Can we autoload autoflush from IO::File?  Do or die.
 print "ok 6\n";
 
-print +(rewind($fh) ? '' : 'not '),"ok 7\n";
+print 'not ' unless print $fh scalar(localtime($time)),"\n";
+print "ok 7\n";
+
+print +(rewind($fh) ? '' : 'not '),"ok 8\n";
 
 chop($line = <$fh>);
-print +($line eq localtime($time) ? '' : 'not '), "ok 8\n";
+print +($line eq localtime($time) ? '' : 'not '), "ok 9\n";
 
 ($gotname) = (getname($fh) =~/\](.*);/);
-print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 9\n";
+print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 10\n";
 
 $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0,
                               'ctx=rec', 'shr=put', 'dna=.tmp');
-print +($sfh ? '' : 'not ($!) '), "ok 10\n";
+print +($sfh ? '' : 'not ($!) '), "ok 11\n";
 
 close($fh);
 sysread($sfh,$line,24);
-print +($line eq localtime($time) ? '' : 'not '), "ok 11\n";
+print +($line eq localtime($time) ? '' : 'not '), "ok 12\n";
 
 undef $sfh;
-print +(stat("$name.tmp") ? 'not ' : ''),"ok 12\n";
+print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n";
 
-print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 13\n";
+print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n";