← Index
NYTProf Performance Profile   « block view • line view • sub view »
For C:/lo/libo-master/solenv/bin/make_installer.pl
  Run on Mon Sep 24 00:52:54 2012
Reported on Mon Sep 24 07:34:41 2012

Filename/usr/lib/perl5/5.14/Tie/Hash.pm
StatementsExecuted 7 statements in 1.25ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111197µs277µsTie::Hash::::BEGIN@188 Tie::Hash::BEGIN@188
11117µs234µsTie::Hash::::BEGIN@189 Tie::Hash::BEGIN@189
1119µs9µ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
311µsour $VERSION = '1.04';
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<perltie/"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
188263µs2356µs
# spent 277µs (197+80) within Tie::Hash::BEGIN@188 which was called: # once (197µs+80µs) by POSIX::SigRt::BEGIN@58 at line 188
use Carp;
# spent 277µs making 1 call to Tie::Hash::BEGIN@188 # spent 80µs making 1 call to Exporter::import
18921.17ms2451µs
# spent 234µs (17+217) within Tie::Hash::BEGIN@189 which was called: # once (17µs+217µs) by POSIX::SigRt::BEGIN@58 at line 189
use warnings::register;
# spent 234µs making 1 call to Tie::Hash::BEGIN@189 # spent 217µ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 my $pkg_new = $pkg -> can ('new');
201
202 if ($pkg_new and $pkg ne __PACKAGE__) {
203 my $my_new = __PACKAGE__ -> can ('new');
204 if ($pkg_new == $my_new) {
205 #
206 # Prevent recursion
207 #
208 croak "$pkg must define either a TIEHASH() or a new() method";
209 }
210
211 warnings::warnif ("WARNING: calling ${pkg}->new since " .
212 "${pkg}->TIEHASH is missing");
213 $pkg -> new (@_);
214 }
215 else {
216 croak "$pkg doesn't define a TIEHASH method";
217 }
218}
219
220sub EXISTS {
221 my $pkg = ref $_[0];
222 croak "$pkg doesn't define an EXISTS method";
223}
224
225sub CLEAR {
226 my $self = shift;
227 my $key = $self->FIRSTKEY(@_);
228 my @keys;
229
230 while (defined $key) {
231 push @keys, $key;
232 $key = $self->NEXTKEY(@_, $key);
233 }
234 foreach $key (@keys) {
235 $self->DELETE(@_, $key);
236 }
237}
238
239# The Tie::StdHash package implements standard perl hash behaviour.
240# It exists to act as a base class for classes which only wish to
241# alter some parts of their behaviour.
242
243package Tie::StdHash;
244# @ISA = qw(Tie::Hash); # would inherit new() only
245
246112µs
# spent 9µs within Tie::StdHash::TIEHASH which was called: # once (9µs+0s) by installer::epmfile::BEGIN@42 at line 65 of POSIX.pm
sub TIEHASH { bless {}, $_[0] }
247sub STORE { $_[0]->{$_[1]} = $_[2] }
248sub FETCH { $_[0]->{$_[1]} }
249sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
250sub NEXTKEY { each %{$_[0]} }
251sub EXISTS { exists $_[0]->{$_[1]} }
252sub DELETE { delete $_[0]->{$_[1]} }
253sub CLEAR { %{$_[0]} = () }
254sub SCALAR { scalar %{$_[0]} }
255
256package Tie::ExtraHash;
257
258sub TIEHASH { my $p = shift; bless [{}, @_], $p }
259sub STORE { $_[0][0]{$_[1]} = $_[2] }
260sub FETCH { $_[0][0]{$_[1]} }
261sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
262sub NEXTKEY { each %{$_[0][0]} }
263sub EXISTS { exists $_[0][0]->{$_[1]} }
264sub DELETE { delete $_[0][0]->{$_[1]} }
265sub CLEAR { %{$_[0][0]} = () }
266sub SCALAR { scalar %{$_[0][0]} }
267
26819µs1;