X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FIO%2Flib%2FIO%2FHandle.pm;h=e02f6dfe5d898f20f7a865c0cdaf9a0363accb6e;hb=f86702ccfcc3646d7aa30b09ce4f4413be9f99d1;hp=aaba77c056541fcb7cc45cada63e2b4d4dc7c2b6;hpb=8add82fcce53822c8119c2a311f526a412bbc9c7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index aaba77c..e02f6df 100644
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -1,81 +1,62 @@
-#
 
 package IO::Handle;
 
 =head1 NAME
 
-IO::Handle - supply object methods for filehandles
+IO::Handle - supply object methods for I/O handles
 
 =head1 SYNOPSIS
 
     use IO::Handle;
 
     $fh = new IO::Handle;
-    if ($fh->open "< file") {
-        print <$fh>;
-        $fh->close;
-    }
-
-    $fh = new IO::Handle "> FOO";
-    if (defined $fh) {
-        print $fh "bar\n";
+    if ($fh->fdopen(fileno(STDIN),"r")) {
+        print $fh->getline;
         $fh->close;
     }
 
-    $fh = new IO::Handle "file", "r";
-    if (defined $fh) {
-        print <$fh>;
-        undef $fh;       # automatically closes the file
-    }
-
-    $fh = new IO::Handle "file", O_WRONLY|O_APPEND;
-    if (defined $fh) {
-        print $fh "corge\n";
-        undef $fh;       # automatically closes the file
+    $fh = new IO::Handle;
+    if ($fh->fdopen(fileno(STDOUT),"w")) {
+        $fh->print("Some text\n");
     }
 
-    $pos = $fh->getpos;
-    $fh->setpos $pos;
-
     $fh->setvbuf($buffer_var, _IOLBF, 1024);
 
+    undef $fh;       # automatically closes the file if it's open
+
     autoflush STDOUT 1;
 
 =head1 DESCRIPTION
 
-C<IO::Handle::new> creates a C<IO::Handle>, which is a reference to a
-newly created symbol (see the C<Symbol> package).  If it receives any
-parameters, they are passed to C<IO::Handle::open>; if the open fails,
-the C<IO::Handle> object is destroyed.  Otherwise, it is returned to
-the caller.
-
-C<IO::Handle::new_from_fd> creates a C<IO::Handle> like C<new> does.
-It requires two parameters, which are passed to C<IO::Handle::fdopen>;
-if the fdopen fails, the C<IO::Handle> object is destroyed.
-Otherwise, it is returned to the caller.
-
-C<IO::Handle::open> accepts one parameter or two.  With one parameter,
-it is just a front end for the built-in C<open> function.  With two
-parameters, the first parameter is a filename that may include
-whitespace or other special characters, and the second parameter is
-the open mode in either Perl form (">", "+<", etc.) or POSIX form
-("w", "r+", etc.).
-
-C<IO::Handle::fdopen> is like C<open> except that its first parameter
-is not a filename but rather a file handle name, a IO::Handle object,
-or a file descriptor number.
+C<IO::Handle> is the base class for all other IO handle classes. It is
+not intended that objects of C<IO::Handle> would be created directly,
+but instead C<IO::Handle> is inherited from by several other classes
+in the IO hierarchy.
 
-C<IO::Handle::write> is like C<write> found in C, that is it is the
-opposite of read. The wrapper for the perl C<write> function is
-called C<format_write>.
+If you are reading this documentation, looking for a replacement for
+the C<FileHandle> package, then I suggest you read the documentation
+for C<IO::File>
+
+A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)
+
+=head1 CONSTRUCTOR
+
+=over 4
 
-C<IO::Handle::opened> returns true if the object is currently a valid
-file descriptor.
+=item new ()
 
-If the C functions fgetpos() and fsetpos() are available, then
-C<IO::Handle::getpos> returns an opaque value that represents the
-current position of the IO::Handle, and C<IO::Handle::setpos> uses
-that value to return to a previously visited position.
+Creates a new C<IO::Handle> object.
+
+=item new_from_fd ( FD, MODE )
+
+Creates a C<IO::Handle> like C<new> does.
+It requires two parameters, which are passed to the method C<fdopen>;
+if the fdopen fails, the object is destroyed. Otherwise, it is returned
+to the caller.
+
+=back
+
+=head1 METHODS
 
 If the C function setvbuf() is available, then C<IO::Handle::setvbuf>
 sets the buffering policy for the IO::Handle.  The calling sequence
@@ -90,15 +71,18 @@ result!
 See L<perlfunc> for complete descriptions of each of the following
 supported C<IO::Handle> methods, which are just front ends for the
 corresponding built-in functions:
-  
+
     close
     fileno
     getc
-    gets
     eof
     read
     truncate
     stat
+    print
+    printf
+    sysread
+    syswrite
 
 See L<perlvar> for complete descriptions of each of the following
 supported C<IO::Handle> methods:
@@ -121,14 +105,6 @@ Furthermore, for doing normal I/O you might need these:
 
 =over 
 
-=item $fh->print
-
-See L<perlfunc/print>.
-
-=item $fh->printf
-
-See L<perlfunc/printf>.
-
 =item $fh->getline
 
 This works like <$fh> described in L<perlop/"I/O Operators">
@@ -141,11 +117,40 @@ This works like <$fh> when called in an array context to
 read all the remaining lines in a file, except that it's more readable.
 It will also croak() if accidentally called in a scalar context.
 
+=item $fh->fdopen ( FD, MODE )
+
+C<fdopen> is like an ordinary C<open> except that its first parameter
+is not a filename but rather a file handle name, a IO::Handle object,
+or a file descriptor number.
+
+=item $fh->write ( BUF, LEN [, OFFSET }\] )
+
+C<write> is like C<write> found in C, that is it is the
+opposite of read. The wrapper for the perl C<write> function is
+called C<format_write>.
+
+=item $fh->opened
+
+Returns true if the object is currently a valid file descriptor.
+
+=back
+
+Lastly, a special method for working under B<-T> and setuid/gid scripts:
+
+=over
+
+=item $fh->untaint
+
+Marks the object as taint-clean, and as such data read from it will also
+be considered taint-clean. Note that this is a very trusting action to
+take, and appropriate consideration for the data source and potential
+vulnerability should be kept in mind.
+
 =back
 
