← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:10 2021

Filename/usr/local/lib/perl5/site_perl/IO/WrapTie.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sIO::WrapTie::::BEGIN@3 IO::WrapTie::BEGIN@3
0000s0sIO::WrapTie::::BEGIN@4 IO::WrapTie::BEGIN@4
0000s0sIO::WrapTie::Master::::AUTOLOADIO::WrapTie::Master::AUTOLOAD
0000s0sIO::WrapTie::Master::::BEGIN@29IO::WrapTie::Master::BEGIN@29
0000s0sIO::WrapTie::Master::::BEGIN@30IO::WrapTie::Master::BEGIN@30
0000s0sIO::WrapTie::Master::::BEGIN@31IO::WrapTie::Master::BEGIN@31
0000s0sIO::WrapTie::Master::::PRELOADIO::WrapTie::Master::PRELOAD
0000s0sIO::WrapTie::Master::::newIO::WrapTie::Master::new
0000s0sIO::WrapTie::Slave::::TIE_MASTER IO::WrapTie::Slave::TIE_MASTER
0000s0sIO::WrapTie::Slave::::new_tie IO::WrapTie::Slave::new_tie
0000s0sIO::WrapTie::::new IO::WrapTie::new
0000s0sIO::WrapTie::::wraptie IO::WrapTie::wraptie
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package IO::WrapTie;
2
3use strict;
4use Exporter;
5
6# Inheritance, exporting, and package version:
7our @ISA = qw(Exporter);
8our @EXPORT = qw(wraptie);
9our $VERSION = '2.113';
10
11# Function, exported.
12sub wraptie {
13 IO::WrapTie::Master->new(@_);
14}
15
16# Class method; BACKWARDS-COMPATIBILITY ONLY!
17sub new {
18 shift;
19 IO::WrapTie::Master->new(@_);
20}
21
- -
24#------------------------------------------------------------
25package # hide from pause
26 IO::WrapTie::Master;
27#------------------------------------------------------------
28
29use strict;
30use vars qw($AUTOLOAD);
31use IO::Handle;
32
33# We inherit from IO::Handle to get methods which invoke i/o operators,
34# like print(), on our tied handle:
35our @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<TIEHANDLE> 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#
56sub new {
57 my $master = shift;
58 my $io = IO::Handle->new; ### create a new handle
59 my $slave = shift;
60 tie *$io, $slave, @_; ### tie: will invoke slave's TIEHANDLE
61 bless $io, $master; ### return a master
62}
63
64#------------------------------
65# AUTOLOAD
66#------------------------------
67# Delegate method invocations on the master to the underlying slave.
68#
69sub AUTOLOAD {
70 my $method = $AUTOLOAD;
71 $method =~ s/.*:://;
72 my $self = shift; tied(*$self)->$method(\@_);
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#
89sub PRELOAD {
90 my $class = shift;
91 foreach (@_) {
92 eval "sub ${class}::$_ { my \$s = shift; tied(*\$s)->$_(\@_) }";
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#
100PRELOAD IO::WrapTie::Master
101 qw(open opened close read clearerr eof seek tell setpos getpos);
102
- -
105#------------------------------------------------------------
106package # 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#
124sub new_tie {
125 my $self = shift;
126 $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#
134sub TIE_MASTER { 'IO::WrapTie::Master' }
135
136#------------------------------
1371;
138__END__