contrib/perl5/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 DESTROY this
  69
  70 Free the storage associated with the tied handle referenced by I<this>.
  71 This is rarely needed, as Perl manages its memory quite well. But the
  72 option exists, should a class wish to perform specific actions upon the
  73 destruction of an instance.
  74
  75 =back
  76
  77 =head1 MORE INFORMATION
  78
  79 The L<perltie> section contains an example of tying handles.
  80
  81 =cut
  82
  83 use Carp;
  84
  85 sub new {
  86     my $pkg = shift;
  87     $pkg->TIEHANDLE(@_);
  88 }
  89
  90 # "Grandfather" the new, a la Tie::Hash
  91
  92 sub TIEHANDLE {
  93     my $pkg = shift;
  94     if (defined &{"{$pkg}::new"}) {
  95         carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
  96             if $^W;
  97         $pkg->new(@_);
  98     }
  99     else {
 100         croak "$pkg doesn't define a TIEHANDLE method";
 101     }
 102 }
 103
 104 sub PRINT {
 105     my $self = shift;
 106     if($self->can('WRITE') != \&WRITE) {
 107         my $buf = join(defined $, ? $, : "",@_);
 108         $buf .= $\ if defined $\;
 109         $self->WRITE($buf,length($buf),0);
 110     }
 111     else {
 112         croak ref($self)," doesn't define a PRINT method";
 113     }
 114 }
 115
 116 sub PRINTF {
 117     my $self = shift;
 118
 119     if($self->can('WRITE') != \&WRITE) {
 120         my $buf = sprintf(@_);
 121         $self->WRITE($buf,length($buf),0);
 122     }
 123     else {
 124         croak ref($self)," doesn't define a PRINTF method";
 125     }
 126 }
 127
 128 sub READLINE {
 129     my $pkg = ref $_[0];
 130     croak "$pkg doesn't define a READLINE method";
 131 }
 132
 133 sub GETC {
 134     my $self = shift;
 135
 136     if($self->can('READ') != \&READ) {
 137         my $buf;
 138         $self->READ($buf,1);
 139         return $buf;
 140     }
 141     else {
 142         croak ref($self)," doesn't define a GETC method";
 143     }
 144 }
 145
 146 sub READ {
 147     my $pkg = ref $_[0];
 148     croak "$pkg doesn't define a READ method";
 149 }
 150
 151 sub WRITE {
 152     my $pkg = ref $_[0];
 153     croak "$pkg doesn't define a WRITE method";
 154 }
 155
 156 sub CLOSE {
 157     my $pkg = ref $_[0];
 158     croak "$pkg doesn't define a CLOSE method";
 159 }
 160
 161 1;