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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 (file)
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 (file)
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;