1#line 1
2# SEE DOCUMENTATION AT BOTTOM OF FILE
3
4
5#------------------------------------------------------------
6package IO::WrapTie;
7#------------------------------------------------------------
8require 5.004;              ### for tie
9use strict;
10use vars qw(@ISA @EXPORT $VERSION);
11use Exporter;
12
13# Inheritance, exporting, and package version:
14@ISA     = qw(Exporter);
15@EXPORT  = qw(wraptie);
16$VERSION = "2.110";
17
18# Function, exported.
19sub wraptie {
20    IO::WrapTie::Master->new(@_);
21}
22
23# Class method; BACKWARDS-COMPATIBILITY ONLY!
24sub new {
25    shift;
26    IO::WrapTie::Master->new(@_);
27}
28
29
30
31#------------------------------------------------------------
32package IO::WrapTie::Master;
33#------------------------------------------------------------
34
35use strict;
36use vars qw(@ISA $AUTOLOAD);
37use IO::Handle;
38
39# We inherit from IO::Handle to get methods which invoke i/o operators,
40# like print(), on our tied handle:
41@ISA = qw(IO::Handle);
42
43#------------------------------
44# new SLAVE, TIEARGS...
45#------------------------------
46# Create a new subclass of IO::Handle which...
47#
48#   (1) Handles i/o OPERATORS because it is tied to an instance of
49#       an i/o-like class, like IO::Scalar.
50#
51#   (2) Handles i/o METHODS by delegating them to that same tied object!.
52#
53# Arguments are the slave class (e.g., IO::Scalar), followed by all
54# the arguments normally sent into that class's TIEHANDLE method.
55# In other words, much like the arguments to tie().  :-)
56#
57# NOTE:
58# The thing $x we return must be a BLESSED REF, for ($x->print()).
59# The underlying symbol must be a FILEHANDLE, for (print $x "foo").
60# It has to have a way of getting to the "real" back-end object...
61#
62sub new {
63    my $master = shift;
64    my $io = IO::Handle->new;   ### create a new handle
65    my $slave = shift;
66    tie *$io, $slave, @_;       ### tie: will invoke slave's TIEHANDLE
67    bless $io, $master;         ### return a master
68}
69
70#------------------------------
71# AUTOLOAD
72#------------------------------
73# Delegate method invocations on the master to the underlying slave.
74#
75sub AUTOLOAD {
76    my $method = $AUTOLOAD;
77    $method =~ s/.*:://;
78    my $self = shift; tied(*$self)->$method(\@_);
79}
80
81#------------------------------
82# PRELOAD
83#------------------------------
84# Utility.
85#
86# Most methods like print(), getline(), etc. which work on the tied object
87# via Perl's i/o operators (like 'print') are inherited from IO::Handle.
88#
89# Other methods, like seek() and sref(), we must delegate ourselves.
90# AUTOLOAD takes care of these.
91#
92# However, it may be necessary to preload delegators into your
93# own class.  PRELOAD will do this.
94#
95sub PRELOAD {
96    my $class = shift;
97    foreach (@_) {
98	eval "sub ${class}::$_ { my \$s = shift; tied(*\$s)->$_(\@_) }";
99    }
100}
101
102# Preload delegators for some standard methods which we can't simply
103# inherit from IO::Handle... for example, some IO::Handle methods
104# assume that there is an underlying file descriptor.
105#
106PRELOAD IO::WrapTie::Master
107    qw(open opened close read clearerr eof seek tell setpos getpos);
108
109
110
111#------------------------------------------------------------
112package IO::WrapTie::Slave;
113#------------------------------------------------------------
114# Teeny private class providing a new_tie constructor...
115#
116# HOW IT ALL WORKS:
117#
118# Slaves inherit from this class.
119#
120# When you send a new_tie() message to a tie-slave class (like IO::Scalar),
121# it first determines what class should provide its master, via TIE_MASTER.
122# In this case, IO::Scalar->TIE_MASTER would return IO::Scalar::Master.
123# Then, we create a new master (an IO::Scalar::Master) with the same args
124# sent to new_tie.
125#
126# In general, the new() method of the master is inherited directly
127# from IO::WrapTie::Master.
128#
129sub new_tie {
130    my $self = shift;
131    $self->TIE_MASTER->new($self,@_);     ### e.g., IO::Scalar::Master->new(@_)
132}
133
134# Default class method for new_tie().
135# All your tie-slave class (like IO::Scalar) has to do is override this
136# method with a method that returns the name of an appropriate "master"
137# class for tying that slave.
138#
139sub TIE_MASTER { 'IO::WrapTie::Master' }
140
141#------------------------------
1421;
143__END__
144
145
146package IO::WrapTie;      ### for doc generator
147
148
149#line 490
150
151