From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 12 Nov 2000 21:30:04 +0000 (+0000)
Subject: [ID 20001112.006] IO::Seekable::getpos doesn't check for fgetpos() failure
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a6a714bd63c892b02b99c5d9a11e90c9a061423b;p=p5sagit%2Fp5-mst-13.2.git

[ID 20001112.006] IO::Seekable::getpos doesn't check for fgetpos() failure
Message-Id: <E13v4hQ-0000mn-00@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@7662
---

diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 1b79cfd..6da48dc 100644
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -142,12 +142,17 @@ fgetpos(handle)
     CODE:
 	if (handle) {
 	    Fpos_t pos;
+	    if (
 #ifdef PerlIO
-	    PerlIO_getpos(handle, &pos);
+		PerlIO_getpos(handle, &pos)
 #else
-	    fgetpos(handle, &pos);
+		fgetpos(handle, &pos)
 #endif
-	    ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+		) {
+		ST(0) = &PL_sv_undef;
+	    } else {
+		ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+	    }
 	}
 	else {
 	    ST(0) = &PL_sv_undef;
diff --git a/ext/IO/lib/IO/Seekable.pm b/ext/IO/lib/IO/Seekable.pm
index e09d48b..77e0c3a 100644
--- a/ext/IO/lib/IO/Seekable.pm
+++ b/ext/IO/lib/IO/Seekable.pm
@@ -18,19 +18,69 @@ C<IO::Seekable> does not have a constructor of its own as it is intended to
 be inherited by other C<IO::Handle> based objects. It provides methods
 which allow seeking of the file descriptors.
 
-If the C functions fgetpos() and fsetpos() are available, then
-C<$io-E<lt>getpos> returns an opaque value that represents the
-current position of the IO::File, and C<$io-E<gt>setpos(POS)> uses
-that value to return to a previously visited position.
+=over 4
 
+=item $io->getpos
+
+Returns an opaque value that represents the current position of the
+IO::File, or C<undef> if this is not possible (eg an unseekable stream such
+as a terminal, pipe or socket). If the fgetpos() function is available in
+your C library it is used to implements getpos, else perl emulates getpos
+using C's ftell() function.
+
+=item $io->setpos
+
+Uses the value of a previous getpos call to return to a previously visited
+position. Returns 0 on success, -1 on failure.
+
+=back
+  
 See L<perlfunc> for complete descriptions of each of the following
 supported C<IO::Seekable> methods, which are just front ends for the
 corresponding built-in functions:
 
-  $io->seek( POS, WHENCE )
-  $io->sysseek( POS, WHENCE )
-  $io->tell
+=over 4
+
+=item $io->setpos ( POS, WHENCE )
+
+Seek the IO::File to position POS, relative to WHENCE:
+
+=over 8
+
+=item WHENCE=0 (SEEK_SET)
+
+POS is absolute position. (Seek relative to the start of the file)
+
+=item WHENCE=1 (SEEK_CUR)
+
+POS is an offset from the current position. (Seek relative to current)
+
+=item WHENCE=1 (SEEK_END)
+
+POS is an offset from the end of the file. (Seek relative to end)
+
+=back
+
+The SEEK_* constants can be imported from the C<Fcntl> module if you
+don't wish to use the numbers C<0> C<1> or C<2> in your code.
+
+Returns C<1> upon success, C<0> otherwise.
+
+=item $io->sysseek( POS, WHENCE )
+
+Similar to $io->seek, but sets the IO::File's position using the system
+call lseek(2) directly, so will confuse most perl IO operators except
+sysread and syswrite (see L<perlfunc> for full details)
+
+Returns the new position, or C<undef> on failure.  A position
+of zero is returned as the string C<"0 but true">
+
+=item $io->tell
+
+Returns the IO::File's current position, or -1 on error.
 
+=back
+  
 =head1 SEE ALSO
 
 L<perlfunc>, 
diff --git a/t/lib/io_xs.t b/t/lib/io_xs.t
index 9305c31..47a20aa 100755
--- a/t/lib/io_xs.t
+++ b/t/lib/io_xs.t
@@ -21,7 +21,7 @@ BEGIN {
 use IO::File;
 use IO::Seekable;
 
-print "1..4\n";
+print "1..6\n";
 
 $x = new_tmpfile IO::File or print "not ";
 print "ok 1\n";
@@ -40,3 +40,23 @@ print scalar <$x>;
 $! = 0;
 $x->setpos(undef);
 print $! ? "ok 4 # $!\n" : "not ok 4\n";
+
+# These shenanigans are intended to make a perl IO pointing to C FILE *
+# (or equivalent) on a closed file handle. Something that will fail fgetops()
+# Might be easier to use STDIN if (-t STDIN || -P STDIN) if ttys/pipes on
+# all platforms fail to fgetpos()
+$fn = $x->fileno();
+$y = new IO::File;
+if ($y->fdopen ($fn, "r")) {
+  print "ok 5\n";
+  $x->close() or die $!;
+  $!=0;
+  $p = $y->getpos;
+  if (defined $p) {
+    print "not ok 6 # closed handle returned defined position, \$!='$!'\n";
+  } else {
+    print "ok 6 # $!\n";
+  }
+} else {
+  print "not ok 5 # failed to duplicated file number $fd\n", "not ok 6\n";
+}