dist/IO/lib/IO/Handle.pm

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