From: Michael G. Schwern Date: Tue, 7 Aug 2007 15:47:31 +0000 (-0700) Subject: Move Tie::StdHandle into its own file. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6269bcb345b181471bbd548478a6bca649978f78;p=p5sagit%2Fp5-mst-13.2.git Move Tie::StdHandle into its own file. Message-Id: <46B8F683.7040607@pobox.com> p4raw-id: //depot/perl@31689 --- diff --git a/MANIFEST b/MANIFEST index 8375e39..c5acd01 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2765,6 +2765,7 @@ lib/Tie/File/t/41_heap.t Unit tests for Tie::File::Heap lib/Tie/File/t/42_offset.t Unit tests for the offset method lib/Tie/Handle.pm Base class for tied handles lib/Tie/Handle/stdhandle.t Test for Tie::StdHandle +lib/Tie/Handle/stdhandle_from_handle.t Test for Tie::StdHandle/Handle backwards compat lib/Tie/Hash/NamedCapture.pm Implements %- and %+ behaviour lib/Tie/Hash.pm Base class for tied hashes lib/Tie/Memoize.pm Base class for memoized tied hashes @@ -2776,6 +2777,7 @@ lib/Tie/RefHash/storable.t Test for Tie::RefHash with storable lib/Tie/RefHash/threaded.t Test for Tie::RefHash with threads lib/Tie/Scalar.pm Base class for tied scalars lib/Tie/Scalar.t See if Tie::Scalar works +lib/Tie/StdHandle.pm Tie::StdHandle lib/Tie/SubstrHash.pm Compact hash for known key, value and table size lib/Tie/SubstrHash.t Test for Tie::SubstrHash lib/Time/gmtime.pm By-name interface to Perl's builtin gmtime diff --git a/lib/Tie/Handle.pm b/lib/Tie/Handle.pm index d8747f1..1751650 100644 --- a/lib/Tie/Handle.pm +++ b/lib/Tie/Handle.pm @@ -3,9 +3,13 @@ package Tie::Handle; use 5.006_001; our $VERSION = '4.1'; +# 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, Tie::StdHandle - base class definitions for tied handles +Tie::Handle - base class definitions for tied handles =head1 SYNOPSIS @@ -194,41 +198,4 @@ sub CLOSE { croak "$pkg doesn't define a CLOSE method"; } -package Tie::StdHandle; -our @ISA = 'Tie::Handle'; -use Carp; - -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; diff --git a/lib/Tie/Handle/stdhandle.t b/lib/Tie/Handle/stdhandle.t index f03f5d9..13a8255 100755 --- a/lib/Tie/Handle/stdhandle.t +++ b/lib/Tie/Handle/stdhandle.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -use Tie::Handle; +use Tie::StdHandle; tie *tst,Tie::StdHandle; $f = 'tst'; diff --git a/lib/Tie/Handle/stdhandle_from_handle.t b/lib/Tie/Handle/stdhandle_from_handle.t new file mode 100644 index 0000000..71eb608 --- /dev/null +++ b/lib/Tie/Handle/stdhandle_from_handle.t @@ -0,0 +1,18 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Test::More tests => 1; + +use Tie::Handle; + +{ + package Foo; + @ISA = qw(Tie::StdHandle); +} + +# For backwards compatabilty with 5.8.x +ok( Foo->can("TIEHANDLE"), "loading Tie::Handle loads TieStdHandle" ); diff --git a/lib/Tie/StdHandle.pm b/lib/Tie/StdHandle.pm new file mode 100644 index 0000000..93db289 --- /dev/null +++ b/lib/Tie/StdHandle.pm @@ -0,0 +1,40 @@ +package Tie::StdHandle; + +use Tie::Handle; +our @ISA = 'Tie::Handle'; +use Carp; + +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;