From 316ee97c621496b0fe3267f57cce81bee44ca1e6 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 17 Feb 2011 12:20:49 +0000 Subject: Moving old tlperl prior to committing new one git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl0/lib/Tie/Handle.pm | 201 +++++++++++++++++++++++++++++++++ 1 file changed, 201 insertions(+) create mode 100755 Master/tlpkg/tlperl0/lib/Tie/Handle.pm (limited to 'Master/tlpkg/tlperl0/lib/Tie/Handle.pm') diff --git a/Master/tlpkg/tlperl0/lib/Tie/Handle.pm b/Master/tlpkg/tlperl0/lib/Tie/Handle.pm new file mode 100755 index 00000000000..4e92f75a3d1 --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/Tie/Handle.pm @@ -0,0 +1,201 @@ +package Tie::Handle; + +use 5.006_001; +our $VERSION = '4.2'; + +# Tie::StdHandle used to be inside Tie::Handle. For backwards compatibility +# loading Tie::Handle has to make Tie::StdHandle available. +use Tie::StdHandle; + +=head1 NAME + +Tie::Handle - base class definitions for tied handles + +=head1 SYNOPSIS + + package NewHandle; + require Tie::Handle; + + @ISA = qw(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 for a list of the functions required in tying a handle to a package. +The basic B package provides a C method, as well as methods +C, C, C and C. + +For developers wishing to write their own tied-handle classes, the methods +are summarized below. The L section not only documents these, but +has sample code as well: + +=over 4 + +=item TIEHANDLE classname, LIST + +The method invoked by the command C. Associates a new +glob instance with the specified class. C would represent additional +arguments (along the lines of L and compatriots) needed to +complete the association. + +=item WRITE this, scalar, length, offset + +Write I bytes of data from I starting at I. + +=item PRINT this, LIST + +Print the values in I + +=item PRINTF this, format, LIST + +Print the values in I using I + +=item READ this, scalar, length, offset + +Read I bytes of data into I starting at I. + +=item READLINE this + +Read a single line + +=item GETC this + +Get a single character + +=item CLOSE this + +Close the handle + +=item OPEN this, filename + +(Re-)open the handle + +=item BINMODE this + +Specify content is binary + +=item EOF this + +Test for end of file. + +=item TELL this + +Return position in the file. + +=item SEEK this, offset, whence + +Position the file. + +Test for end of file. + +=item DESTROY this + +Free the storage associated with the tied handle referenced by I. +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 section contains an example of tying handles. + +=head1 COMPATIBILITY + +This version of Tie::Handle is neither related to nor compatible with +the Tie::Handle (3.0) module available on CPAN. It was due to an +accident that two modules with the same name appeared. The namespace +clash has been cleared in favor of this module that comes with the +perl core in September 2000 and accordingly the version number has +been bumped up to 4.0. + +=cut + +use Carp; +use warnings::register; + +sub new { + my $pkg = shift; + $pkg->TIEHANDLE(@_); +} + +# "Grandfather" the new, a la Tie::Hash + +sub TIEHANDLE { + my $pkg = shift; + if (defined &{"{$pkg}::new"}) { + warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"); + $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(shift,@_); + $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; -- cgit v1.2.3