162 lines
3.4 KiB
Perl
162 lines
3.4 KiB
Perl
package Tie::Handle;
|
|
|
|
=head1 NAME
|
|
|
|
Tie::Handle - base class definitions for tied handles
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
package NewHandle;
|
|
require Tie::Handle;
|
|
|
|
@ISA = (Tie::Handle);
|
|
|
|
sub READ { ... } # Provide a needed method
|
|
sub TIEHANDLE { ... } # Overrides inherited method
|
|
|
|
|
|
package main;
|
|
|
|
tie *FH, 'NewHandle';
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module provides some skeletal methods for handle-tying classes. See
|
|
L<perltie> for a list of the functions required in tying a handle to a package.
|
|
The basic B<Tie::Handle> package provides a C<new> method, as well as methods
|
|
C<TIESCALAR>, C<FETCH> and C<STORE>. The C<new> method is provided as a means
|
|
of grandfathering, for classes that forget to provide their own C<TIESCALAR>
|
|
method.
|
|
|
|
For developers wishing to write their own tied-handle classes, the methods
|
|
are summarized below. The L<perltie> section not only documents these, but
|
|
has sample code as well:
|
|
|
|
=over
|
|
|
|
=item TIEHANDLE classname, LIST
|
|
|
|
The method invoked by the command C<tie *glob, classname>. Associates a new
|
|
glob instance with the specified class. C<LIST> would represent additional
|
|
arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
|
|
complete the association.
|
|
|
|
=item WRITE this, scalar, length, offset
|
|
|
|
Write I<length> bytes of data from I<scalar> starting at I<offset>.
|
|
|
|
=item PRINT this, LIST
|
|
|
|
Print the values in I<LIST>
|
|
|
|
=item PRINTF this, format, LIST
|
|
|
|
Print the values in I<LIST> using I<format>
|
|
|
|
=item READ this, scalar, length, offset
|
|
|
|
Read I<length> bytes of data into I<scalar> starting at I<offset>.
|
|
|
|
=item READLINE this
|
|
|
|
Read a single line
|
|
|
|
=item GETC this
|
|
|
|
Get a single character
|
|
|
|
=item DESTROY this
|
|
|
|
Free the storage associated with the tied handle referenced by I<this>.
|
|
This is rarely needed, as Perl manages its memory quite well. But the
|
|
option exists, should a class wish to perform specific actions upon the
|
|
destruction of an instance.
|
|
|
|
=back
|
|
|
|
=head1 MORE INFORMATION
|
|
|
|
The L<perltie> section contains an example of tying handles.
|
|
|
|
=cut
|
|
|
|
use Carp;
|
|
|
|
sub new {
|
|
my $pkg = shift;
|
|
$pkg->TIEHANDLE(@_);
|
|
}
|
|
|
|
# "Grandfather" the new, a la Tie::Hash
|
|
|
|
sub TIEHANDLE {
|
|
my $pkg = shift;
|
|
if (defined &{"{$pkg}::new"}) {
|
|
carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
|
|
if $^W;
|
|
$pkg->new(@_);
|
|
}
|
|
else {
|
|
croak "$pkg doesn't define a TIEHANDLE method";
|
|
}
|
|
}
|
|
|
|
sub PRINT {
|
|
my $self = shift;
|
|
if($self->can('WRITE') != \&WRITE) {
|
|
my $buf = join(defined $, ? $, : "",@_);
|
|
$buf .= $\ if defined $\;
|
|
$self->WRITE($buf,length($buf),0);
|
|
}
|
|
else {
|
|
croak ref($self)," doesn't define a PRINT method";
|
|
}
|
|
}
|
|
|
|
sub PRINTF {
|
|
my $self = shift;
|
|
|
|
if($self->can('WRITE') != \&WRITE) {
|
|
my $buf = sprintf(@_);
|
|
$self->WRITE($buf,length($buf),0);
|
|
}
|
|
else {
|
|
croak ref($self)," doesn't define a PRINTF method";
|
|
}
|
|
}
|
|
|
|
sub READLINE {
|
|
my $pkg = ref $_[0];
|
|
croak "$pkg doesn't define a READLINE method";
|
|
}
|
|
|
|
sub GETC {
|
|
my $self = shift;
|
|
|
|
if($self->can('READ') != \&READ) {
|
|
my $buf;
|
|
$self->READ($buf,1);
|
|
return $buf;
|
|
}
|
|
else {
|
|
croak ref($self)," doesn't define a GETC method";
|
|
}
|
|
}
|
|
|
|
sub READ {
|
|
my $pkg = ref $_[0];
|
|
croak "$pkg doesn't define a READ method";
|
|
}
|
|
|
|
sub WRITE {
|
|
my $pkg = ref $_[0];
|
|
croak "$pkg doesn't define a WRITE method";
|
|
}
|
|
|
|
sub CLOSE {
|
|
my $pkg = ref $_[0];
|
|
croak "$pkg doesn't define a CLOSE method";
|
|
}
|
|
|
|
1;
|