contrib/perl5/ext/IO/lib/IO/Handle.pm

   1
   2 package IO::Handle;
   3
   4 =head1 NAME
   5
   6 IO::Handle - supply object methods for I/O handles
   7
   8 =head1 SYNOPSIS
   9
  10     use IO::Handle;
  11
  12     $fh = new IO::Handle;
  13     if ($fh->fdopen(fileno(STDIN),"r")) {
  14         print $fh->getline;
  15         $fh->close;
  16     }
  17
  18     $fh = new IO::Handle;
  19     if ($fh->fdopen(fileno(STDOUT),"w")) {
  20         $fh->print("Some text\n");
  21     }
  22
  23     use IO::Handle '_IOLBF';
  24     $fh->setvbuf($buffer_var, _IOLBF, 1024);
  25
  26     undef $fh;       # 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>
  40
  41 A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)
  42
  43 =head1 CONSTRUCTOR
  44
  45 =over 4
  46
  47 =item new ()
  48
  49 Creates a new C<IO::Handle> object.
  50
  51 =item new_from_fd ( FD, MODE )
  52
  53 Creates a C<IO::Handle> like C<new> does.
  54 It requires two parameters, which are passed to the method C<fdopen>;
  55 if the fdopen fails, the object is destroyed. Otherwise, it is returned
  56 to the caller.
  57
  58 =back
  59
  60 =head1 METHODS
  61
  62 See L<perlfunc> for complete descriptions of each of the following
  63 supported C<IO::Handle> methods, which are just front ends for the
  64 corresponding built-in functions:
  65
  66     close
  67     fileno
  68     getc
  69     eof
  70     read
  71     truncate
  72     stat
  73     print
  74     printf
  75     sysread
  76     syswrite
  77
  78 See L<perlvar> for complete descriptions of each of the following
  79 supported C<IO::Handle> methods:
  80
  81     autoflush
  82     output_field_separator
  83     output_record_separator
  84     input_record_separator
  85     input_line_number
  86     format_page_number
  87     format_lines_per_page
  88     format_lines_left
  89     format_name
  90     format_top_name
  91     format_line_break_characters
  92     format_formfeed
  93     format_write
  94
  95 Furthermore, for doing normal I/O you might need these:
  96
  97 =over
  98
  99 =item $fh->fdopen ( FD, MODE )
 100
 101 C<fdopen> is like an ordinary C<open> except that its first parameter
 102 is not a filename but rather a file handle name, a IO::Handle object,
 103 or a file descriptor number.
 104
 105 =item $fh->opened
 106
 107 Returns true if the object is currently a valid file descriptor.
 108
 109 =item $fh->getline
 110
 111 This works like <$fh> described in L<perlop/"I/O Operators">
 112 except that it's more readable and can be safely called in an
 113 array context but still returns just one line.
 114
 115 =item $fh->getlines
 116
 117 This works like <$fh> when called in an array context to
 118 read all the remaining lines in a file, except that it's more readable.
 119 It will also croak() if accidentally called in a scalar context.
 120
 121 =item $fh->ungetc ( ORD )
 122
 123 Pushes a character with the given ordinal value back onto the given
 124 handle's input stream.
 125
 126 =item $fh->write ( BUF, LEN [, OFFSET }\] )
 127
 128 This C<write> is like C<write> found in C, that is it is the
 129 opposite of read. The wrapper for the perl C<write> function is
 130 called C<format_write>.
 131
 132 =item $fh->flush
 133
 134 Flush the given handle's buffer.
 135
 136 =item $fh->error
 137
 138 Returns a true value if the given handle has experienced any errors
 139 since it was opened or since the last call to C<clearerr>.
 140
 141 =item $fh->clearerr
 142
 143 Clear the given handle's error indicator.
 144
 145 =back
 146
 147 If the C functions setbuf() and/or setvbuf() are available, then
 148 C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
 149 policy for an IO::Handle.  The calling sequences for the Perl functions
 150 are the same as their C counterparts--including the constants C<_IOFBF>,
 151 C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
 152 specifies a scalar variable to use as a buffer.  WARNING: A variable
 153 used as a buffer by C<setbuf> or C<setvbuf> must not be modified in any
 154 way until the IO::Handle is closed or C<setbuf> or C<setvbuf> is called
 155 again, or memory corruption may result!  Note that you need to import
 156 the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly.
 157
 158 Lastly, there is a special method for working under B<-T> and setuid/gid
 159 scripts:
 160
 161 =over
 162
 163 =item $fh->untaint
 164
 165 Marks the object as taint-clean, and as such data read from it will also
 166 be considered taint-clean. Note that this is a very trusting action to
 167 take, and appropriate consideration for the data source and potential
 168 vulnerability should be kept in mind.
 169
 170 =back
 171
 172 =head1 NOTE
 173
 174 A C<IO::Handle> object is a GLOB reference. Some modules that
 175 inherit from C<IO::Handle> may want to keep object related variables
 176 in the hash table part of the GLOB. In an attempt to prevent modules
 177 trampling on each other I propose the that any such module should prefix
 178 its variables with its own name separated by _'s. For example the IO::Socket
 179 module keeps a C<timeout> variable in 'io_socket_timeout'.
 180
 181 =head1 SEE ALSO
 182
 183 L<perlfunc>,
 184 L<perlop/"I/O Operators">,
 185 L<IO::File>
 186
 187 =head1 BUGS
 188
 189 Due to backwards compatibility, all filehandles resemble objects
 190 of class C<IO::Handle>, or actually classes derived from that class.
 191 They actually aren't.  Which means you can't derive your own
 192 class from C<IO::Handle> and inherit those methods.
 193
 194 =head1 HISTORY
 195
 196 Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
 197
 198 =cut
 199
 200 require 5.000;
 201 use strict;
 202 use vars qw($VERSION $XS_VERSION @EXPORT_OK $AUTOLOAD @ISA);
 203 use Carp;
 204 use Symbol;
 205 use SelectSaver;
 206
 207 require Exporter;
 208 @ISA = qw(Exporter);
 209
 210 $VERSION = "1.1505";
 211 $XS_VERSION = "1.15";
 212
 213 @EXPORT_OK = qw(
 214     autoflush
 215     output_field_separator
 216     output_record_separator
 217     input_record_separator
 218     input_line_number
 219     format_page_number
 220     format_lines_per_page
 221     format_lines_left
 222     format_name
 223     format_top_name
 224     format_line_break_characters
 225     format_formfeed
 226     format_write
 227
 228     print
 229     printf
 230     getline
 231     getlines
 232
 233     SEEK_SET
 234     SEEK_CUR
 235     SEEK_END
 236     _IOFBF
 237     _IOLBF
 238     _IONBF
 239 );
 240
 241
 242 ################################################
 243 ## Interaction with the XS.
 244 ##
 245
 246 require DynaLoader;
 247 @IO::ISA = qw(DynaLoader);
 248 bootstrap IO $XS_VERSION;
 249
 250 sub AUTOLOAD {
 251     if ($AUTOLOAD =~ /::(_?[a-z])/) {
 252         $AutoLoader::AUTOLOAD = $AUTOLOAD;
 253         goto &AutoLoader::AUTOLOAD
 254     }
 255     my $constname = $AUTOLOAD;
 256     $constname =~ s/.*:://;
 257     my $val = constant($constname);
 258     defined $val or croak "$constname is not a valid IO::Handle macro";
 259     no strict 'refs';
 260     *$AUTOLOAD = sub { $val };
 261     goto &$AUTOLOAD;
 262 }
 263
 264
 265 ################################################
 266 ## Constructors, destructors.
 267 ##
 268
 269 sub new {
 270     my $class = ref($_[0]) || $_[0] || "IO::Handle";
 271     @_ == 1 or croak "usage: new $class";
 272     my $fh = gensym;
 273     bless $fh, $class;
 274 }
 275
 276 sub new_from_fd {
 277     my $class = ref($_[0]) || $_[0] || "IO::Handle";
 278     @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
 279     my $fh = gensym;
 280     shift;
 281     IO::Handle::fdopen($fh, @_)
 282         or return undef;
 283     bless $fh, $class;
 284 }
 285
 286 #
 287 # There is no need for DESTROY to do anything, because when the
 288 # last reference to an IO object is gone, Perl automatically
 289 # closes its associated files (if any).  However, to avoid any
 290 # attempts to autoload DESTROY, we here define it to do nothing.
 291 #
 292 sub DESTROY {}
 293
 294
 295 ################################################
 296 ## Open and close.
 297 ##
 298
 299 sub _open_mode_string {
 300     my ($mode) = @_;
 301     $mode =~ /^\+?(<|>>?)$/
 302       or $mode =~ s/^r(\+?)$/$1</
 303       or $mode =~ s/^w(\+?)$/$1>/
 304       or $mode =~ s/^a(\+?)$/$1>>/
 305       or croak "IO::Handle: bad open mode: $mode";
 306     $mode;
 307 }
 308
 309 sub fdopen {
 310     @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
 311     my ($fh, $fd, $mode) = @_;
 312     local(*GLOB);
 313
 314     if (ref($fd) && "".$fd =~ /GLOB\(/o) {
 315         # It's a glob reference; Alias it as we cannot get name of anon GLOBs
 316         my $n = qualify(*GLOB);
 317         *GLOB = *{*$fd};
 318         $fd =  $n;
 319     } elsif ($fd =~ m#^\d+$#) {
 320         # It's an FD number; prefix with "=".
 321         $fd = "=$fd";
 322     }
 323
 324     open($fh, _open_mode_string($mode) . '&' . $fd)
 325         ? $fh : undef;
 326 }
 327
 328 sub close {
 329     @_ == 1 or croak 'usage: $fh->close()';
 330     my($fh) = @_;
 331
 332     close($fh);
 333 }
 334
 335 ################################################
 336 ## Normal I/O functions.
 337 ##
 338
 339 # flock
 340 # select
 341
 342 sub opened {
 343     @_ == 1 or croak 'usage: $fh->opened()';
 344     defined fileno($_[0]);
 345 }
 346
 347 sub fileno {
 348     @_ == 1 or croak 'usage: $fh->fileno()';
 349     fileno($_[0]);
 350 }
 351
 352 sub getc {
 353     @_ == 1 or croak 'usage: $fh->getc()';
 354     getc($_[0]);
 355 }
 356
 357 sub eof {
 358     @_ == 1 or croak 'usage: $fh->eof()';
 359     eof($_[0]);
 360 }
 361
 362 sub print {
 363     @_ or croak 'usage: $fh->print([ARGS])';
 364     my $this = shift;
 365     print $this @_;
 366 }
 367
 368 sub printf {
 369     @_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
 370     my $this = shift;
 371     printf $this @_;
 372 }
 373
 374 sub getline {
 375     @_ == 1 or croak 'usage: $fh->getline';
 376     my $this = shift;
 377     return scalar <$this>;
 378 }
 379
 380 *gets = \&getline;  # deprecated
 381
 382 sub getlines {
 383     @_ == 1 or croak 'usage: $fh->getline()';
 384     wantarray or
 385         croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline';
 386     my $this = shift;
 387     return <$this>;
 388 }
 389
 390 sub truncate {
 391     @_ == 2 or croak 'usage: $fh->truncate(LEN)';
 392     truncate($_[0], $_[1]);
 393 }
 394
 395 sub read {
 396     @_ == 3 || @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])';
 397     read($_[0], $_[1], $_[2], $_[3] || 0);
 398 }
 399
 400 sub sysread {
 401     @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])';
 402     sysread($_[0], $_[1], $_[2], $_[3] || 0);
 403 }
 404
 405 sub write {
 406     @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
 407     local($\) = "";
 408     print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
 409 }
 410
 411 sub syswrite {
 412     @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])';
 413     syswrite($_[0], $_[1], $_[2], $_[3] || 0);
 414 }
 415
 416 sub stat {
 417     @_ == 1 or croak 'usage: $fh->stat()';
 418     stat($_[0]);
 419 }
 420
 421 ################################################
 422 ## State modification functions.
 423 ##
 424
 425 sub autoflush {
 426     my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 427     my $prev = $|;
 428     $| = @_ > 1 ? $_[1] : 1;
 429     $prev;
 430 }
 431
 432 sub output_field_separator {
 433     my $prev = $,;
 434     $, = $_[1] if @_ > 1;
 435     $prev;
 436 }
 437
 438 sub output_record_separator {
 439     my $prev = $\;
 440     $\ = $_[1] if @_ > 1;
 441     $prev;
 442 }
 443
 444 sub input_record_separator {
 445     my $prev = $/;
 446     $/ = $_[1] if @_ > 1;
 447     $prev;
 448 }
 449
 450 sub input_line_number {
 451     # localizing $. doesn't work as advertised.  grrrrrr.
 452     my $prev = $.;
 453     $. = $_[1] if @_ > 1;
 454     $prev;
 455 }
 456
 457 sub format_page_number {
 458     my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 459     my $prev = $%;
 460     $% = $_[1] if @_ > 1;
 461     $prev;
 462 }
 463
 464 sub format_lines_per_page {
 465     my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 466     my $prev = $=;
 467     $= = $_[1] if @_ > 1;
 468     $prev;
 469 }
 470
 471 sub format_lines_left {
 472     my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 473     my $prev = $-;
 474     $- = $_[1] if @_ > 1;
 475     $prev;
 476 }
 477
 478 sub format_name {
 479     my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 480     my $prev = $~;
 481     $~ = qualify($_[1], caller) if @_ > 1;
 482     $prev;
 483 }
 484
 485 sub format_top_name {
 486     my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
 487     my $prev = $^;
 488     $^ = qualify($_[1], caller) if @_ > 1;
 489     $prev;
 490 }
 491
 492 sub format_line_break_characters {
 493     my $prev = $:;
 494     $: = $_[1] if @_ > 1;
 495     $prev;
 496 }
 497
 498 sub format_formfeed {
 499     my $prev = $^L;
 500     $^L = $_[1] if @_ > 1;
 501     $prev;
 502 }
 503
 504 sub formline {
 505     my $fh = shift;
 506     my $picture = shift;
 507     local($^A) = $^A;
 508     local($\) = "";
 509     formline($picture, @_);
 510     print $fh $^A;
 511 }
 512
 513 sub format_write {
 514     @_ < 3 || croak 'usage: $fh->write( [FORMAT_NAME] )';
 515     if (@_ == 2) {
 516         my ($fh, $fmt) = @_;
 517         my $oldfmt = $fh->format_name($fmt);
 518         CORE::write($fh);
 519         $fh->format_name($oldfmt);
 520     } else {
 521         CORE::write($_[0]);
 522     }
 523 }
 524
 525 sub fcntl {
 526     @_ == 3 || croak 'usage: $fh->fcntl( OP, VALUE );';
 527     my ($fh, $op, $val) = @_;
 528     my $r = fcntl($fh, $op, $val);
 529     defined $r && $r eq "0 but true" ? 0 : $r;
 530 }
 531
 532 sub ioctl {
 533     @_ == 3 || croak 'usage: $fh->ioctl( OP, VALUE );';
 534     my ($fh, $op, $val) = @_;
 535     my $r = ioctl($fh, $op, $val);
 536     defined $r && $r eq "0 but true" ? 0 : $r;
 537 }
 538
 539 1;