ext/IO/lib/IO/Handle.pm

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