| File | /usr/share/perl/5.10/Tie/Hash.pm |
| Statements Executed | 9 |
| Total Time | 0.0009169 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::CLEAR |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::DELETE |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::EXISTS |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::FETCH |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::FIRSTKEY |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::NEXTKEY |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::SCALAR |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::STORE |
| 0 | 0 | 0 | 0s | 0s | Tie::ExtraHash::TIEHASH |
| 0 | 0 | 0 | 0s | 0s | Tie::Hash::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Tie::Hash::CLEAR |
| 0 | 0 | 0 | 0s | 0s | Tie::Hash::EXISTS |
| 0 | 0 | 0 | 0s | 0s | Tie::Hash::TIEHASH |
| 0 | 0 | 0 | 0s | 0s | Tie::Hash::new |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::CLEAR |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::DELETE |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::EXISTS |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::FETCH |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::FIRSTKEY |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::NEXTKEY |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::SCALAR |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::STORE |
| 0 | 0 | 0 | 0s | 0s | Tie::StdHash::TIEHASH |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package Tie::Hash; | |||
| 2 | ||||
| 3 | 1 | 800ns | 800ns | our $VERSION = '1.02'; |
| 4 | ||||
| 5 | 3 | 60µs | 20µs | use Carp; # spent 92µs making 1 call to Exporter::import |
| 6 | 3 | 842µs | 280µs | use warnings::register; # spent 118µ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 | 6µs | 6µs | sub TIEHASH { bless {}, $_[0] } |
| 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 | 8µs | 8µs | 1; |