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