From: Hans Mulder Date: Fri, 5 Jun 1998 11:08:40 +0000 (-0700) Subject: Mangled patch, needed hand-tweaks, along with binmode for rs.t: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b2b9c687790241e85aa7b76aaeec8b744ce6b49;p=p5sagit%2Fp5-mst-13.2.git Mangled patch, needed hand-tweaks, along with binmode for rs.t: Message-Id: <3.0.5.32.19980605110840.009e12b0@ous.edu> Subject: Re: [PATCH 5.004_66]Add record read capability to <> p4raw-id: //depot/perl@1099 --- diff --git a/perl.h b/perl.h index b1f0be0..c8bd8b5 100644 --- a/perl.h +++ b/perl.h @@ -1818,6 +1818,7 @@ typedef enum { #define RsSNARF(sv) (! SvOK(sv)) #define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv)) #define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv)) +#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) /* Set up PERLVAR macros for populating structs */ #define PERLVAR(var,type) type var; diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 2cb95af..d9edffa 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -222,6 +222,27 @@ character belongs to the next paragraph, even if it's a newline. Remember: the value of $/ is a string, not a regexp. AWK has to be better for something :-) +Setting $/ to a reference to an integer, scalar containing an integer, or +scalar that's convertable to an integer will attempt to read records +instead of lines, with the maximum record size being the referenced +integer. So this: + + $/ = \32768; # or \"32768", or \$var_containing_32768 + open(FILE, $myfile); + $_ = ; + +will read a record of no more than 32768 bytes from FILE. If you're not +reading from a record-oriented file (or your OS doesn't have +record-oriented files), then you'll likely get a full chunk of data with +every read. If a record is larger than the record size you've set, you'll +get the record back in pieces. + +On VMS, record reads are done with the equivalent of C, so it's +best not to mix record and non-record reads on the same file. (This is +likely not a problem, as any file you'd want to read in record mode is +proably usable in line mode) Non-VMS systems perform normal I/O, so +it's safe to mix record and non-record reads of a file. + =item autoflush HANDLE EXPR =item $OUTPUT_AUTOFLUSH diff --git a/sv.c b/sv.c index f5a979a..023693f 100644 --- a/sv.c +++ b/sv.c @@ -3153,6 +3153,31 @@ sv_gets(register SV *sv, register PerlIO *fp, I32 append) rsptr = NULL; rslen = 0; } + else if (RsRECORD(rs)) { + I32 recsize, bytesread; + char *buffer; + + /* Grab the size of the record we're getting */ + recsize = SvIV(SvRV(rs)); + (void)SvPOK_only(sv); /* Validate pointer */ + /* Make sure we've got the room to yank in the whole thing */ + if (SvLEN(sv) <= recsize + 3) { + /* No, so make it bigger */ + SvGROW(sv, recsize + 3); + } + buffer = SvPVX(sv); /* Get the location of the final buffer */ + /* Go yank in */ +#ifdef VMS + /* VMS wants read instead of fread, because fread doesn't respect */ + /* RMS record boundaries. This is not necessarily a good thing to be */ + /* doing, but we've got no other real choice */ + bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize); +#else + bytesread = PerlIO_read(fp, buffer, recsize); +#endif + SvCUR_set(sv, bytesread); + return(SvCUR(sv) ? SvPVX(sv) : Nullch); + } else if (RsPARA(rs)) { rsptr = "\n\n"; rslen = 2; diff --git a/t/base/rs.t b/t/base/rs.t new file mode 100755 index 0000000..2f467a6 --- /dev/null +++ b/t/base/rs.t @@ -0,0 +1,122 @@ +#!./perl +# Test $! + +print "1..14\n"; + +$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n"; + +# Create our test datafile +open TESTFILE, ">./foo" or die "error $! $^E opening"; +binmode TESTFILE; +print TESTFILE $teststring; +close TESTFILE; + +open TESTFILE, "<./foo"; +binmode TESTFILE; + +# Check the default $/ +$bar = ; +if ($bar eq "1\n") {print "ok 1\n";} else {print "not ok 1\n";} + +# explicitly set to \n +$/ = "\n"; +$bar = ; +if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";} + +# Try a non line terminator +$/ = "3"; +$bar = ; +if ($bar eq "123") {print "ok 3\n";} else {print "not ok 3\n";} + +# Eat the line terminator +$/ = "\n"; +$bar = ; + +# How about a larger terminator +$/ = "34"; +$bar = ; +if ($bar eq "1234") {print "ok 4\n";} else {print "not ok 4\n";} + +# Eat the line terminator +$/ = "\n"; +$bar = ; + +# Does paragraph mode work? +$/ = ''; +$bar = ; +if ($bar eq "1234\n12345\n\n") {print "ok 5\n";} else {print "not ok 5\n";} + +# Try slurping the rest of the file +$/ = undef; +$bar = ; +if ($bar eq "123456\n1234567\n") {print "ok 6\n";} else {print "not ok 6\n";} + +# try the record reading tests. New file so we don't have to worry about +# the size of \n. +close TESTFILE; +unlink "./foo"; +open TESTFILE, ">./foo"; +print TESTFILE "1234567890123456789012345678901234567890"; +binmode TESTFILE; +close TESTFILE; +open TESTFILE, "<./foo"; +binmode TESTFILE; + +# Test straight number +$/ = \2; +$bar = ; +if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";} + +# Test stringified number +$/ = \"2"; +$bar = ; +if ($bar eq "34") {print "ok 8\n";} else {print "not ok 8\n";} + +# Integer variable +$foo = 2; +$/ = \$foo; +$bar = ; +if ($bar eq "56") {print "ok 9\n";} else {print "not ok 9\n";} + +# String variable +$foo = "2"; +$/ = \$foo; +$bar = ; +if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";} + +# Get rid of the temp file +unlink "./foo"; + +# Now for the tricky bit--full record reading +if ($^O eq 'VMS') { + # Create a temp file. We jump through these hoops 'cause CREATE really + # doesn't like our methods for some reason. + open TEMPFILE, ">./foo"; + print TEMPFILE "foo\nfoobar\nbaz\n"; + close TEMPFILE; + open CREATEPIPE, "|\@sys\$input"; + print CREATEPIPE "DEFINE SYS\$INPUT FOO./user\n"; + print CREATEPIPE "CREATE []FOO.BAR\n"; + close CREATEPIPE; + unlink "./foo"; + + open TESTFILE, "<./foo.bar"; + $/ = \10; + $bar = ; + if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";} + $bar = ; + if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";} + # can we do a short read? + $/ = \2; + $bar = ; + if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";} + # do we get the rest of the record? + $bar = ; + if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";} + + unlink "./foo.bar"; +} else { + # Nobody else does this at the moment (well, maybe OS/390, but they can + # put their own tests in) so we just punt + foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"}; +}