lib/Tie/Handle.pm

   1 package Tie::Handle;
   2
   3 =head1 NAME
   4
   5 Tie::Handle - base class definitions for tied handles
   6
   7 =head1 SYNOPSIS
   8
   9     package NewHandle;
  10     require Tie::Handle;
  11
  12     @ISA = (Tie::Handle);
  13
  14     sub READ { ... }            # Provide a needed method
  15     sub TIEHANDLE { ... }       # Overrides inherited method
  16
  17
  18     package main;
  19
  20     tie *FH, 'NewHandle';
  21
  22 =head1 DESCRIPTION
  23
  24 This module provides some skeletal methods for handle-tying classes. See
  25 L<perltie> for a list of the functions required in tying a handle to a package.
  26 The basic B<Tie::Handle> package provides a C<new> method, as well as methods
  27 C<TIESCALAR>, C<FETCH> and C<STORE>. The C<new> method is provided as a means
  28 of grandfathering, for classes that forget to provide their own C<TIESCALAR>
  29 method.
  30
  31 For developers wishing to write their own tied-handle classes, the methods
  32 are summarized below. The L<perltie> section not only documents these, but
  33 has sample code as well:
  34
  35 =over
  36
  37 =item TIEHANDLE classname, LIST
  38
  39 The method invoked by the command C<tie *glob, classname>. Associates a new
  40 glob instance with the specified class. C<LIST> would represent additional
  41 arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
  42 complete the association.
  43
  44 =item WRITE this, scalar, length, offset
  45
  46 Write I<length> bytes of data from I<scalar> starting at I<offset>.
  47
  48 =item PRINT this, LIST
  49
  50 Print the values in I<LIST>
  51
  52 =item PRINTF this, format, LIST
  53
  54 Print the values in I<LIST> using I<format>
  55
  56 =item READ this, scalar, length, offset
  57
  58 Read I<length> bytes of data into I<scalar> starting at I<offset>.
  59
  60 =item READLINE this
  61
  62 Read a single line
  63
  64 =item GETC this
  65
  66 Get a single character
  67
  68 =item CLOSE this
  69
  70 Close the handle
  71
  72 =item DESTROY this
  73
  74 Free the storage associated with the tied handle referenced by I<this>.
  75 This is rarely needed, as Perl manages its memory quite well. But the
  76 option exists, should a class wish to perform specific actions upon the
  77 destruction of an instance.
  78
  79 =back
  80
  81 =head1 MORE INFORMATION
  82
  83 The L<perltie> section contains an example of tying handles.
  84
  85 =cut
  86
  87 use Carp;
  88
  89 sub new {
  90     my $pkg = shift;
  91     $pkg->TIEHANDLE(@_);
  92 }
  93
  94 # "Grandfather" the new, a la Tie::Hash
  95
  96 sub TIEHANDLE {
  97     my $pkg = shift;
  98     if (defined &{"{$pkg}::new"}) {
  99         carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
 100             if $^W;
 101         $pkg->new(@_);
 102     }
 103     else {
 104         croak "$pkg doesn't define a TIEHANDLE method";
 105     }
 106 }
 107
 108 sub PRINT {
 109     my $self = shift;
 110     if($self->can('WRITE') != \&WRITE) {
 111         my $buf = join(defined $, ? $, : "",@_);
 112         $buf .= $\ if defined $\;
 113         $self->WRITE($buf,length($buf),0);
 114     }
 115     else {
 116         croak ref($self)," doesn't define a PRINT method";
 117     }
 118 }
 119
 120 sub PRINTF {
 121     my $self = shift;
 122
 123     if($self->can('WRITE') != \&WRITE) {
 124         my $buf = sprintf(@_);
 125         $self->WRITE($buf,length($buf),0);
 126     }
 127     else {
 128         croak ref($self)," doesn't define a PRINTF method";
 129     }
 130 }
 131
 132 sub READLINE {
 133     my $pkg = ref $_[0];
 134     croak "$pkg doesn't define a READLINE method";
 135 }
 136
 137 sub GETC {
 138     my $self = shift;
 139
 140     if($self->can('READ') != \&READ) {
 141         my $buf;
 142         $self->READ($buf,1);
 143         return $buf;
 144     }
 145     else {
 146         croak ref($self)," doesn't define a GETC method";
 147     }
 148 }
 149
 150 sub READ {
 151     my $pkg = ref $_[0];
 152     croak "$pkg doesn't define a READ method";
 153 }
 154
 155 sub WRITE {
 156     my $pkg = ref $_[0];
 157     croak "$pkg doesn't define a WRITE method";
 158 }
 159
 160 sub CLOSE {
 161     my $pkg = ref $_[0];
 162     croak "$pkg doesn't define a CLOSE method";
 163 }
 164
 165 1;