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