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=back 195 196 197If the C functions setbuf() and/or setvbuf() are available, then 198C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering 199policy for an IO::Handle. The calling sequences for the Perl functions 200are the same as their C counterparts--including the constants C<_IOFBF>, 201C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter 202specifies a scalar variable to use as a buffer. You should only 203change the buffer before any I/O, or immediately after calling flush. 204 205WARNING: The IO::Handle::setvbuf() is not available by default on 206Perls 5.8.0 and later because setvbuf() is rather specific to using 207the stdio library, while Perl prefers the new perlio subsystem instead. 208 209WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not 210be modified> in any way until the IO::Handle is closed or C<setbuf> or 211C<setvbuf> is called again, or memory corruption may result! Remember that 212the order of global destruction is undefined, so even if your buffer 213variable remains in scope until program termination, it may be undefined 214before the file IO::Handle is closed. Note that you need to import the 215constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf 216returns nothing. setvbuf returns "0 but true", on success, C<undef> on 217failure. 218 219Lastly, there is a special method for working under B<-T> and setuid/gid 220scripts: 221 222=over 4 223 224=item $io->untaint 225 226Marks the object as taint-clean, and as such data read from it will also 227be considered taint-clean. Note that this is a very trusting action to 228take, and appropriate consideration for the data source and potential 229vulnerability should be kept in mind. Returns 0 on success, -1 if setting 230the taint-clean flag failed. (eg invalid handle) 231 232=back 233 234=head1 NOTE 235 236An C<IO::Handle> object is a reference to a symbol/GLOB reference (see 237the L<Symbol> package). Some modules that 238inherit from C<IO::Handle> may want to keep object related variables 239in the hash table part of the GLOB. In an attempt to prevent modules 240trampling on each other I propose the that any such module should prefix 241its variables with its own name separated by _'s. For example the IO::Socket 242module keeps a C<timeout> variable in 'io_socket_timeout'. 243 244=head1 SEE ALSO 245 246L<perlfunc>, 247L<perlop/"I/O Operators">, 248L<IO::File> 249 250=head1 BUGS 251 252Due to backwards compatibility, all filehandles resemble objects 253of class C<IO::Handle>, or actually classes derived from that class. 254They actually aren't. Which means you can't derive your own 255class from C<IO::Handle> and inherit those methods. 256 257=head1 HISTORY 258 259Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt> 260 261=cut 262 263use 5.008_001; 264use strict; 265use Carp; 266use Symbol; 267use SelectSaver; 268use IO (); # Load the XS module 269 270require Exporter; 271our @ISA = qw(Exporter); 272 273our $VERSION = "1.52"; 274 275our @EXPORT_OK = qw( 276 autoflush 277 output_field_separator 278 output_record_separator 279 input_record_separator 280 input_line_number 281 format_page_number 282 format_lines_per_page 283 format_lines_left 284 format_name 285 format_top_name 286 format_line_break_characters 287 format_formfeed 288 format_write 289 290 print 291 printf 292 say 293 getline 294 getlines 295 296 printflush 297 flush 298 299 SEEK_SET 300 SEEK_CUR 301 SEEK_END 302 _IOFBF 303 _IOLBF 304 _IONBF 305); 306 307################################################ 308## Constructors, destructors. 309## 310 311sub new { 312 my $class = ref($_[0]) || $_[0] || "IO::Handle"; 313 if (@_ != 1) { 314 # Since perl will automatically require IO::File if needed, but 315 # also initialises IO::File's @ISA as part of the core we must 316 # ensure IO::File is loaded if IO::Handle is. This avoids effect- 317 # ively "half-loading" IO::File. 318 if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) { 319 require IO::File; 320 shift; 321 return IO::File::->new(@_); 322 } 323 croak "usage: $class->new()"; 324 } 325 my $io = gensym; 326 bless $io, $class; 327} 328 329sub new_from_fd { 330 my $class = ref($_[0]) || $_[0] || "IO::Handle"; 331 @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)"; 332 my $io = gensym; 333 shift; 334 IO::Handle::fdopen($io, @_) 335 or return undef; 336 bless $io, $class; 337} 338 339# 340# There is no need for DESTROY to do anything, because when the 341# last reference to an IO object is gone, Perl automatically 342# closes its associated files (if any). However, to avoid any 343# attempts to autoload DESTROY, we here define it to do nothing. 344# 345sub DESTROY {} 346 347 348################################################ 349## Open and close. 350## 351 352sub _open_mode_string { 353 my ($mode) = @_; 354 $mode =~ /^\+?(<|>>?)$/ 355 or $mode =~ s/^r(\+?)$/$1</ 356 or $mode =~ s/^w(\+?)$/$1>/ 357 or $mode =~ s/^a(\+?)$/$1>>/ 358 or croak "IO::Handle: bad open mode: $mode"; 359 $mode; 360} 361 362sub fdopen { 363 @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; 364 my ($io, $fd, $mode) = @_; 365 local(*GLOB); 366 367 if (ref($fd) && "$fd" =~ /GLOB\(/o) { 368 # It's a glob reference; Alias it as we cannot get name of anon GLOBs 369 my $n = qualify(*GLOB); 370 *GLOB = *{*$fd}; 371 $fd = $n; 372 } elsif ($fd =~ m#^\d+$#) { 373 # It's an FD number; prefix with "=". 374 $fd = "=$fd"; 375 } 376 377 open($io, _open_mode_string($mode) . '&' . $fd) 378 ? $io : undef; 379} 380 381sub close { 382 @_ == 1 or croak 'usage: $io->close()'; 383 my($io) = @_; 384 385 close($io); 386} 387 388################################################ 389## Normal I/O functions. 390## 391 392# flock 393# select 394 395sub opened { 396 @_ == 1 or croak 'usage: $io->opened()'; 397 defined fileno($_[0]); 398} 399 400sub fileno { 401 @_ == 1 or croak 'usage: $io->fileno()'; 402 fileno($_[0]); 403} 404 405sub getc { 406 @_ == 1 or croak 'usage: $io->getc()'; 407 getc($_[0]); 408} 409 410sub eof { 411 @_ == 1 or croak 'usage: $io->eof()'; 412 eof($_[0]); 413} 414 415sub print { 416 @_ or croak 'usage: $io->print(ARGS)'; 417 my $this = shift; 418 print $this @_; 419} 420 421sub printf { 422 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; 423 my $this = shift; 424 printf $this @_; 425} 426 427sub say { 428 @_ or croak 'usage: $io->say(ARGS)'; 429 my $this = shift; 430 local $\ = "\n"; 431 print $this @_; 432} 433 434sub truncate { 435 @_ == 2 or croak 'usage: $io->truncate(LEN)'; 436 truncate($_[0], $_[1]); 437} 438 439sub read { 440 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; 441 read($_[0], $_[1], $_[2], $_[3] || 0); 442} 443 444sub sysread { 445 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; 446 sysread($_[0], $_[1], $_[2], $_[3] || 0); 447} 448 449sub 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 456sub 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 465sub stat { 466 @_ == 1 or croak 'usage: $io->stat()'; 467 stat($_[0]); 468} 469 470################################################ 471## State modification functions. 472## 473 474sub autoflush { 475 my $old = SelectSaver->new(qualify($_[0], caller)); 476 my $prev = $|; 477 $| = @_ > 1 ? $_[1] : 1; 478 $prev; 479} 480 481sub 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 489sub 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 497sub 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 505sub input_line_number { 506 local $.; 507 () = tell qualify($_[0], caller) if ref($_[0]); 508 my $prev = $.; 509 $. = $_[1] if @_ > 1; 510 $prev; 511} 512 513sub format_page_number { 514 my $old; 515 $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]); 516 my $prev = $%; 517 $% = $_[1] if @_ > 1; 518 $prev; 519} 520 521sub format_lines_per_page { 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_left { 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_name { 538 my $old; 539 $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]); 540 my $prev = $~; 541 $~ = qualify($_[1], caller) if @_ > 1; 542 $prev; 543} 544 545sub format_top_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_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 561sub 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 569sub formline { 570 my $io = shift; 571 my $picture = shift; 572 local($^A) = $^A; 573 local($\) = ""; 574 formline($picture, @_); 575 print $io $^A; 576} 577 578sub 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 590sub fcntl { 591 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; 592 my ($io, $op) = @_; 593 return fcntl($io, $op, $_[2]); 594} 595 596sub ioctl { 597 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; 598 my ($io, $op) = @_; 599 return ioctl($io, $op, $_[2]); 600} 601 602# this sub is for compatibility with older releases of IO that used 603# a sub called constant to determine if a constant existed -- GMB 604# 605# The SEEK_* and _IO?BF constants were the only constants at that time 606# any new code should just check defined(&CONSTANT_NAME) 607 608sub constant { 609 no strict 'refs'; 610 my $name = shift; 611 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) 612 ? &{$name}() : undef; 613} 614 615 616# so that flush.pl can be deprecated 617 618sub printflush { 619 my $io = shift; 620 my $old; 621 $old = SelectSaver->new(qualify($io, caller)) if ref($io); 622 local $| = 1; 623 if(ref($io)) { 624 print $io @_; 625 } 626 else { 627 print @_; 628 } 629} 630 6311; 632