X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FIO%2Flib%2FIO%2FHandle.pm;h=778841118b8b1eac5703d0e9fad6e36553915993;hb=7b0f711abd55488cc790ac95f935f46d630a87bb;hp=30ee2e59899f2a4fc29aa98f31862c9c68bf9164;hpb=1e374101a32f2df640b9fad36d86b2ed88f6eaf8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm index 30ee2e5..7788411 100644 --- a/ext/IO/lib/IO/Handle.pm +++ b/ext/IO/lib/IO/Handle.pm @@ -1,4 +1,3 @@ - package IO::Handle; =head1 NAME @@ -20,6 +19,7 @@ IO::Handle - supply object methods for I/O handles $io->print("Some text\n"); } + # setvbuf is not available by default on Perls 5.8.0 and later. use IO::Handle '_IOLBF'; $io->setvbuf($buffer_var, _IOLBF, 1024); @@ -48,7 +48,7 @@ Creates a new C object. =item new_from_fd ( FD, MODE ) -Creates a C like C does. +Creates an C like C does. It requires two parameters, which are passed to the method C; if the fdopen fails, the object is destroyed. Otherwise, it is returned to the caller. @@ -69,9 +69,10 @@ corresponding built-in functions: $io->read ( BUF, LEN, [OFFSET] ) $io->print ( ARGS ) $io->printf ( FMT, [ARGS] ) + $io->say ( ARGS ) $io->stat $io->sysread ( BUF, LEN, [OFFSET] ) - $io->syswrite ( BUF, LEN, [OFFSET] ) + $io->syswrite ( BUF, [LEN, [OFFSET]] ) $io->truncate ( LEN ) See L for complete descriptions of each of the following @@ -100,28 +101,31 @@ The following methods are not supported on a per-filehandle basis. Furthermore, for doing normal I/O you might need these: -=over +=over 4 =item $io->fdopen ( FD, MODE ) C is like an ordinary C except that its first parameter -is not a filename but rather a file handle name, a IO::Handle object, +is not a filename but rather a file handle name, an IO::Handle object, or a file descriptor number. =item $io->opened -Returns true if the object is currently a valid file descriptor. +Returns true if the object is currently a valid file descriptor, false +otherwise. =item $io->getline This works like <$io> described in L -except that it's more readable and can be safely called in an -array context but still returns just one line. +except that it's more readable and can be safely called in a +list context but still returns just one line. If used as the conditional ++within a C or C-style C loop, however, you will need to ++emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>. =item $io->getlines -This works like <$io> when called in an array context to -read all the remaining lines in a file, except that it's more readable. +This works like <$io> when called in a list 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 $io->ungetc ( ORD ) @@ -139,31 +143,37 @@ called C. =item $io->error Returns a true value if the given handle has experienced any errors -since it was opened or since the last call to C. +since it was opened or since the last call to C, or if the +handle is invalid. It only returns false for a valid handle with no +outstanding errors. =item $io->clearerr -Clear the given handle's error indicator. +Clear the given handle's error indicator. Returns -1 if the handle is +invalid, 0 otherwise. =item $io->sync C synchronizes a file's in-memory state with that on the physical medium. C does not operate at the perlio api level, but -operates on the file descriptor, this means that any data held at the -perlio api level will not be synchronized. To synchronize data that is -buffered at the perlio api level you must use the flush method. C -is not implemented on all platforms. See L. +operates on the file descriptor (similar to sysread, sysseek and +systell). This means that any data held at the perlio api level will not +be synchronized. To synchronize data that is buffered at the perlio api +level you must use the flush method. C is not implemented on all +platforms. Returns "0 but true" on success, C on error, C +for an invalid handle. See L. =item $io->flush C causes perl to flush any buffered data at the perlio api level. Any unread data in the buffer will be discarded, and any unwritten data -will be written to the underlying file descriptor. +will be written to the underlying file descriptor. Returns "0 but true" +on success, C on error. =item $io->printflush ( ARGS ) Turns on autoflush, print ARGS and then restores the autoflush status of the -C object. +C object. Returns the return value from print. =item $io->blocking ( [ BOOL ] ) @@ -183,29 +193,41 @@ C and C set the buffering policy for an IO::Handle. The calling sequences for the Perl functions are the same as their C counterparts--including the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter -specifies a scalar variable to use as a buffer. WARNING: A variable -used as a buffer by C or C must not be modified in any -way until the IO::Handle is closed or C or C is called -again, or memory corruption may result! Note that you need to import -the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. +specifies a scalar variable to use as a buffer. You should only +change the buffer before any I/O, or immediately after calling flush. + +WARNING: The IO::Handle::setvbuf() is not available by default on +Perls 5.8.0 and later because setvbuf() is rather specific to using +the stdio library, while Perl prefers the new perlio subsystem instead. + +WARNING: A variable used as a buffer by C or C B in any way until the IO::Handle is closed or C or +C is called again, or memory corruption may result! Remember that +the order of global destruction is undefined, so even if your buffer +variable remains in scope until program termination, it may be undefined +before the file IO::Handle is closed. Note that you need to import the +constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf +returns nothing. setvbuf returns "0 but true", on success, C on +failure. Lastly, there is a special method for working under B<-T> and setuid/gid scripts: -=over +=over 4 =item $io->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. +vulnerability should be kept in mind. Returns 0 on success, -1 if setting +the taint-clean flag failed. (eg invalid handle) =back =head1 NOTE -A C object is a reference to a symbol/GLOB reference (see +An C object is a reference to a symbol/GLOB reference (see the C package). Some modules that inherit from C may want to keep object related variables in the hash table part of the GLOB. In an attempt to prevent modules @@ -232,9 +254,9 @@ Derived from FileHandle.pm by Graham Barr EFE =cut -require 5.000; +use 5.006_001; use strict; -use vars qw($VERSION @EXPORT_OK @ISA); +our($VERSION, @EXPORT_OK, @ISA); use Carp; use Symbol; use SelectSaver; @@ -243,7 +265,8 @@ use IO (); # Load the XS module require Exporter; @ISA = qw(Exporter); -$VERSION = "1.21"; +$VERSION = "1.27_01"; +$VERSION = eval $VERSION; @EXPORT_OK = qw( autoflush @@ -262,6 +285,7 @@ $VERSION = "1.21"; print printf + say getline getlines @@ -385,6 +409,13 @@ sub printf { printf $this @_; } +sub say { + @_ or croak 'usage: $io->say(ARGS)'; + my $this = shift; + local $\ = ""; + print $this @_, "\n"; +} + sub getline { @_ == 1 or croak 'usage: $io->getline()'; my $this = shift; @@ -417,14 +448,19 @@ sub sysread { } sub write { - @_ == 3 || @_ == 4 or croak 'usage: $io->write(BUF, LEN [, OFFSET])'; + @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])'; local($\) = ""; + $_[2] = length($_[1]) unless defined $_[2]; print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); } sub syswrite { - @_ == 3 || @_ == 4 or croak 'usage: $io->syswrite(BUF, LEN [, OFFSET])'; - syswrite($_[0], $_[1], $_[2], $_[3] || 0); + @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])'; + if (defined($_[2])) { + syswrite($_[0], $_[1], $_[2], $_[3] || 0); + } else { + syswrite($_[0], $_[1]); + } } sub stat { @@ -469,42 +505,47 @@ sub input_record_separator { sub input_line_number { local $.; - my $tell = tell qualify($_[0], caller) if ref($_[0]); + () = tell qualify($_[0], caller) if ref($_[0]); my $prev = $.; $. = $_[1] if @_ > 1; $prev; } sub format_page_number { - my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); + my $old; + $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $%; $% = $_[1] if @_ > 1; $prev; } sub format_lines_per_page { - my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); + my $old; + $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $=; $= = $_[1] if @_ > 1; $prev; } sub format_lines_left { - my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); + my $old; + $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $-; $- = $_[1] if @_ > 1; $prev; } sub format_name { - my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); + my $old; + $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $~; $~ = qualify($_[1], caller) if @_ > 1; $prev; } sub format_top_name { - my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); + my $old; + $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); my $prev = $^; $^ = qualify($_[1], caller) if @_ > 1; $prev; @@ -539,7 +580,7 @@ sub format_write { @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; if (@_ == 2) { my ($io, $fmt) = @_; - my $oldfmt = $io->format_name($fmt); + my $oldfmt = $io->format_name(qualify($fmt,caller)); CORE::write($io); $io->format_name($oldfmt); } else { @@ -547,18 +588,18 @@ sub format_write { } } +# XXX undocumented sub fcntl { @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; - my ($io, $op, $val) = @_; - my $r = fcntl($io, $op, $val); - defined $r && $r eq "0 but true" ? 0 : $r; + my ($io, $op) = @_; + return fcntl($io, $op, $_[2]); } +# XXX undocumented sub ioctl { @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; - my ($io, $op, $val) = @_; - my $r = ioctl($io, $op, $val); - defined $r && $r eq "0 but true" ? 0 : $r; + my ($io, $op) = @_; + return ioctl($io, $op, $_[2]); } # this sub is for compatability with older releases of IO that used @@ -575,11 +616,12 @@ sub constant { } -# so that flush.pl can be depriciated +# so that flush.pl can be deprecated sub printflush { my $io = shift; - my $old = new SelectSaver qualify($io, caller) if ref($io); + my $old; + $old = new SelectSaver qualify($io, caller) if ref($io); local $| = 1; if(ref($io)) { print $io @_;