File Coverage

blib/lib/IO/WrapTie.pm
Criterion Covered Total %
statement 31 53 58.4
branch n/a
condition n/a
subroutine 10 22 45.4
pod 1 2 50.0
total 42 77 54.5


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