[Summary view] [Print] [Text view]

   1  package IO::Handle;
   2  
   3  =head1 NAME
   4  
   5  IO::Handle - supply object methods for I/O handles
   6  
   7  =head1 SYNOPSIS
   8  
   9      use IO::Handle;
  10  
  11      $io = new IO::Handle;
  12      if ($io->fdopen(fileno(STDIN),"r")) {
  13          print $io->getline;
  14          $io->close;
  15      }
  16  
  17      $io = new IO::Handle;
  18      if ($io->fdopen(fileno(STDOUT),"w")) {
  19          $io->print("Some text\n");
  20      }
  21  
  22      # setvbuf is not available by default on Perls 5.8.0 and later.
  23      use IO::Handle '_IOLBF';
  24      $io->setvbuf($buffer_var, _IOLBF, 1024);
  25  
  26      undef $io;       # automatically closes the file if it's open
  27  
  28      autoflush STDOUT 1;
  29  
  30  =head1 DESCRIPTION
  31  
  32  C<IO::Handle> is the base class for all other IO handle classes. It is
  33  not intended that objects of C<IO::Handle> would be created directly,
  34  but instead C<IO::Handle> is inherited from by several other classes
  35  in the IO hierarchy.
  36  
  37  If you are reading this documentation, looking for a replacement for
  38  the C<FileHandle> package, then I suggest you read the documentation
  39  for C<IO::File> too.
  40  
  41  =head1 CONSTRUCTOR
  42  
  43  =over 4
  44  
  45  =item new ()
  46  
  47  Creates a new C<IO::Handle> object.
  48  
  49  =item new_from_fd ( FD, MODE )
  50  
  51  Creates an C<IO::Handle> like C<new> does.
  52  It requires two parameters, which are passed to the method C<fdopen>;
  53  if the fdopen fails, the object is destroyed. Otherwise, it is returned
  54  to the caller.
  55  
  56  =back
  57  
  58  =head1 METHODS
  59  
  60  See L<perlfunc> for complete descriptions of each of the following
  61  supported C<IO::Handle> methods, which are just front ends for the
  62  corresponding built-in functions:
  63  
  64      $io->close
  65      $io->eof
  66      $io->fileno
  67      $io->format_write( [FORMAT_NAME] )
  68      $io->getc
  69      $io->read ( BUF, LEN, [OFFSET] )
  70      $io->print ( ARGS )
  71      $io->printf ( FMT, [ARGS] )
  72      $io->say ( ARGS )
  73      $io->stat
  74      $io->sysread ( BUF, LEN, [OFFSET] )
  75      $io->syswrite ( BUF, [LEN, [OFFSET]] )
  76      $io->truncate ( LEN )
  77  
  78  See L<perlvar> for complete descriptions of each of the following
  79  supported C<IO::Handle> methods.  All of them return the previous
  80  value of the attribute and takes an optional single argument that when
  81  given will set the value.  If no argument is given the previous value
  82  is unchanged (except for $io->autoflush will actually turn ON
  83  autoflush by default).
  84  
  85      $io->autoflush ( [BOOL] )                         $|
  86      $io->format_page_number( [NUM] )                  $%
  87      $io->format_lines_per_page( [NUM] )               $=
  88      $io->format_lines_left( [NUM] )                   $-
  89      $io->format_name( [STR] )                         $~
  90      $io->format_top_name( [STR] )                     $^
  91      $io->input_line_number( [NUM])                    $.
  92  
  93  The following methods are not supported on a per-filehandle basis.
  94  
  95      IO::Handle->format_line_break_characters( [STR] ) $:
  96      IO::Handle->format_formfeed( [STR])               $^L
  97      IO::Handle->output_field_separator( [STR] )       $,
  98      IO::Handle->output_record_separator( [STR] )      $\
  99  
 100      IO::Handle->input_record_separator( [STR] )       $/
 101  
 102  Furthermore, for doing normal I/O you might need these:
 103  
 104  =over 4
 105  
 106  =item $io->fdopen ( FD, MODE )
 107  
 108  C<fdopen> is like an ordinary C<open> except that its first parameter
 109  is not a filename but rather a file handle name, an IO::Handle object,
 110  or a file descriptor number.
 111  
 112  =item $io->opened
 113  
 114  Returns true if the object is currently a valid file descriptor, false
 115  otherwise.
 116  
 117  =item $io->getline
 118  
 119  This works like <$io> described in L<perlop/"I/O Operators">
 120  except that it's more readable and can be safely called in a
 121  list context but still returns just one line.  If used as the conditional
 122  +within a C<while> or C-style C<for> loop, however, you will need to
 123  +emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>.
 124  
 125  =item $io->getlines
 126  
 127  This works like <$io> when called in a list context to read all
 128  the remaining lines in a file, except that it's more readable.
 129  It will also croak() if accidentally called in a scalar context.
 130  
 131  =item $io->ungetc ( ORD )
 132  
 133  Pushes a character with the given ordinal value back onto the given
 134  handle's input stream.  Only one character of pushback per handle is
 135  guaranteed.
 136  
 137  =item $io->write ( BUF, LEN [, OFFSET ] )
 138  
 139  This C<write> is like C<write> found in C, that is it is the
 140  opposite of read. The wrapper for the perl C<write> function is
 141  called C<format_write>.
 142  
 143  =item $io->error
 144  
 145  Returns a true value if the given handle has experienced any errors
 146  since it was opened or since the last call to C<clearerr>, or if the
 147  handle is invalid. It only returns false for a valid handle with no
 148  outstanding errors.
 149  
 150  =item $io->clearerr
 151  
 152  Clear the given handle's error indicator. Returns -1 if the handle is
 153  invalid, 0 otherwise.
 154  
 155  =item $io->sync
 156  
 157  C<sync> synchronizes a file's in-memory state  with  that  on the
 158  physical medium. C<sync> does not operate at the perlio api level, but
 159  operates on the file descriptor (similar to sysread, sysseek and
 160  systell). This means that any data held at the perlio api level will not
 161  be synchronized. To synchronize data that is buffered at the perlio api
 162  level you must use the flush method. C<sync> is not implemented on all
 163  platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
 164  for an invalid handle. See L<fsync(3c)>.
 165  
 166  =item $io->flush
 167  
 168  C<flush> causes perl to flush any buffered data at the perlio api level.
 169  Any unread data in the buffer will be discarded, and any unwritten data
 170  will be written to the underlying file descriptor. Returns "0 but true"
 171  on success, C<undef> on error.
 172  
 173  =item $io->printflush ( ARGS )
 174  
 175  Turns on autoflush, print ARGS and then restores the autoflush status of the
 176  C<IO::Handle> object. Returns the return value from print.
 177  
 178  =item $io->blocking ( [ BOOL ] )
 179  
 180  If called with an argument C<blocking> will turn on non-blocking IO if
 181  C<BOOL> is false, and turn it off if C<BOOL> is true.
 182  
 183  C<blocking> will return the value of the previous setting, or the
 184  current setting if C<BOOL> is not given. 
 185  
 186  If an error occurs C<blocking> will return undef and C<$!> will be set.
 187  
 188  =back
 189  
 190  
 191  If the C functions setbuf() and/or setvbuf() are available, then
 192  C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
 193  policy for an IO::Handle.  The calling sequences for the Perl functions
 194  are the same as their C counterparts--including the constants C<_IOFBF>,
 195  C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
 196  specifies a scalar variable to use as a buffer. You should only
 197  change the buffer before any I/O, or immediately after calling flush.
 198  
 199  WARNING: The IO::Handle::setvbuf() is not available by default on
 200  Perls 5.8.0 and later because setvbuf() is rather specific to using
 201  the stdio library, while Perl prefers the new perlio subsystem instead.
 202  
 203  WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not
 204  be modified> in any way until the IO::Handle is closed or C<setbuf> or
 205  C<setvbuf> is called again, or memory corruption may result! Remember that
 206  the order of global destruction is undefined, so even if your buffer
 207  variable remains in scope until program termination, it may be undefined
 208  before the file IO::Handle is closed. Note that you need to import the
 209  constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
 210  returns nothing. setvbuf returns "0 but true", on success, C<undef> on
 211  failure.
 212  
 213  Lastly, there is a special method for working under B<-T> and setuid/gid
 214  scripts:
 215  
 216  =over 4
 217  
 218  =item $io->untaint
 219  
 220  Marks the object as taint-clean, and as such data read from it will also
 221  be considered taint-clean. Note that this is a very trusting action to
 222  take, and appropriate consideration for the data source and potential
 223  vulnerability should be kept in mind. Returns 0 on success, -1 if setting
 224  the taint-clean flag failed. (eg invalid handle)
 225  
 226  =back
 227  
 228  =head1 NOTE
 229  
 230  An C<IO::Handle> object is a reference to a symbol/GLOB reference (see
 231  the C<Symbol> package).  Some modules that
 232  inherit from C<IO::Handle> may want to keep object related variables
 233  in the hash table part of the GLOB. In an attempt to prevent modules
 234  trampling on each other I propose the that any such module should prefix
 235  its variables with its own name separated by _'s. For example the IO::Socket
 236  module keeps a C<timeout> variable in 'io_socket_timeout'.
 237  
 238  =head1 SEE ALSO
 239  
 240  L<perlfunc>, 
 241  L<perlop/"I/O Operators">,
 242  L<IO::File>
 243  
 244  =head1 BUGS
 245  
 246  Due to backwards compatibility, all filehandles resemble objects
 247  of class C<IO::Handle>, or actually classes derived from that class.
 248  They actually aren't.  Which means you can't derive your own 
 249  class from C<IO::Handle> and inherit those methods.
 250  
 251  =head1 HISTORY
 252  
 253  Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
 254  
 255  =cut
 256  
 257  use 5.006_001;
 258  use strict;
 259  our($VERSION, @EXPORT_OK, @ISA);
 260  use Carp;
 261  use Symbol;
 262  use SelectSaver;
 263  use IO ();    # Load the XS module
 264  
 265  require Exporter;
 266  @ISA = qw(Exporter);
 267  
 268  $VERSION = "1.27";
 269  $VERSION = eval $VERSION;
 270  
 271  @EXPORT_OK = qw(
 272      autoflush
 273      output_field_separator
 274      output_record_separator
 275      input_record_separator
 276      input_line_number
 277      format_page_number
 278      format_lines_per_page
 279      format_lines_left
 280      format_name
 281      format_top_name
 282      format_line_break_characters
 283      format_formfeed
 284      format_write
 285  
 286      print
 287      printf
 288      say
 289      getline
 290      getlines
 291  
 292      printflush
 293      flush
 294  
 295      SEEK_SET
 296      SEEK_CUR
 297      SEEK_END
 298      _IOFBF
 299      _IOLBF
 300      _IONBF
 301  );
 302  
 303  ################################################
 304  ## Constructors, destructors.
 305  ##
 306  
 307  sub new {
 308      my $class = ref($_[0]) || $_[0] || "IO::Handle";
 309      @_ == 1 or croak "usage: new $class";
 310      my $io = gensym;
 311      bless $io, $class;
 312  }
 313  
 314  sub new_from_fd {
 315      my $class = ref($_[0]) || $_[0] || "IO::Handle";
 316      @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
 317      my $io = gensym;
 318      shift;
 319      IO::Handle::fdopen($io, @_)
 320      or return undef;
 321      bless $io, $class;
 322  }
 323  
 324  #
 325  # There is no need for DESTROY to do anything, because when the
 326  # last reference to an IO object is gone, Perl automatically
 327  # closes its associated files (if any).  However, to avoid any
 328  # attempts to autoload DESTROY, we here define it to do nothing.
 329  #
 330  sub DESTROY {}
 331  
 332  
 333  ################################################
 334  ## Open and close.
 335  ##
 336  
 337  sub _open_mode_string {
 338      my ($mode) = @_;
 339      $mode =~ /^\+?(<|>>?)$/
 340        or $mode =~ s/^r(\+?)$/$1</
 341        or $mode =~ s/^w(\+?)$/$1>/
 342        or $mode =~ s/^a(\+?)$/$1>>/
 343        or croak "IO::Handle: bad open mode: $mode";
 344      $mode;
 345  }
 346  
 347  sub fdopen {
 348      @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
 349      my ($io, $fd, $mode) = @_;
 350      local(*GLOB);
 351  
 352      if (ref($fd) && "".$fd =~ /GLOB\(/o) {
 353      # It's a glob reference; Alias it as we cannot get name of anon GLOBs
 354      my $n = qualify(*GLOB);
 355      *GLOB = *{*$fd};
 356      $fd =  $n;
 357      } elsif ($fd =~ m#^\d+$#) {
 358      # It's an FD number; prefix with "=".
 359      $fd = "=$fd";
 360      }
 361  
 362      open($io, _open_mode_string($mode) . '&' . $fd)
 363      ? $io : undef;
 364  }
 365  
 366  sub close {
 367      @_ == 1 or croak 'usage: $io->close()';
 368      my($io) = @_;
 369  
 370      close($io);
 371  }
 372  
 373  ################################################
 374  ## Normal I/O functions.
 375  ##
 376  
 377  # flock
 378  # select
 379  
 380  sub opened {
 381      @_ == 1 or croak 'usage: $io->opened()';
 382      defined fileno($_[0]);
 383  }
 384  
 385  sub fileno {
 386      @_ == 1 or croak 'usage: $io->fileno()';
 387      fileno($_[0]);
 388  }
 389  
 390  sub getc {
 391      @_ == 1 or croak 'usage: $io->getc()';
 392      getc($_[0]);
 393  }
 394  
 395  sub eof {
 396      @_ == 1 or croak 'usage: $io->eof()';
 397      eof($_[0]);
 398  }
 399  
 400  sub print {
 401      @_ or croak 'usage: $io->print(ARGS)';
 402      my $this = shift;
 403      print $this @_;
 404  }
 405  
 406  sub printf {
 407      @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
 408      my $this = shift;
 409      printf $this @_;
 410  }
 411  
 412  sub say {
 413      @_ or croak 'usage: $io->say(ARGS)';
 414      my $this = shift;
 415      print $this @_, "\n";
 416  }
 417  
 418  sub getline {
 419      @_ == 1 or croak 'usage: $io->getline()';
 420      my $this = shift;
 421      return scalar <$this>;
 422  } 
 423  
 424  *gets = \&getline;  # deprecated
 425  
 426  sub getlines {
 427      @_ == 1 or croak 'usage: $io->getlines()';
 428      wantarray or
 429      croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
 430      my $this = shift;
 431      return <$this>;
 432  }
 433  
 434  sub truncate {
 435      @_ == 2 or croak 'usage: $io->truncate(LEN)';
 436      truncate($_[0], $_[1]);
 437  }
 438  
 439  sub read {
 440      @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
 441      read($_[0], $_[1], $_[2], $_[3] || 0);
 442  }
 443  
 444  sub sysread {
 445      @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
 446      sysread($_[0], $_[1], $_[2], $_[3] || 0);
 447  }
 448  
 449  sub write {
 450      @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
 451      local($\) = "";
 452      $_[2] = length($_[1]) unless defined $_[2];
 453      print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
 454  }
 455  
 456  sub syswrite {
 457      @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
 458      if (defined($_[2])) {
 459      syswrite($_[0], $_[1], $_[2], $_[3] || 0);
 460      } else {
 461      syswrite($_[0], $_[1]);
 462      }
 463  }
 464  
 465  sub stat {
 466      @_ == 1 or croak 'usage: $io->stat()';
 467      stat($_[0]);
 468  }
 469  
 470  ################################################
 471  ## State modification functions.
 472  ##
 473  
 474  sub autoflush {
 475      my $old = new SelectSaver qualify($_[0], caller);
 476      my $prev = $|;
 477      $| = @_ > 1 ? $_[1] : 1;
 478      $prev;
 479  }
 480  
 481  sub output_field_separator {
 482      carp "output_field_separator is not supported on a per-handle basis"
 483      if ref($_[0]);
 484      my $prev = $,;
 485      $, = $_[1] if @_ > 1;
 486      $prev;
 487  }
 488  
 489  sub output_record_separator {
 490      carp "output_record_separator is not supported on a per-handle basis"
 491      if ref($_[0]);
 492      my $prev = $\;
 493      $\ = $_[1] if @_ > 1;
 494      $prev;
 495  }
 496  
 497  sub input_record_separator {
 498      carp "input_record_separator is not supported on a per-handle basis"
 499      if ref($_[0]);
 500      my $prev = $/;
 501      $/ = $_[1] if @_ > 1;
 502      $prev;
 503  }
 504  
 505  sub input_line_number {
 506      local $.;
 507      () = tell qualify($_[0], caller) if ref($_[0]);
 508      my $prev = $.;
 509      $. = $_[1] if @_ > 1;
 510      $prev;
 511  }
 512  
 513  sub format_page_number {
 514      my $old;
 515      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 516      my $prev = $%;
 517      $% = $_[1] if @_ > 1;
 518      $prev;
 519  }
 520  
 521  sub format_lines_per_page {
 522      my $old;
 523      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 524      my $prev = $=;
 525      $= = $_[1] if @_ > 1;
 526      $prev;
 527  }
 528  
 529  sub format_lines_left {
 530      my $old;
 531      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 532      my $prev = $-;
 533      $- = $_[1] if @_ > 1;
 534      $prev;
 535  }
 536  
 537  sub format_name {
 538      my $old;
 539      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 540      my $prev = $~;
 541      $~ = qualify($_[1], caller) if @_ > 1;
 542      $prev;
 543  }
 544  
 545  sub format_top_name {
 546      my $old;
 547      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 548      my $prev = $^;
 549      $^ = qualify($_[1], caller) if @_ > 1;
 550      $prev;
 551  }
 552  
 553  sub format_line_break_characters {
 554      carp "format_line_break_characters is not supported on a per-handle basis"
 555      if ref($_[0]);
 556      my $prev = $:;
 557      $: = $_[1] if @_ > 1;
 558      $prev;
 559  }
 560  
 561  sub format_formfeed {
 562      carp "format_formfeed is not supported on a per-handle basis"
 563      if ref($_[0]);
 564      my $prev = $^L;
 565      $^L = $_[1] if @_ > 1;
 566      $prev;
 567  }
 568  
 569  sub formline {
 570      my $io = shift;
 571      my $picture = shift;
 572      local($^A) = $^A;
 573      local($\) = "";
 574      formline($picture, @_);
 575      print $io $^A;
 576  }
 577  
 578  sub format_write {
 579      @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
 580      if (@_ == 2) {
 581      my ($io, $fmt) = @_;
 582      my $oldfmt = $io->format_name(qualify($fmt,caller));
 583      CORE::write($io);
 584      $io->format_name($oldfmt);
 585      } else {
 586      CORE::write($_[0]);
 587      }
 588  }
 589  
 590  # XXX undocumented
 591  sub fcntl {
 592      @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
 593      my ($io, $op) = @_;
 594      return fcntl($io, $op, $_[2]);
 595  }
 596  
 597  # XXX undocumented
 598  sub ioctl {
 599      @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
 600      my ($io, $op) = @_;
 601      return ioctl($io, $op, $_[2]);
 602  }
 603  
 604  # this sub is for compatability with older releases of IO that used
 605  # a sub called constant to detemine if a constant existed -- GMB
 606  #
 607  # The SEEK_* and _IO?BF constants were the only constants at that time
 608  # any new code should just chech defined(&CONSTANT_NAME)
 609  
 610  sub constant {
 611      no strict 'refs';
 612      my $name = shift;
 613      (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
 614      ? &{$name}() : undef;
 615  }
 616  
 617  
 618  # so that flush.pl can be deprecated
 619  
 620  sub printflush {
 621      my $io = shift;
 622      my $old;
 623      $old = new SelectSaver qualify($io, caller) if ref($io);
 624      local $| = 1;
 625      if(ref($io)) {
 626          print $io @_;
 627      }
 628      else {
 629      print @_;
 630      }
 631  }
 632  
 633  1;