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