← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:21 2010

File/opt/wise/lib/perl5/5.10.0/Tie/Hash.pm
Statements Executed9
Total Time0.000735 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
00000Tie::ExtraHash::CLEAR
00000Tie::ExtraHash::DELETE
00000Tie::ExtraHash::EXISTS
00000Tie::ExtraHash::FETCH
00000Tie::ExtraHash::FIRSTKEY
00000Tie::ExtraHash::NEXTKEY
00000Tie::ExtraHash::SCALAR
00000Tie::ExtraHash::STORE
00000Tie::ExtraHash::TIEHASH
00000Tie::Hash::BEGIN
00000Tie::Hash::CLEAR
00000Tie::Hash::EXISTS
00000Tie::Hash::TIEHASH
00000Tie::Hash::new
00000Tie::StdHash::CLEAR
00000Tie::StdHash::DELETE
00000Tie::StdHash::EXISTS
00000Tie::StdHash::FETCH
00000Tie::StdHash::FIRSTKEY
00000Tie::StdHash::NEXTKEY
00000Tie::StdHash::SCALAR
00000Tie::StdHash::STORE
00000Tie::StdHash::TIEHASH

LineStmts.Exclusive
Time		Avg.Code
1package Tie::Hash;
2
311.0e-61.0e-6our $VERSION = '1.02';
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 only those needing overrides
26 # Accessors access the storage in %{$_[0]};
27 # TIEHASH should return a reference to the actual storage
28 sub DELETE { ... }
29
30 package NewExtraHash;
31 require Tie::Hash;
32
33 @ISA = qw(Tie::ExtraHash);
34
35 # All methods provided by default, define only those needing overrides
36 # Accessors access the storage in %{$_[0][0]};
37 # TIEHASH should return an array reference with the first element being
38 # the reference to the actual storage
39 sub DELETE {
40 $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer
41 delete $_[0][0]->{$_[1]}; # $_[0]->SUPER::DELETE($_[1])
42 }
43
44
45 package main;
46
47 tie %new_hash, 'NewHash';
48 tie %new_std_hash, 'NewStdHash';
49 tie %new_extra_hash, 'NewExtraHash',
50 sub {warn "Doing \U$_[1]\E of $_[2].\n"};
51
52=head1 DESCRIPTION
53
54This module provides some skeletal methods for hash-tying classes. See
55L<perltie> for a list of the functions required in order to tie a hash
56to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
57as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> and
58B<Tie::ExtraHash> packages
59provide most methods for hashes described in L<perltie> (the exceptions
60are C<UNTIE> and C<DESTROY>). They cause tied hashes to behave exactly like standard hashes,
61and allow for selective overwriting of methods. B<Tie::Hash> grandfathers the
62C<new> method: it is used if C<TIEHASH> is not defined
63in the case a class forgets to include a C<TIEHASH> method.
64
65For developers wishing to write their own tied hashes, the required methods
66are briefly defined below. See the L<perltie> section for more detailed
67descriptive, as well as example code:
68
69=over 4
70
71=item TIEHASH classname, LIST
72
73The method invoked by the command C<tie %hash, classname>. Associates a new
74hash instance with the specified class. C<LIST> would represent additional
75arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
76complete the association.
77
78=item STORE this, key, value
79
80Store datum I<value> into I<key> for the tied hash I<this>.
81
82=item FETCH this, key
83
84Retrieve the datum in I<key> for the tied hash I<this>.
85
86=item FIRSTKEY this
87
88Return the first key in the hash.
89
90=item NEXTKEY this, lastkey
91
92Return the next key in the hash.
93
94=item EXISTS this, key
95
96Verify that I<key> exists with the tied hash I<this>.
97
98The B<Tie::Hash> implementation is a stub that simply croaks.
99
100=item DELETE this, key
101
102Delete the key I<key> from the tied hash I<this>.
103
104=item CLEAR this
105
106Clear all values from the tied hash I<this>.
107
108=item SCALAR this
109
110Returns what evaluating the hash in scalar context yields.
111
112B<Tie::Hash> does not implement this method (but B<Tie::StdHash>
113and B<Tie::ExtraHash> do).
114
115=back
116
117=head1 Inheriting from B<Tie::StdHash>
118
119The accessor methods assume that the actual storage for the data in the tied
120hash is in the hash referenced by C<tied(%tiedhash)>. Thus overwritten
121C<TIEHASH> method should return a hash reference, and the remaining methods
122should operate on the hash referenced by the first argument:
123
124 package ReportHash;
125 our @ISA = 'Tie::StdHash';
126
127 sub TIEHASH {
128 my $storage = bless {}, shift;
129 warn "New ReportHash created, stored in $storage.\n";
130 $storage
131 }
132 sub STORE {
133 warn "Storing data with key $_[1] at $_[0].\n";
134 $_[0]{$_[1]} = $_[2]
135 }
136
137
138=head1 Inheriting from B<Tie::ExtraHash>
139
140The accessor methods assume that the actual storage for the data in the tied
141hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thus overwritten
142C<TIEHASH> method should return an array reference with the first
143element being a hash reference, and the remaining methods should operate on the
144hash C<< %{ $_[0]->[0] } >>:
145
146 package ReportHash;
147 our @ISA = 'Tie::ExtraHash';
148
149 sub TIEHASH {
150 my $class = shift;
151 my $storage = bless [{}, @_], $class;
152 warn "New ReportHash created, stored in $storage.\n";
153 $storage;
154 }
155 sub STORE {
156 warn "Storing data with key $_[1] at $_[0].\n";
157 $_[0][0]{$_[1]} = $_[2]
158 }
159
160The default C<TIEHASH> method stores "extra" arguments to tie() starting
161from offset 1 in the array referenced by C<tied(%tiedhash)>; this is the
162same storage algorithm as in TIEHASH subroutine above. Hence, a typical
163package inheriting from B<Tie::ExtraHash> does not need to overwrite this
164method.
165
166=head1 C<SCALAR>, C<UNTIE> and C<DESTROY>
167
168The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>,
169B<Tie::StdHash>, or B<Tie::ExtraHash>. Tied hashes do not require
170presence of these methods, but if defined, the methods will be called in
171proper time, see L<perltie>.
172
173C<SCALAR> is only defined in B<Tie::StdHash> and B<Tie::ExtraHash>.
174
175If needed, these methods should be defined by the package inheriting from
176B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. See L<pertie/"SCALAR">
177to find out what happens when C<SCALAR> does not exist.
178
179=head1 MORE INFORMATION
180
181The packages relating to various DBM-related implementations (F<DB_File>,
182F<NDBM_File>, etc.) show examples of general tied hashes, as does the
183L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
184good working examples.
185
186=cut
187
18833.0e-51.0e-5use Carp;
# spent 53µs making 1 call to Exporter::import
18930.000690.00023use warnings::register;
# spent 120µs making 1 call to warnings::register::import
190
191sub new {
192 my $pkg = shift;
193 $pkg->TIEHASH(@_);
194}
195
196# Grandfather "new"
197
198sub TIEHASH {
199 my $pkg = shift;
200 if (defined &{"${pkg}::new"}) {
201 warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing");
202 $pkg->new(@_);
203 }
204 else {
205 croak "$pkg doesn't define a TIEHASH method";
206 }
207}
208
209sub EXISTS {
210 my $pkg = ref $_[0];
211 croak "$pkg doesn't define an EXISTS method";
212}
213
214sub CLEAR {
215 my $self = shift;
216 my $key = $self->FIRSTKEY(@_);
217 my @keys;
218
219 while (defined $key) {
220 push @keys, $key;
221 $key = $self->NEXTKEY(@_, $key);
222 }
223 foreach $key (@keys) {
224 $self->DELETE(@_, $key);
225 }
226}
227
228# The Tie::StdHash package implements standard perl hash behaviour.
229# It exists to act as a base class for classes which only wish to
230# alter some parts of their behaviour.
231
232package Tie::StdHash;
233# @ISA = qw(Tie::Hash); # would inherit new() only
234
23511.1e-51.1e-5sub TIEHASH { bless {}, $_[0] }
236sub STORE { $_[0]->{$_[1]} = $_[2] }
237sub FETCH { $_[0]->{$_[1]} }
238sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
239sub NEXTKEY { each %{$_[0]} }
240sub EXISTS { exists $_[0]->{$_[1]} }
241sub DELETE { delete $_[0]->{$_[1]} }
242sub CLEAR { %{$_[0]} = () }
243sub SCALAR { scalar %{$_[0]} }
244
245package Tie::ExtraHash;
246
247sub TIEHASH { my $p = shift; bless [{}, @_], $p }
248sub STORE { $_[0][0]{$_[1]} = $_[2] }
249sub FETCH { $_[0][0]{$_[1]} }
250sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
251sub NEXTKEY { each %{$_[0][0]} }
252sub EXISTS { exists $_[0][0]->{$_[1]} }
253sub DELETE { delete $_[0][0]->{$_[1]} }
254sub CLEAR { %{$_[0][0]} = () }
255sub SCALAR { scalar %{$_[0][0]} }
256
25714.0e-64.0e-61;

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.