Filename | /usr/share/perl/5.10/Tie/Hash.pm |
Statements | Executed 9 statements in 1.23ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 30µs | 131µs | BEGIN@5 | Tie::Hash::
1 | 1 | 1 | 17µs | 182µs | BEGIN@6 | Tie::Hash::
1 | 1 | 1 | 10µs | 10µs | TIEHASH | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | CLEAR | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | DELETE | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | EXISTS | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | FETCH | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | FIRSTKEY | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | NEXTKEY | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | SCALAR | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | STORE | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | TIEHASH | Tie::ExtraHash::
0 | 0 | 0 | 0s | 0s | CLEAR | Tie::Hash::
0 | 0 | 0 | 0s | 0s | EXISTS | Tie::Hash::
0 | 0 | 0 | 0s | 0s | TIEHASH | Tie::Hash::
0 | 0 | 0 | 0s | 0s | new | Tie::Hash::
0 | 0 | 0 | 0s | 0s | CLEAR | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | DELETE | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | EXISTS | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | FETCH | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | FIRSTKEY | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | NEXTKEY | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | SCALAR | Tie::StdHash::
0 | 0 | 0 | 0s | 0s | STORE | Tie::StdHash::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Tie::Hash; | ||||
2 | |||||
3 | 1 | 2µs | our $VERSION = '1.03'; | ||
4 | |||||
5 | 3 | 55µs | 2 | 232µs | # spent 131µs (30+101) within Tie::Hash::BEGIN@5 which was called:
# once (30µs+101µs) by POSIX::SigRt::BEGIN@64 at line 5 # spent 131µs making 1 call to Tie::Hash::BEGIN@5
# spent 101µs making 1 call to Exporter::import |
6 | 3 | 1.15ms | 2 | 347µs | # spent 182µs (17+165) within Tie::Hash::BEGIN@6 which was called:
# once (17µs+165µs) by POSIX::SigRt::BEGIN@64 at line 6 # spent 182µs making 1 call to Tie::Hash::BEGIN@6
# spent 165µs making 1 call to warnings::register::import |
7 | |||||
8 | sub new { | ||||
9 | my $pkg = shift; | ||||
10 | $pkg->TIEHASH(@_); | ||||
11 | } | ||||
12 | |||||
13 | # Grandfather "new" | ||||
14 | |||||
15 | sub TIEHASH { | ||||
16 | my $pkg = shift; | ||||
17 | if (defined &{"${pkg}::new"}) { | ||||
18 | warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"); | ||||
19 | $pkg->new(@_); | ||||
20 | } | ||||
21 | else { | ||||
22 | croak "$pkg doesn't define a TIEHASH method"; | ||||
23 | } | ||||
24 | } | ||||
25 | |||||
26 | sub EXISTS { | ||||
27 | my $pkg = ref $_[0]; | ||||
28 | croak "$pkg doesn't define an EXISTS method"; | ||||
29 | } | ||||
30 | |||||
31 | sub CLEAR { | ||||
32 | my $self = shift; | ||||
33 | my $key = $self->FIRSTKEY(@_); | ||||
34 | my @keys; | ||||
35 | |||||
36 | while (defined $key) { | ||||
37 | push @keys, $key; | ||||
38 | $key = $self->NEXTKEY(@_, $key); | ||||
39 | } | ||||
40 | foreach $key (@keys) { | ||||
41 | $self->DELETE(@_, $key); | ||||
42 | } | ||||
43 | } | ||||
44 | |||||
45 | # The Tie::StdHash package implements standard perl hash behaviour. | ||||
46 | # It exists to act as a base class for classes which only wish to | ||||
47 | # alter some parts of their behaviour. | ||||
48 | |||||
49 | package Tie::StdHash; | ||||
50 | # @ISA = qw(Tie::Hash); # would inherit new() only | ||||
51 | |||||
52 | 1 | 13µs | # spent 10µs within Tie::StdHash::TIEHASH which was called:
# once (10µs+0s) by C4::Context::BEGIN@106 at line 71 of POSIX.pm | ||
53 | sub STORE { $_[0]->{$_[1]} = $_[2] } | ||||
54 | sub FETCH { $_[0]->{$_[1]} } | ||||
55 | sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } | ||||
56 | sub NEXTKEY { each %{$_[0]} } | ||||
57 | sub EXISTS { exists $_[0]->{$_[1]} } | ||||
58 | sub DELETE { delete $_[0]->{$_[1]} } | ||||
59 | sub CLEAR { %{$_[0]} = () } | ||||
60 | sub SCALAR { scalar %{$_[0]} } | ||||
61 | |||||
62 | package Tie::ExtraHash; | ||||
63 | |||||
64 | sub TIEHASH { my $p = shift; bless [{}, @_], $p } | ||||
65 | sub STORE { $_[0][0]{$_[1]} = $_[2] } | ||||
66 | sub FETCH { $_[0][0]{$_[1]} } | ||||
67 | sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } | ||||
68 | sub NEXTKEY { each %{$_[0][0]} } | ||||
69 | sub EXISTS { exists $_[0][0]->{$_[1]} } | ||||
70 | sub DELETE { delete $_[0][0]->{$_[1]} } | ||||
71 | sub CLEAR { %{$_[0][0]} = () } | ||||
72 | sub SCALAR { scalar %{$_[0][0]} } | ||||
73 | |||||
74 | 1 | 6µs | 1; |