-=head1
+=head1 NOTE
 
-The reference returned from new is a GLOB reference. Some modules that
+A C<IO::Handle> object is a GLOB reference. Some modules that
 inherit from C<IO::Handle> may want to keep object related variables
 in the hash table part of the GLOB. In an attempt to prevent modules
 trampling on each other I propose the that any such module should prefix
@@ -156,7 +161,7 @@ module keeps a C<timeout> variable in 'io_socket_timeout'.
 
 L<perlfunc>, 
 L<perlop/"I/O Operators">,
-L<POSIX/"FileHandle">
+L<IO::File>
 
 =head1 BUGS
 
@@ -167,12 +172,13 @@ class from C<IO::Handle> and inherit those methods.
 
 =head1 HISTORY
 
-Derived from FileHandle.pm by Graham Barr <bodg@tiuk.ti.com>
+Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
 
 =cut
 
 require 5.000;
-use vars qw($VERSION @EXPORT_OK $AUTOLOAD);
+use strict;
+use vars qw($VERSION $XS_VERSION @EXPORT_OK $AUTOLOAD @ISA);
 use Carp;
 use Symbol;
 use SelectSaver;
@@ -180,13 +186,8 @@ use SelectSaver;
 require Exporter;
 @ISA = qw(Exporter);
 
