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