[Summary view] [Print] [Text view]

   1  package Tie::Handle;
   2  
   3  use 5.006_001;
   4  our $VERSION = '4.1';
   5  
   6  # Tie::StdHandle used to be inside Tie::Handle.  For backwards compatibility
   7  # loading Tie::Handle has to make Tie::StdHandle available.
   8  use Tie::StdHandle;
   9  
  10  =head1 NAME
  11  
  12  Tie::Handle - 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  This module provides some skeletal methods for handle-tying classes. See
  32  L<perltie> for a list of the functions required in tying a handle to a package.
  33  The basic B<Tie::Handle> package provides a C<new> method, as well as methods
  34  C<TIEHANDLE>, C<PRINT>, C<PRINTF> and C<GETC>. 
  35  
  36  For developers wishing to write their own tied-handle classes, the methods
  37  are summarized below. The L<perltie> section not only documents these, but
  38  has sample code as well:
  39  
  40  =over 4
  41  
  42  =item TIEHANDLE classname, LIST
  43  
  44  The method invoked by the command C<tie *glob, classname>. Associates a new
  45  glob instance with the specified class. C<LIST> would represent additional
  46  arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
  47  complete the association.
  48  
  49  =item WRITE this, scalar, length, offset
  50  
  51  Write I<length> bytes of data from I<scalar> starting at I<offset>.
  52  
  53  =item PRINT this, LIST
  54  
  55  Print the values in I<LIST>
  56  
  57  =item PRINTF this, format, LIST
  58  
  59  Print the values in I<LIST> using I<format>
  60  
  61  =item READ this, scalar, length, offset
  62  
  63  Read I<length> bytes of data into I<scalar> starting at I<offset>.
  64  
  65  =item READLINE this
  66  
  67  Read a single line
  68  
  69  =item GETC this
  70  
  71  Get a single character
  72  
  73  =item CLOSE this
  74  
  75  Close the handle
  76  
  77  =item OPEN this, filename
  78  
  79  (Re-)open the handle
  80  
  81  =item BINMODE this
  82  
  83  Specify content is binary
  84  
  85  =item EOF this
  86  
  87  Test for end of file.
  88  
  89  =item TELL this
  90  
  91  Return position in the file.
  92  
  93  =item SEEK this, offset, whence
  94  
  95  Position the file.
  96  
  97  Test for end of file.
  98  
  99  =item DESTROY this
 100  
 101  Free the storage associated with the tied handle referenced by I<this>.
 102  This is rarely needed, as Perl manages its memory quite well. But the
 103  option exists, should a class wish to perform specific actions upon the
 104  destruction of an instance.
 105  
 106  =back
 107  
 108  =head1 MORE INFORMATION
 109  
 110  The L<perltie> section contains an example of tying handles.
 111  
 112  =head1 COMPATIBILITY
 113  
 114  This version of Tie::Handle is neither related to nor compatible with
 115  the Tie::Handle (3.0) module available on CPAN. It was due to an
 116  accident that two modules with the same name appeared. The namespace
 117  clash has been cleared in favor of this module that comes with the
 118  perl core in September 2000 and accordingly the version number has
 119  been bumped up to 4.0.
 120  
 121  =cut
 122  
 123  use Carp;
 124  use warnings::register;
 125  
 126  sub new {
 127      my $pkg = shift;
 128      $pkg->TIEHANDLE(@_);
 129  }
 130  
 131  # "Grandfather" the new, a la Tie::Hash
 132  
 133  sub TIEHANDLE {
 134      my $pkg = shift;
 135      if (defined &{"{$pkg}::new"}) {
 136      warnings::warnif("WARNING: calling $pkg}->new since $pkg}->TIEHANDLE is missing");
 137      $pkg->new(@_);
 138      }
 139      else {
 140      croak "$pkg doesn't define a TIEHANDLE method";
 141      }
 142  }
 143  
 144  sub PRINT {
 145      my $self = shift;
 146      if($self->can('WRITE') != \&WRITE) {
 147      my $buf = join(defined $, ? $, : "",@_);
 148      $buf .= $\ if defined $\;
 149      $self->WRITE($buf,length($buf),0);
 150      }
 151      else {
 152      croak ref($self)," doesn't define a PRINT method";
 153      }
 154  }
 155  
 156  sub PRINTF {
 157      my $self = shift;
 158      
 159      if($self->can('WRITE') != \&WRITE) {
 160      my $buf = sprintf(shift,@_);
 161      $self->WRITE($buf,length($buf),0);
 162      }
 163      else {
 164      croak ref($self)," doesn't define a PRINTF method";
 165      }
 166  }
 167  
 168  sub READLINE {
 169      my $pkg = ref $_[0];
 170      croak "$pkg doesn't define a READLINE method";
 171  }
 172  
 173  sub GETC {
 174      my $self = shift;
 175      
 176      if($self->can('READ') != \&READ) {
 177      my $buf;
 178      $self->READ($buf,1);
 179      return $buf;
 180      }
 181      else {
 182      croak ref($self)," doesn't define a GETC method";
 183      }
 184  }
 185  
 186  sub READ {
 187      my $pkg = ref $_[0];
 188      croak "$pkg doesn't define a READ method";
 189  }
 190  
 191  sub WRITE {
 192      my $pkg = ref $_[0];
 193      croak "$pkg doesn't define a WRITE method";
 194  }
 195  
 196  sub CLOSE {
 197      my $pkg = ref $_[0];
 198      croak "$pkg doesn't define a CLOSE method";
 199  }
 200  
 201  1;