-##
-## TEMPORARY workaround as perl expects handles to be <FileHandle> objects
-##
-@FileHandle::ISA = qw(IO::Handle);
-
-
-$VERSION = sprintf("%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "1.1502";
+$XS_VERSION = "1.15";
 
 @EXPORT_OK = qw(
     autoflush
@@ -225,7 +226,7 @@ $VERSION = sprintf("%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
 
 require DynaLoader;
 @IO::ISA = qw(DynaLoader);
-bootstrap IO $VERSION;
+bootstrap IO $XS_VERSION;
 
 sub AUTOLOAD {
     if ($AUTOLOAD =~ /::(_?[a-z])/) {
@@ -236,6 +237,7 @@ sub AUTOLOAD {
     $constname =~ s/.*:://;
     my $val = constant($constname);
     defined $val or croak "$constname is not a valid IO::Handle macro";
+    no strict 'refs';
     *$AUTOLOAD = sub { $val };
     goto &$AUTOLOAD;
 }
@@ -246,30 +248,30 @@ sub AUTOLOAD {
 ##
 
 sub new {
-    @_ == 1 or croak 'usage: new IO::Handle';
-    my $class = ref($_[0]) || $_[0];
+    my $class = ref($_[0]) || $_[0] || "IO::Handle";
+    @_ == 1 or croak "usage: new $class";
     my $fh = gensym;
     bless $fh, $class;
 }
 
 sub new_from_fd {
-    @_ == 3 or croak 'usage: new_from_fd IO::Handle FD, MODE';
-    my $class = shift;
+    my $class = ref($_[0]) || $_[0] || "IO::Handle";
+    @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
     my $fh = gensym;
+    shift;
     IO::Handle::fdopen($fh, @_)
 	or return undef;
     bless $fh, $class;
-    $fh->_ref_fd;
-    $fh;
 }
 
-# FileHandle::DESTROY use to call close(). This creates a problem
-# if 2 Handle objects have the same fd. sv_clear will call io close
-# when the refcount in the xpvio becomes zero.
 #
-# It is defined as empty to stop AUTOLOAD being called :-)
+# There is no need for DESTROY to do anything, because when the
+# last reference to an IO object is gone, Perl automatically
+# closes its associated files (if any).  However, to avoid any
+# attempts to autoload DESTROY, we here define it to do nothing.
+#
+sub DESTROY {}
 
-sub DESTROY { }
 
 ################################################
 ## Open and close.
@@ -307,26 +309,16 @@ sub fdopen {
 sub close {
     @_ == 1 or croak 'usage: $fh->close()';
     my($fh) = @_;
-    my $r = close($fh);
 
-    # This may seem as though it should be in IO::Pipe, but the
-    # object gets blessed out of IO::Pipe when reader/writer is called
-    waitpid(${*$fh}{'io_pipe_pid'},0)
-	if(defined ${*$fh}{'io_pipe_pid'});
-
-    $r;
+    close($fh);
 }
 
 ################################################
 ## Normal I/O functions.
 ##
 
-# fcntl
 # flock
-# ioctl
 # select
-# sysread
-# syswrite
 
 sub opened {
     @_ == 1 or croak 'usage: $fh->opened()';
@@ -343,12 +335,6 @@ sub getc {
     getc($_[0]);
 }
 
-sub gets {
-    @_ == 1 or croak 'usage: $fh->gets()';
-    my ($handle) = @_;
-    scalar <$handle>;
-}
-
 sub eof {
     @_ == 1 or croak 'usage: $fh->eof()';
     eof($_[0]);
@@ -372,11 +358,13 @@ sub getline {
     return scalar <$this>;
 } 
 
+*gets = \&getline;  # deprecated
+
 sub getlines {
     @_ == 1 or croak 'usage: $fh->getline()';
-    my $this = shift;
     wantarray or
-	croak "Can't call IO::Handle::getlines in a scalar context, use IO::Handle::getline";
+	croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline';
+    my $this = shift;
     return <$this>;
 }
 
@@ -390,12 +378,22 @@ sub read {
     read($_[0], $_[1], $_[2], $_[3] || 0);
 }
 
+sub sysread {
+    @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])';
+    sysread($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
 sub write {
     @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
     local($\) = "";
     print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
 }
 
+sub syswrite {
+    @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])';
+    syswrite($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
 sub stat {
     @_ == 1 or croak 'usage: $fh->stat()';
     stat($_[0]);
@@ -510,5 +508,18 @@ sub format_write {
     }
 }
 
+sub fcntl {
+    @_ == 3 || croak 'usage: $fh->fcntl( OP, VALUE );';
+    my ($fh, $op, $val) = @_;
+    my $r = fcntl($fh, $op, $val);
+    defined $r && $r eq "0 but true" ? 0 : $r;
+}
+
+sub ioctl {
+    @_ == 3 || croak 'usage: $fh->ioctl( OP, VALUE );';
+    my ($fh, $op, $val) = @_;
+    my $r = ioctl($fh, $op, $val);
+    defined $r && $r eq "0 but true" ? 0 : $r;
+}
 
 1;