diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tie/StdHandle.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tie/StdHandle.pm | 71 |
1 files changed, 71 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tie/StdHandle.pm b/Master/tlpkg/tlperl/lib/Tie/StdHandle.pm new file mode 100644 index 00000000000..3a1a3db4788 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tie/StdHandle.pm @@ -0,0 +1,71 @@ +package Tie::StdHandle; + +use strict; + +use Tie::Handle; +use vars qw(@ISA $VERSION); +@ISA = 'Tie::Handle'; +$VERSION = '4.2'; + +=head1 NAME + +Tie::StdHandle - 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 + +The B<Tie::StdHandle> package provide most methods for file handles described +in L<perltie> (the exceptions are C<UNTIE> and C<DESTROY>). It causes tied +file handles to behave exactly like standard file handles and allow for +selective overwriting of methods. + +=cut + +sub TIEHANDLE +{ + my $class = shift; + my $fh = \do { local *HANDLE}; + bless $fh,$class; + $fh->OPEN(@_) if (@_); + return $fh; +} + +sub EOF { eof($_[0]) } +sub TELL { tell($_[0]) } +sub FILENO { fileno($_[0]) } +sub SEEK { seek($_[0],$_[1],$_[2]) } +sub CLOSE { close($_[0]) } +sub BINMODE { binmode($_[0]) } + +sub OPEN +{ + $_[0]->CLOSE if defined($_[0]->FILENO); + @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]); +} + +sub READ { read($_[0],$_[1],$_[2]) } +sub READLINE { my $fh = $_[0]; <$fh> } +sub GETC { getc($_[0]) } + +sub WRITE +{ + my $fh = $_[0]; + print $fh substr($_[1],0,$_[2]) +} + + +1; |