Make perlio line buffer VMS record-oriented files on output.

When perlio flushes down to the unix layer, it can introduce a
spurious record boundary when writing to a record-oriented file.
Perl may create such files when doing edit-in-place or any other
context where the file format is inherited from a previous
version of the file.

The problem can be eliminated by enabling line buffering on such
files when they are opened.  This was a regression in 5.10.0 since
before that stdio's buffering performed the same function.

N.B.  Lines longer than the size of the perlio buffer will still
result in multiple records -- a larger buffer may be necessary.

For more details and discussion see:

http://www.nntp.perl.org/group/perl.vmsperl/2010/11/msg15419.html

Thanks to Martin Zinser for the problem report.

diff --git a/ext/VMS-Stdio/t/vms_stdio.t b/ext/VMS-Stdio/t/vms_stdio.t
index 77505d8..64fe3a3 100644 (file)
--- a/ext/VMS-Stdio/t/vms_stdio.t
+++ b/ext/VMS-Stdio/t/vms_stdio.t
@@ -2,7 +2,7 @@
 use VMS::Stdio;
 import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
 
-print "1..18\n";
+print "1..19\n";
 print +(defined(&getname) ? '' : 'not '), "ok 1\n";
 
 #VMS can pretend that it is UNIX.
@@ -77,3 +77,33 @@ close $sfh;
 unlink("$name.tmp");
 print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n";
 #print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n";
+
+# This is not exactly a test of VMS::Stdio, but we need it to create a record-oriented
+# file and then make sure perlio can write to it without introducing spurious newlines.
+
+1 while unlink 'rectest.lis';
+END { 1 while unlink 'rectest.lis'; }
+
+$fh = VMS::Stdio::vmsopen('>rectest.lis', 'rfm=var', 'rat=cr')
+   or die "Couldn't open rectest.lis: $!";
+close $fh;
+
+open $fh, '>', 'rectest.lis'
+   or die "Couldn't open rectest.lis: $!";
+
+for (1..20) { print $fh ('Z' x 2048) . "\n" ; }
+
+close $fh;
+
+open $fh, '<', 'rectest.lis'
+   or die "Couldn't open rectest.lis: $!";
+
+my @records = <$fh>;
+close $fh;
+
+if (scalar(@records) == 20) {
+    print "ok 19\n";
+}
+else {
+    print "not ok 18 # Expected 20 got " . scalar(@records) . "\n";
+}

diff --git a/perlio.c b/perlio.c
index 13b1351..4620ecd 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -3761,6 +3761,22 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                 */
                PerlLIO_setmode(fd, O_BINARY);
 #endif
+#ifdef VMS
+#include <rms.h>
+               /* Enable line buffering with record-oriented regular files
+                * so we don't introduce an extraneous record boundary when
+                * the buffer fills up.
+                */
+               if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
+                   Stat_t st;
+                   if (PerlLIO_fstat(fd, &st) == 0
+                       && S_ISREG(st.st_mode)
+                       && (st.st_fab_rfm == FAB$C_VAR 
+                           || st.st_fab_rfm == FAB$C_VFC)) {
+                       PerlIOBase(f)->flags |= PERLIO_F_LINEBUF;
+                   }
+               }
+#endif
            }
        }
     }