lib/Tie/StdHandle.pm

   1 package Tie::StdHandle;
   2
   3 use strict;
   4
   5 use Tie::Handle;
   6 use vars qw(@ISA $VERSION);
   7 @ISA = 'Tie::Handle';
   8 $VERSION = '4.4';
   9
  10 =head1 NAME
  11
  12 Tie::StdHandle - base class definitions for tied handles
  13
  14 =head1 SYNOPSIS
  15
  16     package NewHandle;
  17     require Tie::Handle;
  18
  19     @ISA = qw(Tie::Handle);
  20
  21     sub READ { ... }            # Provide a needed method
  22     sub TIEHANDLE { ... }       # Overrides inherited method
  23
  24
  25     package main;
  26
  27     tie *FH, 'NewHandle';
  28
  29 =head1 DESCRIPTION
  30
  31 The B<Tie::StdHandle> package provide most methods for file handles described
  32 in L<perltie> (the exceptions are C<UNTIE> and C<DESTROY>).  It causes tied
  33 file handles to behave exactly like standard file handles and allow for
  34 selective overwriting of methods.
  35
  36 =cut
  37
  38 sub TIEHANDLE
  39 {
  40  my $class = shift;
  41  my $fh    = \do { local *HANDLE};
  42  bless $fh,$class;
  43  $fh->OPEN(@_) if (@_);
  44  return $fh;
  45 }
  46
  47 sub EOF     { eof($_[0]) }
  48 sub TELL    { tell($_[0]) }
  49 sub FILENO  { fileno($_[0]) }
  50 sub SEEK    { seek($_[0],$_[1],$_[2]) }
  51 sub CLOSE   { close($_[0]) }
  52 sub BINMODE { binmode($_[0]) }
  53
  54 sub OPEN
  55 {
  56  $_[0]->CLOSE if defined($_[0]->FILENO);
  57  @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]);
  58 }
  59
  60 sub READ     { &CORE::read(shift, \shift, @_) }
  61 sub READLINE { my $fh = $_[0]; <$fh> }
  62 sub GETC     { getc($_[0]) }
  63
  64 sub WRITE
  65 {
  66  my $fh = $_[0];
  67  local $\; # don't print any line terminator
  68  print $fh substr($_[1], $_[3], $_[2]);
  69 }
  70
  71
  72 1;