diff options
Diffstat (limited to 'Master/xemtex/perl/lib/IO/Handle.pm')
-rw-r--r-- | Master/xemtex/perl/lib/IO/Handle.pm | 613 |
1 files changed, 0 insertions, 613 deletions
diff --git a/Master/xemtex/perl/lib/IO/Handle.pm b/Master/xemtex/perl/lib/IO/Handle.pm deleted file mode 100644 index 81bec5a6c1a..00000000000 --- a/Master/xemtex/perl/lib/IO/Handle.pm +++ /dev/null @@ -1,613 +0,0 @@ - -package IO::Handle; - -=head1 NAME - -IO::Handle - supply object methods for I/O handles - -=head1 SYNOPSIS - - use IO::Handle; - - $io = new IO::Handle; - if ($io->fdopen(fileno(STDIN),"r")) { - print $io->getline; - $io->close; - } - - $io = new IO::Handle; - if ($io->fdopen(fileno(STDOUT),"w")) { - $io->print("Some text\n"); - } - - use IO::Handle '_IOLBF'; - $io->setvbuf($buffer_var, _IOLBF, 1024); - - undef $io; # automatically closes the file if it's open - - autoflush STDOUT 1; - -=head1 DESCRIPTION - -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. - -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> too. - -=head1 CONSTRUCTOR - -=over 4 - -=item new () - -Creates a new C<IO::Handle> object. - -=item new_from_fd ( FD, MODE ) - -Creates an 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 - -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: - - $io->close - $io->eof - $io->fileno - $io->format_write( [FORMAT_NAME] ) - $io->getc - $io->read ( BUF, LEN, [OFFSET] ) - $io->print ( ARGS ) - $io->printf ( FMT, [ARGS] ) - $io->stat - $io->sysread ( BUF, LEN, [OFFSET] ) - $io->syswrite ( BUF, [LEN, [OFFSET]] ) - $io->truncate ( LEN ) - -See L<perlvar> for complete descriptions of each of the following -supported C<IO::Handle> methods. All of them return the previous -value of the attribute and takes an optional single argument that when -given will set the value. If no argument is given the previous value -is unchanged (except for $io->autoflush will actually turn ON -autoflush by default). - - $io->autoflush ( [BOOL] ) $| - $io->format_page_number( [NUM] ) $% - $io->format_lines_per_page( [NUM] ) $= - $io->format_lines_left( [NUM] ) $- - $io->format_name( [STR] ) $~ - $io->format_top_name( [STR] ) $^ - $io->input_line_number( [NUM]) $. - -The following methods are not supported on a per-filehandle basis. - - IO::Handle->format_line_break_characters( [STR] ) $: - IO::Handle->format_formfeed( [STR]) $^L - IO::Handle->output_field_separator( [STR] ) $, - IO::Handle->output_record_separator( [STR] ) $\ - - IO::Handle->input_record_separator( [STR] ) $/ - -Furthermore, for doing normal I/O you might need these: - -=over 4 - -=item $io->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, an IO::Handle object, -or a file descriptor number. - -=item $io->opened - -Returns true if the object is currently a valid file descriptor, false -otherwise. - -=item $io->getline - -This works like <$io> described in L<perlop/"I/O Operators"> -except that it's more readable and can be safely called in a -list context but still returns just one line. - -=item $io->getlines - -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 ) - -Pushes a character with the given ordinal value back onto the given -handle's input stream. Only one character of pushback per handle is -guaranteed. - -=item $io->write ( BUF, LEN [, OFFSET ] ) - -This 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 $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<clearerr>, 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. Returns -1 if the handle is -invalid, 0 otherwise. - -=item $io->sync - -C<sync> synchronizes a file's in-memory state with that on the -physical medium. C<sync> does not operate at the perlio api level, but -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<sync> is not implemented on all -platforms. Returns "0 but true" on success, C<undef> on error, C<undef> -for an invalid handle. See L<fsync(3c)>. - -=item $io->flush - -C<flush> 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. Returns "0 but true" -on success, C<undef> on error. - -=item $io->printflush ( ARGS ) - -Turns on autoflush, print ARGS and then restores the autoflush status of the -C<IO::Handle> object. Returns the return value from print. - -=item $io->blocking ( [ BOOL ] ) - -If called with an argument C<blocking> will turn on non-blocking IO if -C<BOOL> is false, and turn it off if C<BOOL> is true. - -C<blocking> will return the value of the previous setting, or the -current setting if C<BOOL> is not given. - -If an error occurs C<blocking> will return undef and C<$!> will be set. - -=back - - -If the C functions setbuf() and/or setvbuf() are available, then -C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> 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. You should only -change the buffer before any I/O, or immediately after calling flush. - -WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not -be modified> in any way until the IO::Handle is closed or C<setbuf> or -C<setvbuf> 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<undef> on -failure. - -Lastly, there is a special method for working under B<-T> and setuid/gid -scripts: - -=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. Returns 0 on success, -1 if setting -the taint-clean flag failed. (eg invalid handle) - -=back - -=head1 NOTE - -An C<IO::Handle> object is a reference to a symbol/GLOB reference (see -the C<Symbol> package). 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 -its variables with its own name separated by _'s. For example the IO::Socket -module keeps a C<timeout> variable in 'io_socket_timeout'. - -=head1 SEE ALSO - -L<perlfunc>, -L<perlop/"I/O Operators">, -L<IO::File> - -=head1 BUGS - -Due to backwards compatibility, all filehandles resemble objects -of class C<IO::Handle>, or actually classes derived from that class. -They actually aren't. Which means you can't derive your own -class from C<IO::Handle> and inherit those methods. - -=head1 HISTORY - -Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt> - -=cut - -use 5.006_001; -use strict; -our($VERSION, @EXPORT_OK, @ISA); -use Carp; -use Symbol; -use SelectSaver; -use IO (); # Load the XS module - -require Exporter; -@ISA = qw(Exporter); - -$VERSION = "1.21_00"; -$VERSION = eval $VERSION; - -@EXPORT_OK = qw( - autoflush - output_field_separator - output_record_separator - input_record_separator - input_line_number - format_page_number - format_lines_per_page - format_lines_left - format_name - format_top_name - format_line_break_characters - format_formfeed - format_write - - print - printf - getline - getlines - - printflush - flush - - SEEK_SET - SEEK_CUR - SEEK_END - _IOFBF - _IOLBF - _IONBF -); - -################################################ -## Constructors, destructors. -## - -sub new { - my $class = ref($_[0]) || $_[0] || "IO::Handle"; - @_ == 1 or croak "usage: new $class"; - my $io = gensym; - bless $io, $class; -} - -sub new_from_fd { - my $class = ref($_[0]) || $_[0] || "IO::Handle"; - @_ == 3 or croak "usage: new_from_fd $class FD, MODE"; - my $io = gensym; - shift; - IO::Handle::fdopen($io, @_) - or return undef; - bless $io, $class; -} - -# -# 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 {} - - -################################################ -## Open and close. -## - -sub _open_mode_string { - my ($mode) = @_; - $mode =~ /^\+?(<|>>?)$/ - or $mode =~ s/^r(\+?)$/$1</ - or $mode =~ s/^w(\+?)$/$1>/ - or $mode =~ s/^a(\+?)$/$1>>/ - or croak "IO::Handle: bad open mode: $mode"; - $mode; -} - -sub fdopen { - @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; - my ($io, $fd, $mode) = @_; - local(*GLOB); - - if (ref($fd) && "".$fd =~ /GLOB\(/o) { - # It's a glob reference; Alias it as we cannot get name of anon GLOBs - my $n = qualify(*GLOB); - *GLOB = *{*$fd}; - $fd = $n; - } elsif ($fd =~ m#^\d+$#) { - # It's an FD number; prefix with "=". - $fd = "=$fd"; - } - - open($io, _open_mode_string($mode) . '&' . $fd) - ? $io : undef; -} - -sub close { - @_ == 1 or croak 'usage: $io->close()'; - my($io) = @_; - - close($io); -} - -################################################ -## Normal I/O functions. -## - -# flock -# select - -sub opened { - @_ == 1 or croak 'usage: $io->opened()'; - defined fileno($_[0]); -} - -sub fileno { - @_ == 1 or croak 'usage: $io->fileno()'; - fileno($_[0]); -} - -sub getc { - @_ == 1 or croak 'usage: $io->getc()'; - getc($_[0]); -} - -sub eof { - @_ == 1 or croak 'usage: $io->eof()'; - eof($_[0]); -} - -sub print { - @_ or croak 'usage: $io->print(ARGS)'; - my $this = shift; - print $this @_; -} - -sub printf { - @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; - my $this = shift; - printf $this @_; -} - -sub getline { - @_ == 1 or croak 'usage: $io->getline()'; - my $this = shift; - return scalar <$this>; -} - -*gets = \&getline; # deprecated - -sub getlines { - @_ == 1 or croak 'usage: $io->getlines()'; - wantarray or - croak 'Can\'t call $io->getlines in a scalar context, use $io->getline'; - my $this = shift; - return <$this>; -} - -sub truncate { - @_ == 2 or croak 'usage: $io->truncate(LEN)'; - truncate($_[0], $_[1]); -} - -sub read { - @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; - read($_[0], $_[1], $_[2], $_[3] || 0); -} - -sub sysread { - @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; - sysread($_[0], $_[1], $_[2], $_[3] || 0); -} - -sub write { - @_ >= 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 { - @_ >= 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 { - @_ == 1 or croak 'usage: $io->stat()'; - stat($_[0]); -} - -################################################ -## State modification functions. -## - -sub autoflush { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $|; - $| = @_ > 1 ? $_[1] : 1; - $prev; -} - -sub output_field_separator { - carp "output_field_separator is not supported on a per-handle basis" - if ref($_[0]); - my $prev = $,; - $, = $_[1] if @_ > 1; - $prev; -} - -sub output_record_separator { - carp "output_record_separator is not supported on a per-handle basis" - if ref($_[0]); - my $prev = $\; - $\ = $_[1] if @_ > 1; - $prev; -} - -sub input_record_separator { - carp "input_record_separator is not supported on a per-handle basis" - if ref($_[0]); - my $prev = $/; - $/ = $_[1] if @_ > 1; - $prev; -} - -sub input_line_number { - local $.; - my $tell = 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 $prev = $%; - $% = $_[1] if @_ > 1; - $prev; -} - -sub format_lines_per_page { - my $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 $prev = $-; - $- = $_[1] if @_ > 1; - $prev; -} - -sub format_name { - my $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 $prev = $^; - $^ = qualify($_[1], caller) if @_ > 1; - $prev; -} - -sub format_line_break_characters { - carp "format_line_break_characters is not supported on a per-handle basis" - if ref($_[0]); - my $prev = $:; - $: = $_[1] if @_ > 1; - $prev; -} - -sub format_formfeed { - carp "format_formfeed is not supported on a per-handle basis" - if ref($_[0]); - my $prev = $^L; - $^L = $_[1] if @_ > 1; - $prev; -} - -sub formline { - my $io = shift; - my $picture = shift; - local($^A) = $^A; - local($\) = ""; - formline($picture, @_); - print $io $^A; -} - -sub format_write { - @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; - if (@_ == 2) { - my ($io, $fmt) = @_; - my $oldfmt = $io->format_name($fmt); - CORE::write($io); - $io->format_name($oldfmt); - } else { - CORE::write($_[0]); - } -} - -# XXX undocumented -sub fcntl { - @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; - my ($io, $op) = @_; - return fcntl($io, $op, $_[2]); -} - -# XXX undocumented -sub ioctl { - @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; - my ($io, $op) = @_; - return ioctl($io, $op, $_[2]); -} - -# this sub is for compatability with older releases of IO that used -# a sub called constant to detemine if a constant existed -- GMB -# -# The SEEK_* and _IO?BF constants were the only constants at that time -# any new code should just chech defined(&CONSTANT_NAME) - -sub constant { - no strict 'refs'; - my $name = shift; - (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) - ? &{$name}() : undef; -} - - -# so that flush.pl can be deprecated - -sub printflush { - my $io = shift; - my $old = new SelectSaver qualify($io, caller) if ref($io); - local $| = 1; - if(ref($io)) { - print $io @_; - } - else { - print @_; - } -} - -1; |