lib/Tie/Handle.pm

   1 package Tie::Handle;
   2
   3 use 5.006_001;
   4 our $VERSION = '4.2';
   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;