applied suggested patch, modulo superseded parts

	Message-id: <01J8YFGIHW2W001E7S@mail.newman.upenn.edu>
	Subject: [PATCH 5.005_56] Miscellaneous VMS-specific fixes

p4raw-id: //depot/perl@3153

3 files changed, 79 insertions, 12 deletions

diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm
index 04b339725f..d485e0e159 100644
--- a/vms/ext/Stdio/Stdio.pm
+++ b/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.1
-#   Revised: 24-Mar-1998
+#   Version: 2.2
+#   Revised: 19-Jul-1998
 #   Docs revised: 13-Oct-1998 Dan Sugalski <sugalskd@ous.edu>
 
 package VMS::Stdio;
@@ -13,17 +13,17 @@ use Carp '&croak';
 use DynaLoader ();
 use Exporter ();
  
-$VERSION = '2.1';
+$VERSION = '2.2';
 @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 &setdef &tmpnam
+@EXPORT_OK = qw( &binmode &flush &getname &remove &rewind &sync &setdef &tmpnam
                  &vmsopen &vmssysopen &waitfh &writeof );
 %EXPORT_TAGS = ( CONSTANTS => [ qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY
                                     &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC
                                     &O_WRONLY ) ],
-                 FUNCTIONS => [ qw( &flush &getname &remove &rewind &setdef
-                                    &sync &tmpnam &vmsopen &vmssysopen
+                 FUNCTIONS => [ qw( &binmode &flush &getname &remove &rewind
+                                    &setdef &sync &tmpnam &vmsopen &vmssysopen
                                     &waitfh &writeof ) ] );
 
 bootstrap VMS::Stdio $VERSION;
@@ -100,6 +100,7 @@ VMS::Stdio - standard I/O functions via VMS extensions
   close($fh);
   remove("another.file");
   writeof($pipefh);
+  binmode($fh);
 
 =head1 DESCRIPTION
 
@@ -147,6 +148,22 @@ update your code to use the new routines.
 
 =over
 
+=item binmode
+
+This function causes the file handle to be reopened with the CRTL's
+carriage control processing disabled; its effect is the same as that
+of the C<b> access mode in C<vmsopen>.  After the file is reopened,
+the file pointer is positioned as close to its position before the
+call as possible (I<i.e.> as close as fsetpos() can get it -- for
+some record-structured files, it's not possible to return to the
+exact byte offset in the file).  Because the file must be reopened,
+this function cannot be used on temporary-delete files. C<binmode>
+returns true if successful, and C<undef> if not.
+
+Note that the effect of C<binmode> differs from that of the binmode()
+function on operating systems such as Windows and MSDOS, and is not
+needed to process most types of file.
+
 =item flush
 
 This function causes the contents of stdio buffers for the specified
diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs
index 53b491575d..22d9a7262c 100644
--- a/vms/ext/Stdio/Stdio.xs
+++ b/vms/ext/Stdio/Stdio.xs
@@ -1,8 +1,8 @@
 /* VMS::Stdio - VMS extensions to stdio routines 
  *
- * Version:  2.1
- * Author:   Charles Bailey  bailey@genetics.upenn.edu
- * Revised:  24-Mar-1998
+ * Version:  2.2
+ * Author:   Charles Bailey  bailey@newman.upenn.edu
+ * Revised:  18-Jul-1998
  *
  */
 
@@ -125,6 +125,57 @@ constant(name)
 	    ST(0) = &PL_sv_undef;
 
 void
+binmode(fh)
+	SV *	fh
+	PROTOTYPE: $
+	CODE:
+	    IO *io = sv_2io(fh);
+	    FILE *fp = io ? IoOFP(io) : NULL;
+	    char iotype = io ? IoTYPE(io) : '\0';
+	    char filespec[NAM$C_MAXRSS], *acmode, *s, *colon, *dirend = Nullch;
+	    int ret = 0, saverrno = errno, savevmserrno = vaxc$errno;
+	    fpos_t pos;
+	    if (fp == NULL || strchr(">was+-|",iotype) == Nullch) {
+	      set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
+	    }
+	    if (!fgetname(fp,filespec)) XSRETURN_UNDEF;
+	    for (s = filespec; *s; s++) {
+	      if (*s == ':') colon = s;
+	      else if (*s == ']' || *s == '>') dirend = s;
+	    }
+	    /* Looks like a tmpfile, which will go away if reopened */
+	    if (s == dirend + 3) {
+	      set_errno(EBADF); set_vaxc_errno(RMS$_IOP); XSRETURN_UNDEF;
+	    }
+	    /* If we've got a non-file-structured device, clip off the trailing
+	     * junk, and don't lose sleep if we can't get a stream position.  */
+	    if (dirend == Nullch) *(colon+1) = '\0'; 
+	    if (iotype != '-' && (ret = fgetpos(fp, &pos)) == -1 && dirend)
+	      XSRETURN_UNDEF;
+	    switch (iotype) {
+	      case '<': case 'r':           acmode = "rb";                      break;
+	      case '>': case 'w': case '|':
+	        /* use 'a' instead of 'w' to avoid creating new file;
+	           fsetpos below will take care of restoring file position */
+	      case 'a':                     acmode = "ab";                      break;
+	      case '+':  case 's':          acmode = "rb+";                     break;
+	      case '-':                     acmode = fileno(fp) ? "ab" : "rb";  break;
+	      /* iotype'll be null for the SYS$INPUT:/SYS$OUTPUT:/SYS$ERROR: files */
+	      /* since we didn't really open them and can't really */
+	      /* reopen them */
+	      case 0:                       XSRETURN_UNDEF;
+	      default:
+	        if (PL_dowarn) warn("Unrecognized iotype %c for %s in binmode",
+	                         iotype, filespec);
+	        acmode = "rb+";
+	    }
+	    if (freopen(filespec,acmode,fp) == NULL) XSRETURN_UNDEF;
+	    if (iotype != '-' && ret != -1 && fsetpos(fp,&pos) == -1) XSRETURN_UNDEF;
+	    if (ret == -1) { set_errno(saverrno); set_vaxc_errno(savevmserrno); }
+	    XSRETURN_YES;
+
+
+void
 flush(fp)
 	FILE *	fp
 	PROTOTYPE: $
@@ -365,8 +416,7 @@ writeof(mysv)
 	    IO *io = sv_2io(mysv);
 	    FILE *fp = io ? IoOFP(io) : NULL;
 	    if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == Nullch) {
-	      set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN);
-	      ST(0) = &PL_sv_undef;  XSRETURN(1);
+	      set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
 	    }
 	    if (fgetname(fp,devnam) == Nullch) { ST(0) = &PL_sv_undef; XSRETURN(1); }
 	    if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
diff --git a/vms/ext/Stdio/test.pl b/vms/ext/Stdio/test.pl
index 37131deb01..2f735734c1 100755
--- a/vms/ext/Stdio/test.pl
+++ b/vms/ext/Stdio/test.pl
@@ -1,4 +1,4 @@
-# Tests for VMS::Stdio v2.1
+# Tests for VMS::Stdio v2.2
 use VMS::Stdio;
 import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);