Profile of Tie/Hash.pm

← Index
NYTProf Performance Profile «line view»
For t/bug-md-11.t
Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/5.38.2/Tie/Hash.pm
Statements | Executed 7 statements in 563µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 2.89ms | 3.53ms | Tie::Hash::::BEGIN@190 Tie::Hash::BEGIN@190
1 | 1 | 1 | 121µs | 141µs | Tie::Hash::::BEGIN@191 Tie::Hash::BEGIN@191
1 | 1 | 1 | 2µs | 2µs | Tie::StdHash::::TIEHASH Tie::StdHash::TIEHASH
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::CLEARTie::ExtraHash::CLEAR
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::DELETETie::ExtraHash::DELETE
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::EXISTSTie::ExtraHash::EXISTS
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::FETCHTie::ExtraHash::FETCH
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::FIRSTKEYTie::ExtraHash::FIRSTKEY
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::NEXTKEYTie::ExtraHash::NEXTKEY
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::SCALARTie::ExtraHash::SCALAR
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::STORETie::ExtraHash::STORE
0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::::TIEHASHTie::ExtraHash::TIEHASH
0 | 0 | 0 | 0s | 0s | Tie::Hash::::CLEAR Tie::Hash::CLEAR
0 | 0 | 0 | 0s | 0s | Tie::Hash::::EXISTS Tie::Hash::EXISTS
0 | 0 | 0 | 0s | 0s | Tie::Hash::::TIEHASH Tie::Hash::TIEHASH
0 | 0 | 0 | 0s | 0s | Tie::Hash::::new Tie::Hash::new
0 | 0 | 0 | 0s | 0s | Tie::StdHash::::CLEAR Tie::StdHash::CLEAR
0 | 0 | 0 | 0s | 0s | Tie::StdHash::::DELETE Tie::StdHash::DELETE
0 | 0 | 0 | 0s | 0s | Tie::StdHash::::EXISTS Tie::StdHash::EXISTS
0 | 0 | 0 | 0s | 0s | Tie::StdHash::::FETCH Tie::StdHash::FETCH
0 | 0 | 0 | 0s | 0s | Tie::StdHash::::FIRSTKEY Tie::StdHash::FIRSTKEY
0 | 0 | 0 | 0s | 0s | Tie::StdHash::::NEXTKEY Tie::StdHash::NEXTKEY
0 | 0 | 0 | 0s | 0s | Tie::StdHash::::SCALAR Tie::StdHash::SCALAR
0 | 0 | 0 | 0s | 0s | Tie::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Tie::Hash;
2 |  |  |  |  |
3 | 1 | 400ns |  |  | our $VERSION = '1.06';
4 |  |  |  |  |
5 |  |  |  |  | =head1 NAME
6 |  |  |  |  |
7 |  |  |  |  | Tie::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 |  |  |  |  |
56 |  |  |  |  | This module provides some skeletal methods for hash-tying classes. See
57 |  |  |  |  | L<perltie> for a list of the functions required in order to tie a hash
58 |  |  |  |  | to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
59 |  |  |  |  | as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> and
60 |  |  |  |  | B<Tie::ExtraHash> packages
61 |  |  |  |  | provide most methods for hashes described in L<perltie> (the exceptions
62 |  |  |  |  | are C<UNTIE> and C<DESTROY>). They cause tied hashes to behave exactly like standard hashes,
63 |  |  |  |  | and allow for selective overwriting of methods. B<Tie::Hash> has legacy support for the
64 |  |  |  |  | C<new> method: it is used if C<TIEHASH> is not defined
65 |  |  |  |  | in the case a class forgets to include a C<TIEHASH> method.
66 |  |  |  |  |
67 |  |  |  |  | For developers wishing to write their own tied hashes, the required methods
68 |  |  |  |  | are briefly defined below. See the L<perltie> section for more detailed
69 |  |  |  |  | descriptive, as well as example code:
70 |  |  |  |  |
71 |  |  |  |  | =over 4
72 |  |  |  |  |
73 |  |  |  |  | =item TIEHASH classname, LIST
74 |  |  |  |  |
75 |  |  |  |  | The method invoked by the command C<tie %hash, classname>. Associates a new
76 |  |  |  |  | hash instance with the specified class. C<LIST> would represent additional
77 |  |  |  |  | arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
78 |  |  |  |  | complete the association.
79 |  |  |  |  |
80 |  |  |  |  | =item STORE this, key, value
81 |  |  |  |  |
82 |  |  |  |  | Store datum I<value> into I<key> for the tied hash I<this>.
83 |  |  |  |  |
84 |  |  |  |  | =item FETCH this, key
85 |  |  |  |  |
86 |  |  |  |  | Retrieve the datum in I<key> for the tied hash I<this>.
87 |  |  |  |  |
88 |  |  |  |  | =item FIRSTKEY this
89 |  |  |  |  |
90 |  |  |  |  | Return the first key in the hash.
91 |  |  |  |  |
92 |  |  |  |  | =item NEXTKEY this, lastkey
93 |  |  |  |  |
94 |  |  |  |  | Return the next key in the hash.
95 |  |  |  |  |
96 |  |  |  |  | =item EXISTS this, key
97 |  |  |  |  |
98 |  |  |  |  | Verify that I<key> exists with the tied hash I<this>.
99 |  |  |  |  |
100 |  |  |  |  | The B<Tie::Hash> implementation is a stub that simply croaks.
101 |  |  |  |  |
102 |  |  |  |  | =item DELETE this, key
103 |  |  |  |  |
104 |  |  |  |  | Delete the key I<key> from the tied hash I<this>.
105 |  |  |  |  |
106 |  |  |  |  | =item CLEAR this
107 |  |  |  |  |
108 |  |  |  |  | Clear all values from the tied hash I<this>.
109 |  |  |  |  |
110 |  |  |  |  | =item SCALAR this
111 |  |  |  |  |
112 |  |  |  |  | Returns what evaluating the hash in scalar context yields.
113 |  |  |  |  |
114 |  |  |  |  | B<Tie::Hash> does not implement this method (but B<Tie::StdHash>
115 |  |  |  |  | and B<Tie::ExtraHash> do).
116 |  |  |  |  |
117 |  |  |  |  | =back
118 |  |  |  |  |
119 |  |  |  |  | =head1 Inheriting from B<Tie::StdHash>
120 |  |  |  |  |
121 |  |  |  |  | The accessor methods assume that the actual storage for the data in the tied
122 |  |  |  |  | hash is in the hash referenced by C<tied(%tiedhash)>. Thus overwritten
123 |  |  |  |  | C<TIEHASH> method should return a hash reference, and the remaining methods
124 |  |  |  |  | should 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 |  |  |  |  |
142 |  |  |  |  | The accessor methods assume that the actual storage for the data in the tied
143 |  |  |  |  | hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thus overwritten
144 |  |  |  |  | C<TIEHASH> method should return an array reference with the first
145 |  |  |  |  | element being a hash reference, and the remaining methods should operate on the
146 |  |  |  |  | hash 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 |  |  |  |  |
162 |  |  |  |  | The default C<TIEHASH> method stores "extra" arguments to tie() starting
163 |  |  |  |  | from offset 1 in the array referenced by C<tied(%tiedhash)>; this is the
164 |  |  |  |  | same storage algorithm as in TIEHASH subroutine above. Hence, a typical
165 |  |  |  |  | package inheriting from B<Tie::ExtraHash> does not need to overwrite this
166 |  |  |  |  | method.
167 |  |  |  |  |
168 |  |  |  |  | =head1 C<SCALAR>, C<UNTIE> and C<DESTROY>
169 |  |  |  |  |
170 |  |  |  |  | The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>,
171 |  |  |  |  | B<Tie::StdHash>, or B<Tie::ExtraHash>. Tied hashes do not require
172 |  |  |  |  | presence of these methods, but if defined, the methods will be called in
173 |  |  |  |  | proper time, see L<perltie>.
174 |  |  |  |  |
175 |  |  |  |  | C<SCALAR> is only defined in B<Tie::StdHash> and B<Tie::ExtraHash>.
176 |  |  |  |  |
177 |  |  |  |  | If needed, these methods should be defined by the package inheriting from
178 |  |  |  |  | B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. See L<perltie/"SCALAR">
179 |  |  |  |  | to find out what happens when C<SCALAR> does not exist.
180 |  |  |  |  |
181 |  |  |  |  | =head1 MORE INFORMATION
182 |  |  |  |  |
183 |  |  |  |  | The packages relating to various DBM-related implementations (F<DB_File>,
184 |  |  |  |  | F<NDBM_File>, etc.) show examples of general tied hashes, as does the
185 |  |  |  |  | L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
186 |  |  |  |  | good working examples.
187 |  |  |  |  |
188 |  |  |  |  | =cut
189 |  |  |  |  |
190 | 2 | 90µs | 2 | 3.55ms | # spent 3.53ms (2.89+637µs) within Tie::Hash::BEGIN@190 which was called: # once (2.89ms+637µs) by Test2::Util::BEGIN@7 at line 190 use Carp; # spent 3.53ms making 1 call to Tie::Hash::BEGIN@190 # spent 24µs making 1 call to Exporter::import
191 | 2 | 466µs | 2 | 161µs | # spent 141µs (121+20) within Tie::Hash::BEGIN@191 which was called: # once (121µs+20µs) by Test2::Util::BEGIN@7 at line 191 use warnings::register; # spent 141µs making 1 call to Tie::Hash::BEGIN@191 # spent 20µs making 1 call to warnings::register::import
192 |  |  |  |  |
193 |  |  |  |  | sub new {
194 |  |  |  |  | my $pkg = shift;
195 |  |  |  |  | $pkg->TIEHASH(@_);
196 |  |  |  |  | }
197 |  |  |  |  |
198 |  |  |  |  | # Legacy support for new()
199 |  |  |  |  |
200 |  |  |  |  | sub 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 |  |  |  |  |
222 |  |  |  |  | sub EXISTS {
223 |  |  |  |  | my $pkg = ref $_[0];
224 |  |  |  |  | croak "$pkg doesn't define an EXISTS method";
225 |  |  |  |  | }
226 |  |  |  |  |
227 |  |  |  |  | sub 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 |  |  |  |  |
245 |  |  |  |  | package Tie::StdHash;
246 |  |  |  |  | # @ISA = qw(Tie::Hash); # would inherit new() only
247 |  |  |  |  |
248 | 1 | 4µs |  |  | # spent 2µs within Tie::StdHash::TIEHASH which was called: # once (2µs+0s) by Test2::Util::BEGIN@7 at line 564 of POSIX.pm sub TIEHASH { bless {}, $_[0] }
249 |  |  |  |  | sub STORE { $_[0]->{$_[1]} = $_[2] }
250 |  |  |  |  | sub FETCH { $_[0]->{$_[1]} }
251 |  |  |  |  | sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
252 |  |  |  |  | sub NEXTKEY { each %{$_[0]} }
253 |  |  |  |  | sub EXISTS { exists $_[0]->{$_[1]} }
254 |  |  |  |  | sub DELETE { delete $_[0]->{$_[1]} }
255 |  |  |  |  | sub CLEAR { %{$_[0]} = () }
256 |  |  |  |  | sub SCALAR { scalar %{$_[0]} }
257 |  |  |  |  |
258 |  |  |  |  | package Tie::ExtraHash;
259 |  |  |  |  |
260 |  |  |  |  | sub TIEHASH { my $p = shift; bless [{}, @_], $p }
261 |  |  |  |  | sub STORE { $_[0][0]{$_[1]} = $_[2] }
262 |  |  |  |  | sub FETCH { $_[0][0]{$_[1]} }
263 |  |  |  |  | sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
264 |  |  |  |  | sub NEXTKEY { each %{$_[0][0]} }
265 |  |  |  |  | sub EXISTS { exists $_[0][0]->{$_[1]} }
266 |  |  |  |  | sub DELETE { delete $_[0][0]->{$_[1]} }
267 |  |  |  |  | sub CLEAR { %{$_[0][0]} = () }
268 |  |  |  |  | sub SCALAR { scalar %{$_[0][0]} }
269 |  |  |  |  |
270 | 1 | 2µs |  |  | 1;