← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:45 2017

Filename/usr/local/lib/perl5/5.24/Tie/Hash.pm
StatementsExecuted 7 statements in 1.33ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11144µs211µsTie::Hash::::BEGIN@190 Tie::Hash::BEGIN@190
11127µs489µsTie::Hash::::BEGIN@191 Tie::Hash::BEGIN@191
1118µs8µsTie::StdHash::::TIEHASH Tie::StdHash::TIEHASH
0000s0sTie::ExtraHash::::CLEARTie::ExtraHash::CLEAR
0000s0sTie::ExtraHash::::DELETETie::ExtraHash::DELETE
0000s0sTie::ExtraHash::::EXISTSTie::ExtraHash::EXISTS
0000s0sTie::ExtraHash::::FETCHTie::ExtraHash::FETCH
0000s0sTie::ExtraHash::::FIRSTKEYTie::ExtraHash::FIRSTKEY
0000s0sTie::ExtraHash::::NEXTKEYTie::ExtraHash::NEXTKEY
0000s0sTie::ExtraHash::::SCALARTie::ExtraHash::SCALAR
0000s0sTie::ExtraHash::::STORETie::ExtraHash::STORE
0000s0sTie::ExtraHash::::TIEHASHTie::ExtraHash::TIEHASH
0000s0sTie::Hash::::CLEAR Tie::Hash::CLEAR
0000s0sTie::Hash::::EXISTS Tie::Hash::EXISTS
0000s0sTie::Hash::::TIEHASH Tie::Hash::TIEHASH
0000s0sTie::Hash::::new Tie::Hash::new
0000s0sTie::StdHash::::CLEAR Tie::StdHash::CLEAR
0000s0sTie::StdHash::::DELETE Tie::StdHash::DELETE
0000s0sTie::StdHash::::EXISTS Tie::StdHash::EXISTS
0000s0sTie::StdHash::::FETCH Tie::StdHash::FETCH
0000s0sTie::StdHash::::FIRSTKEY Tie::StdHash::FIRSTKEY
0000s0sTie::StdHash::::NEXTKEY Tie::StdHash::NEXTKEY
0000s0sTie::StdHash::::SCALAR Tie::StdHash::SCALAR
0000s0sTie::StdHash::::STORE Tie::StdHash::STORE
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Tie::Hash;
2
312µsour $VERSION = '1.05';
4
5=head1 NAME
6
7Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for tied hashes
8
9=head1 SYNOPSIS
10
11 package NewHash;
12 require Tie::Hash;
13
14 @ISA = qw(Tie::Hash);
15
16 sub DELETE { ... } # Provides needed method
17 sub CLEAR { ... } # Overrides inherited method
18
19
20 package NewStdHash;
21 require Tie::Hash;
22
23 @ISA = qw(Tie::StdHash);
24
25 # All methods provided by default, define
26 # only those needing overrides
27 # Accessors access the storage in %{$_[0]};
28 # TIEHASH should return a reference to the actual storage
29 sub DELETE { ... }
30
31 package NewExtraHash;
32 require Tie::Hash;
33
34 @ISA = qw(Tie::ExtraHash);
35
36 # All methods provided by default, define
37 # only those needing overrides
38 # Accessors access the storage in %{$_[0][0]};
39 # TIEHASH should return an array reference with the first element
40 # being the reference to the actual storage
41 sub DELETE {
42 $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer
43 delete $_[0][0]->{$_[1]}; # $_[0]->SUPER::DELETE($_[1])
44 }
45
46
47 package main;
48
49 tie %new_hash, 'NewHash';
50 tie %new_std_hash, 'NewStdHash';
51 tie %new_extra_hash, 'NewExtraHash',
52 sub {warn "Doing \U$_[1]\E of $_[2].\n"};
53
54=head1 DESCRIPTION
55
56This module provides some skeletal methods for hash-tying classes. See
57L<perltie> for a list of the functions required in order to tie a hash
58to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
59as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> and
60B<Tie::ExtraHash> packages
61provide most methods for hashes described in L<perltie> (the exceptions
62are C<UNTIE> and C<DESTROY>). They cause tied hashes to behave exactly like standard hashes,
63and allow for selective overwriting of methods. B<Tie::Hash> grandfathers the
64C<new> method: it is used if C<TIEHASH> is not defined
65in the case a class forgets to include a C<TIEHASH> method.
66
67For developers wishing to write their own tied hashes, the required methods
68are briefly defined below. See the L<perltie> section for more detailed
69descriptive, as well as example code:
70
71=over 4
72
73=item TIEHASH classname, LIST
74
75The method invoked by the command C<tie %hash, classname>. Associates a new
76hash instance with the specified class. C<LIST> would represent additional
77arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
78complete the association.
79
80=item STORE this, key, value
81
82Store datum I<value> into I<key> for the tied hash I<this>.
83
84=item FETCH this, key
85
86Retrieve the datum in I<key> for the tied hash I<this>.
87
88=item FIRSTKEY this
89
90Return the first key in the hash.
91
92=item NEXTKEY this, lastkey
93
94Return the next key in the hash.
95
96=item EXISTS this, key
97
98Verify that I<key> exists with the tied hash I<this>.
99
100The B<Tie::Hash> implementation is a stub that simply croaks.
101
102=item DELETE this, key
103
104Delete the key I<key> from the tied hash I<this>.
105
106=item CLEAR this
107
108Clear all values from the tied hash I<this>.
109
110=item SCALAR this
111
112Returns what evaluating the hash in scalar context yields.
113
114B<Tie::Hash> does not implement this method (but B<Tie::StdHash>
115and B<Tie::ExtraHash> do).
116
117=back
118
119=head1 Inheriting from B<Tie::StdHash>
120
121The accessor methods assume that the actual storage for the data in the tied
122hash is in the hash referenced by C<tied(%tiedhash)>. Thus overwritten
123C<TIEHASH> method should return a hash reference, and the remaining methods
124should operate on the hash referenced by the first argument:
125
126 package ReportHash;
127 our @ISA = 'Tie::StdHash';
128
129 sub TIEHASH {
130 my $storage = bless {}, shift;
131 warn "New ReportHash created, stored in $storage.\n";
132 $storage
133 }
134 sub STORE {
135 warn "Storing data with key $_[1] at $_[0].\n";
136 $_[0]{$_[1]} = $_[2]
137 }
138
139
140=head1 Inheriting from B<Tie::ExtraHash>
141
142The accessor methods assume that the actual storage for the data in the tied
143hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thus overwritten
144C<TIEHASH> method should return an array reference with the first
145element being a hash reference, and the remaining methods should operate on the
146hash C<< %{ $_[0]->[0] } >>:
147
148 package ReportHash;
149 our @ISA = 'Tie::ExtraHash';
150
151 sub TIEHASH {
152 my $class = shift;
153 my $storage = bless [{}, @_], $class;
154 warn "New ReportHash created, stored in $storage.\n";
155 $storage;
156 }
157 sub STORE {
158 warn "Storing data with key $_[1] at $_[0].\n";
159 $_[0][0]{$_[1]} = $_[2]
160 }
161
162The default C<TIEHASH> method stores "extra" arguments to tie() starting
163from offset 1 in the array referenced by C<tied(%tiedhash)>; this is the
164same storage algorithm as in TIEHASH subroutine above. Hence, a typical
165package inheriting from B<Tie::ExtraHash> does not need to overwrite this
166method.
167
168=head1 C<SCALAR>, C<UNTIE> and C<DESTROY>
169
170The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>,
171B<Tie::StdHash>, or B<Tie::ExtraHash>. Tied hashes do not require
172presence of these methods, but if defined, the methods will be called in
173proper time, see L<perltie>.
174
175C<SCALAR> is only defined in B<Tie::StdHash> and B<Tie::ExtraHash>.
176
177If needed, these methods should be defined by the package inheriting from
178B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. See L<perltie/"SCALAR">
179to find out what happens when C<SCALAR> does not exist.
180
181=head1 MORE INFORMATION
182
183The packages relating to various DBM-related implementations (F<DB_File>,
184F<NDBM_File>, etc.) show examples of general tied hashes, as does the
185L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
186good working examples.
187
188=cut
189
190261µs2377µs
# spent 211µs (44+166) within Tie::Hash::BEGIN@190 which was called: # once (44µs+166µs) by Mail::SpamAssassin::Logger::Stderr::BEGIN@37 at line 190
use Carp;
# spent 211µs making 1 call to Tie::Hash::BEGIN@190 # spent 166µs making 1 call to Exporter::import
19121.25ms2952µs
# spent 489µs (27+462) within Tie::Hash::BEGIN@191 which was called: # once (27µs+462µs) by Mail::SpamAssassin::Logger::Stderr::BEGIN@37 at line 191
use warnings::register;
# spent 489µs making 1 call to Tie::Hash::BEGIN@191 # spent 462µs making 1 call to warnings::register::import
192
193sub new {
194 my $pkg = shift;
195 $pkg->TIEHASH(@_);
196}
197
198# Grandfather "new"
199
200sub TIEHASH {
201 my $pkg = shift;
202 my $pkg_new = $pkg -> can ('new');
203
204 if ($pkg_new and $pkg ne __PACKAGE__) {
205 my $my_new = __PACKAGE__ -> can ('new');
206 if ($pkg_new == $my_new) {
207 #
208 # Prevent recursion
209 #
210 croak "$pkg must define either a TIEHASH() or a new() method";
211 }
212
213 warnings::warnif ("WARNING: calling ${pkg}->new since " .
214 "${pkg}->TIEHASH is missing");
215 $pkg -> new (@_);
216 }
217 else {
218 croak "$pkg doesn't define a TIEHASH method";
219 }
220}
221
222sub EXISTS {
223 my $pkg = ref $_[0];
224 croak "$pkg doesn't define an EXISTS method";
225}
226
227sub CLEAR {
228 my $self = shift;
229 my $key = $self->FIRSTKEY(@_);
230 my @keys;
231
232 while (defined $key) {
233 push @keys, $key;
234 $key = $self->NEXTKEY(@_, $key);
235 }
236 foreach $key (@keys) {
237 $self->DELETE(@_, $key);
238 }
239}
240
241# The Tie::StdHash package implements standard perl hash behaviour.
242# It exists to act as a base class for classes which only wish to
243# alter some parts of their behaviour.
244
245package Tie::StdHash;
246# @ISA = qw(Tie::Hash); # would inherit new() only
247
248113µs
# spent 8µs within Tie::StdHash::TIEHASH which was called: # once (8µs+0s) by Mail::SpamAssassin::Logger::Stderr::BEGIN@37 at line 541 of POSIX.pm
sub TIEHASH { bless {}, $_[0] }
249sub STORE { $_[0]->{$_[1]} = $_[2] }
250sub FETCH { $_[0]->{$_[1]} }
251sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
252sub NEXTKEY { each %{$_[0]} }
253sub EXISTS { exists $_[0]->{$_[1]} }
254sub DELETE { delete $_[0]->{$_[1]} }
255sub CLEAR { %{$_[0]} = () }
256sub SCALAR { scalar %{$_[0]} }
257
258package Tie::ExtraHash;
259
260sub TIEHASH { my $p = shift; bless [{}, @_], $p }
261sub STORE { $_[0][0]{$_[1]} = $_[2] }
262sub FETCH { $_[0][0]{$_[1]} }
263sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
264sub NEXTKEY { each %{$_[0][0]} }
265sub EXISTS { exists $_[0][0]->{$_[1]} }
266sub DELETE { delete $_[0][0]->{$_[1]} }
267sub CLEAR { %{$_[0][0]} = () }
268sub SCALAR { scalar %{$_[0][0]} }
269
27018µs1;
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.