Filename | /usr/local/lib/perl5/5.24/mach/DB_File.pm |
Statements | Executed 4819 statements in 91.2ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
23307361 | 8 | 2 | 214s | 214s | FETCH (xsub) | DB_File::
23298310 | 1 | 1 | 158s | 158s | NEXTKEY (xsub) | DB_File::
473 | 3 | 2 | 5.88s | 5.88s | DESTROY (xsub) | DB_File::
5798 | 4 | 2 | 80.2ms | 80.2ms | STORE (xsub) | DB_File::
438 | 1 | 1 | 37.4ms | 37.4ms | FIRSTKEY (xsub) | DB_File::
473 | 1 | 1 | 34.3ms | 89.8ms | tie_hash_or_array | DB_File::
473 | 1 | 1 | 25.3ms | 25.3ms | DoTie_ (xsub) | DB_File::
880 | 3 | 1 | 15.2ms | 15.2ms | DELETE (xsub) | DB_File::
473 | 3 | 2 | 7.61ms | 97.4ms | TIEHASH | DB_File::
543 | 4 | 1 | 2.91ms | 2.92ms | CORE:match (opcode) | DB_File::
3 | 3 | 1 | 66µs | 179µs | new | DB_File::HASHINFO::
1 | 1 | 1 | 65µs | 65µs | TIEHASH | DB_File::RECNOINFO::
1 | 1 | 1 | 49µs | 79µs | BEGIN@14 | DB_File::HASHINFO::
1 | 1 | 1 | 32µs | 52µs | BEGIN@159 | DB_File::
1 | 1 | 1 | 32µs | 66µs | BEGIN@115 | DB_File::RECNOINFO::
1 | 1 | 1 | 30µs | 30µs | BEGIN@189 | DB_File::
1 | 1 | 1 | 29µs | 36µs | BEGIN@116 | DB_File::RECNOINFO::
1 | 1 | 1 | 28µs | 36µs | BEGIN@15 | DB_File::HASHINFO::
1 | 1 | 1 | 28µs | 34µs | BEGIN@134 | DB_File::BTREEINFO::
1 | 1 | 1 | 27µs | 34µs | BEGIN@160 | DB_File::
1 | 1 | 1 | 27µs | 27µs | TIEHASH | DB_File::HASHINFO::
1 | 1 | 1 | 25µs | 54µs | BEGIN@133 | DB_File::BTREEINFO::
1 | 1 | 1 | 24µs | 248µs | BEGIN@16 | DB_File::HASHINFO::
1 | 1 | 1 | 21µs | 74µs | BEGIN@240 | DB_File::
1 | 1 | 1 | 20µs | 20µs | TIEHASH | DB_File::BTREEINFO::
1 | 1 | 1 | 20µs | 189µs | BEGIN@163 | DB_File::
1 | 1 | 1 | 19µs | 19µs | BEGIN@264 | DB_File::
1 | 1 | 1 | 10µs | 10µs | __ANON__[:176] | DB_File::
1 | 1 | 1 | 9µs | 9µs | __ANON__[:170] | DB_File::
0 | 0 | 0 | 0s | 0s | AUTOLOAD | DB_File::
0 | 0 | 0 | 0s | 0s | CLEAR | DB_File::
0 | 0 | 0 | 0s | 0s | EXTEND | DB_File::
0 | 0 | 0 | 0s | 0s | CLEAR | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | DELETE | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | EXISTS | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | FETCH | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | FIRSTKEY | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | NEXTKEY | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | NotHere | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | STORE | DB_File::HASHINFO::
0 | 0 | 0 | 0s | 0s | SPLICE | DB_File::
0 | 0 | 0 | 0s | 0s | STORABLE_freeze | DB_File::
0 | 0 | 0 | 0s | 0s | STORABLE_thaw | DB_File::
0 | 0 | 0 | 0s | 0s | STORESIZE | DB_File::
0 | 0 | 0 | 0s | 0s | TIEARRAY | DB_File::
0 | 0 | 0 | 0s | 0s | __ANON__[:241] | DB_File::
0 | 0 | 0 | 0s | 0s | del_dup | DB_File::
0 | 0 | 0 | 0s | 0s | find_dup | DB_File::
0 | 0 | 0 | 0s | 0s | get_dup | DB_File::
0 | 0 | 0 | 0s | 0s | splice | DB_File::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # DB_File.pm -- Perl 5 interface to Berkeley DB | ||||
2 | # | ||||
3 | # Written by Paul Marquess (pmqs@cpan.org) | ||||
4 | # | ||||
5 | # Copyright (c) 1995-2014 Paul Marquess. All rights reserved. | ||||
6 | # This program is free software; you can redistribute it and/or | ||||
7 | # modify it under the same terms as Perl itself. | ||||
8 | |||||
9 | |||||
10 | package DB_File::HASHINFO ; | ||||
11 | |||||
12 | 1 | 31µs | require 5.008003; | ||
13 | |||||
14 | 2 | 66µs | 2 | 109µs | # spent 79µs (49+30) within DB_File::HASHINFO::BEGIN@14 which was called:
# once (49µs+30µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 14 # spent 79µs making 1 call to DB_File::HASHINFO::BEGIN@14
# spent 30µs making 1 call to warnings::import |
15 | 2 | 64µs | 2 | 44µs | # spent 36µs (28+8) within DB_File::HASHINFO::BEGIN@15 which was called:
# once (28µs+8µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 15 # spent 36µs making 1 call to DB_File::HASHINFO::BEGIN@15
# spent 8µs making 1 call to strict::import |
16 | 2 | 968µs | 2 | 471µs | # spent 248µs (24+224) within DB_File::HASHINFO::BEGIN@16 which was called:
# once (24µs+224µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 16 # spent 248µs making 1 call to DB_File::HASHINFO::BEGIN@16
# spent 224µs making 1 call to Exporter::import |
17 | 1 | 2µs | require Tie::Hash; | ||
18 | 1 | 20µs | @DB_File::HASHINFO::ISA = qw(Tie::Hash); | ||
19 | |||||
20 | sub new | ||||
21 | # spent 179µs (66+113) within DB_File::HASHINFO::new which was called 3 times, avg 60µs/call:
# once (19µs+65µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 185
# once (28µs+20µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 183
# once (19µs+27µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 184 | ||||
22 | 3 | 6µs | my $pkg = shift ; | ||
23 | 3 | 8µs | my %x ; | ||
24 | 3 | 35µs | 3 | 113µs | tie %x, $pkg ; # spent 65µs making 1 call to DB_File::RECNOINFO::TIEHASH
# spent 27µs making 1 call to DB_File::HASHINFO::TIEHASH
# spent 20µs making 1 call to DB_File::BTREEINFO::TIEHASH |
25 | 3 | 25µs | bless \%x, $pkg ; | ||
26 | } | ||||
27 | |||||
28 | |||||
29 | sub TIEHASH | ||||
30 | # spent 27µs within DB_File::HASHINFO::TIEHASH which was called:
# once (27µs+0s) by DB_File::HASHINFO::new at line 24 | ||||
31 | 1 | 2µs | my $pkg = shift ; | ||
32 | |||||
33 | 1 | 19µs | bless { VALID => { | ||
34 | bsize => 1, | ||||
35 | ffactor => 1, | ||||
36 | nelem => 1, | ||||
37 | cachesize => 1, | ||||
38 | hash => 2, | ||||
39 | lorder => 1, | ||||
40 | }, | ||||
41 | GOT => {} | ||||
42 | }, $pkg ; | ||||
43 | } | ||||
44 | |||||
45 | |||||
46 | sub FETCH | ||||
47 | { | ||||
48 | my $self = shift ; | ||||
49 | my $key = shift ; | ||||
50 | |||||
51 | return $self->{GOT}{$key} if exists $self->{VALID}{$key} ; | ||||
52 | |||||
53 | my $pkg = ref $self ; | ||||
54 | croak "${pkg}::FETCH - Unknown element '$key'" ; | ||||
55 | } | ||||
56 | |||||
57 | |||||
58 | sub STORE | ||||
59 | { | ||||
60 | my $self = shift ; | ||||
61 | my $key = shift ; | ||||
62 | my $value = shift ; | ||||
63 | |||||
64 | my $type = $self->{VALID}{$key}; | ||||
65 | |||||
66 | if ( $type ) | ||||
67 | { | ||||
68 | croak "Key '$key' not associated with a code reference" | ||||
69 | if $type == 2 && !ref $value && ref $value ne 'CODE'; | ||||
70 | $self->{GOT}{$key} = $value ; | ||||
71 | return ; | ||||
72 | } | ||||
73 | |||||
74 | my $pkg = ref $self ; | ||||
75 | croak "${pkg}::STORE - Unknown element '$key'" ; | ||||
76 | } | ||||
77 | |||||
78 | sub DELETE | ||||
79 | { | ||||
80 | my $self = shift ; | ||||
81 | my $key = shift ; | ||||
82 | |||||
83 | if ( exists $self->{VALID}{$key} ) | ||||
84 | { | ||||
85 | delete $self->{GOT}{$key} ; | ||||
86 | return ; | ||||
87 | } | ||||
88 | |||||
89 | my $pkg = ref $self ; | ||||
90 | croak "DB_File::HASHINFO::DELETE - Unknown element '$key'" ; | ||||
91 | } | ||||
92 | |||||
93 | sub EXISTS | ||||
94 | { | ||||
95 | my $self = shift ; | ||||
96 | my $key = shift ; | ||||
97 | |||||
98 | exists $self->{VALID}{$key} ; | ||||
99 | } | ||||
100 | |||||
101 | sub NotHere | ||||
102 | { | ||||
103 | my $self = shift ; | ||||
104 | my $method = shift ; | ||||
105 | |||||
106 | croak ref($self) . " does not define the method ${method}" ; | ||||
107 | } | ||||
108 | |||||
109 | sub FIRSTKEY { my $self = shift ; $self->NotHere("FIRSTKEY") } | ||||
110 | sub NEXTKEY { my $self = shift ; $self->NotHere("NEXTKEY") } | ||||
111 | sub CLEAR { my $self = shift ; $self->NotHere("CLEAR") } | ||||
112 | |||||
113 | package DB_File::RECNOINFO ; | ||||
114 | |||||
115 | 2 | 70µs | 2 | 99µs | # spent 66µs (32+34) within DB_File::RECNOINFO::BEGIN@115 which was called:
# once (32µs+34µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 115 # spent 66µs making 1 call to DB_File::RECNOINFO::BEGIN@115
# spent 34µs making 1 call to warnings::import |
116 | 2 | 184µs | 2 | 44µs | # spent 36µs (29+8) within DB_File::RECNOINFO::BEGIN@116 which was called:
# once (29µs+8µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 116 # spent 36µs making 1 call to DB_File::RECNOINFO::BEGIN@116
# spent 8µs making 1 call to strict::import |
117 | |||||
118 | 1 | 13µs | @DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ; | ||
119 | |||||
120 | sub TIEHASH | ||||
121 | # spent 65µs within DB_File::RECNOINFO::TIEHASH which was called:
# once (65µs+0s) by DB_File::HASHINFO::new at line 24 | ||||
122 | 1 | 2µs | my $pkg = shift ; | ||
123 | |||||
124 | 8 | 67µs | bless { VALID => { map {$_, 1} | ||
125 | qw( bval cachesize psize flags lorder reclen bfname ) | ||||
126 | }, | ||||
127 | GOT => {}, | ||||
128 | }, $pkg ; | ||||
129 | } | ||||
130 | |||||
131 | package DB_File::BTREEINFO ; | ||||
132 | |||||
133 | 2 | 59µs | 2 | 84µs | # spent 54µs (25+29) within DB_File::BTREEINFO::BEGIN@133 which was called:
# once (25µs+29µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 133 # spent 54µs making 1 call to DB_File::BTREEINFO::BEGIN@133
# spent 29µs making 1 call to warnings::import |
134 | 2 | 219µs | 2 | 40µs | # spent 34µs (28+6) within DB_File::BTREEINFO::BEGIN@134 which was called:
# once (28µs+6µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 134 # spent 34µs making 1 call to DB_File::BTREEINFO::BEGIN@134
# spent 6µs making 1 call to strict::import |
135 | |||||
136 | 1 | 6µs | @DB_File::BTREEINFO::ISA = qw(DB_File::HASHINFO) ; | ||
137 | |||||
138 | sub TIEHASH | ||||
139 | # spent 20µs within DB_File::BTREEINFO::TIEHASH which was called:
# once (20µs+0s) by DB_File::HASHINFO::new at line 24 | ||||
140 | 1 | 4µs | my $pkg = shift ; | ||
141 | |||||
142 | 1 | 20µs | bless { VALID => { | ||
143 | flags => 1, | ||||
144 | cachesize => 1, | ||||
145 | maxkeypage => 1, | ||||
146 | minkeypage => 1, | ||||
147 | psize => 1, | ||||
148 | compare => 2, | ||||
149 | prefix => 2, | ||||
150 | lorder => 1, | ||||
151 | }, | ||||
152 | GOT => {}, | ||||
153 | }, $pkg ; | ||||
154 | } | ||||
155 | |||||
156 | |||||
157 | package DB_File ; | ||||
158 | |||||
159 | 2 | 63µs | 2 | 71µs | # spent 52µs (32+19) within DB_File::BEGIN@159 which was called:
# once (32µs+19µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 159 # spent 52µs making 1 call to DB_File::BEGIN@159
# spent 19µs making 1 call to warnings::import |
160 | 2 | 222µs | 2 | 41µs | # spent 34µs (27+7) within DB_File::BEGIN@160 which was called:
# once (27µs+7µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 160 # spent 34µs making 1 call to DB_File::BEGIN@160
# spent 7µs making 1 call to strict::import |
161 | our ($VERSION, @ISA, @EXPORT, $AUTOLOAD, $DB_BTREE, $DB_HASH, $DB_RECNO); | ||||
162 | our ($db_version, $use_XSLoader, $splice_end_array_no_length, $splice_end_array, $Error); | ||||
163 | 2 | 504µs | 2 | 359µs | # spent 189µs (20+170) within DB_File::BEGIN@163 which was called:
# once (20µs+170µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 163 # spent 189µs making 1 call to DB_File::BEGIN@163
# spent 170µs making 1 call to Exporter::import |
164 | |||||
165 | |||||
166 | 1 | 2µs | $VERSION = "1.835" ; | ||
167 | 1 | 33µs | $VERSION = eval $VERSION; # needed for dev releases # spent 11µs executing statements in string eval | ||
168 | |||||
169 | { | ||||
170 | 2 | 29µs | # spent 9µs within DB_File::__ANON__[/usr/local/lib/perl5/5.24/mach/DB_File.pm:170] which was called:
# once (9µs+0s) by DB_File::CORE:match at line 172 | ||
171 | 2 | 11µs | my @a =(1); splice(@a, 3); | ||
172 | 1 | 61µs | 2 | 67µs | $splice_end_array_no_length = # spent 58µs making 1 call to DB_File::CORE:match
# spent 9µs making 1 call to DB_File::__ANON__[DB_File.pm:170] |
173 | ($splice_end_array_no_length =~ /^splice\(\) offset past end of array at /); | ||||
174 | } | ||||
175 | { | ||||
176 | 4 | 31µs | # spent 10µs within DB_File::__ANON__[/usr/local/lib/perl5/5.24/mach/DB_File.pm:176] which was called:
# once (10µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 177 | ||
177 | 2 | 26µs | 1 | 10µs | my @a =(1); splice(@a, 3, 1); # spent 10µs making 1 call to DB_File::__ANON__[DB_File.pm:176] |
178 | 1 | 19µs | 1 | 6µs | $splice_end_array = # spent 6µs making 1 call to DB_File::CORE:match |
179 | ($splice_end_array =~ /^splice\(\) offset past end of array at /); | ||||
180 | } | ||||
181 | |||||
182 | #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; | ||||
183 | 1 | 23µs | 1 | 48µs | $DB_BTREE = new DB_File::BTREEINFO ; # spent 48µs making 1 call to DB_File::HASHINFO::new |
184 | 1 | 6µs | 1 | 47µs | $DB_HASH = new DB_File::HASHINFO ; # spent 47µs making 1 call to DB_File::HASHINFO::new |
185 | 1 | 13µs | 1 | 84µs | $DB_RECNO = new DB_File::RECNOINFO ; # spent 84µs making 1 call to DB_File::HASHINFO::new |
186 | |||||
187 | 1 | 2µs | require Tie::Hash; | ||
188 | 1 | 9µs | require Exporter; | ||
189 | # spent 30µs within DB_File::BEGIN@189 which was called:
# once (30µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 198 | ||||
190 | 1 | 2µs | $use_XSLoader = 1 ; | ||
191 | 4 | 19µs | { local $SIG{__DIE__} ; eval { require XSLoader } ; } | ||
192 | |||||
193 | 1 | 13µs | if ($@) { | ||
194 | $use_XSLoader = 0 ; | ||||
195 | require DynaLoader; | ||||
196 | @ISA = qw(DynaLoader); | ||||
197 | } | ||||
198 | 1 | 244µs | 1 | 30µs | } # spent 30µs making 1 call to DB_File::BEGIN@189 |
199 | |||||
200 | 1 | 10µs | push @ISA, qw(Tie::Hash Exporter); | ||
201 | 1 | 7µs | @EXPORT = qw( | ||
202 | $DB_BTREE $DB_HASH $DB_RECNO | ||||
203 | |||||
204 | BTREEMAGIC | ||||
205 | BTREEVERSION | ||||
206 | DB_LOCK | ||||
207 | DB_SHMEM | ||||
208 | DB_TXN | ||||
209 | HASHMAGIC | ||||
210 | HASHVERSION | ||||
211 | MAX_PAGE_NUMBER | ||||
212 | MAX_PAGE_OFFSET | ||||
213 | MAX_REC_NUMBER | ||||
214 | RET_ERROR | ||||
215 | RET_SPECIAL | ||||
216 | RET_SUCCESS | ||||
217 | R_CURSOR | ||||
218 | R_DUP | ||||
219 | R_FIRST | ||||
220 | R_FIXEDLEN | ||||
221 | R_IAFTER | ||||
222 | R_IBEFORE | ||||
223 | R_LAST | ||||
224 | R_NEXT | ||||
225 | R_NOKEY | ||||
226 | R_NOOVERWRITE | ||||
227 | R_PREV | ||||
228 | R_RECNOSYNC | ||||
229 | R_SETCURSOR | ||||
230 | R_SNAPSHOT | ||||
231 | __R_UNUSED | ||||
232 | |||||
233 | ); | ||||
234 | |||||
235 | sub AUTOLOAD { | ||||
236 | my($constname); | ||||
237 | ($constname = $AUTOLOAD) =~ s/.*:://; | ||||
238 | my ($error, $val) = constant($constname); | ||||
239 | Carp::croak $error if $error; | ||||
240 | 2 | 370µs | 2 | 127µs | # spent 74µs (21+53) within DB_File::BEGIN@240 which was called:
# once (21µs+53µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 240 # spent 74µs making 1 call to DB_File::BEGIN@240
# spent 53µs making 1 call to strict::unimport |
241 | *{$AUTOLOAD} = sub { $val }; | ||||
242 | goto &{$AUTOLOAD}; | ||||
243 | } | ||||
244 | |||||
245 | |||||
246 | 1 | 4µs | eval { | ||
247 | # Make all Fcntl O_XXX constants available for importing | ||||
248 | 1 | 2µs | require Fcntl; | ||
249 | 1 | 517µs | 68 | 135µs | my @O = grep /^O_/, @Fcntl::EXPORT; # spent 135µs making 68 calls to DB_File::CORE:match, avg 2µs/call |
250 | 1 | 9µs | 1 | 952µs | Fcntl->import(@O); # first we import what we want to export # spent 952µs making 1 call to Exporter::import |
251 | 1 | 16µs | push(@EXPORT, @O); | ||
252 | }; | ||||
253 | |||||
254 | 1 | 7µs | if ($use_XSLoader) | ||
255 | 1 | 488µs | 1 | 466µs | { XSLoader::load("DB_File", $VERSION)} # spent 466µs making 1 call to XSLoader::load |
256 | else | ||||
257 | { bootstrap DB_File $VERSION } | ||||
258 | |||||
259 | sub tie_hash_or_array | ||||
260 | # spent 89.8ms (34.3+55.5) within DB_File::tie_hash_or_array which was called 473 times, avg 190µs/call:
# 473 times (34.3ms+55.5ms) by DB_File::TIEHASH at line 292, avg 190µs/call | ||||
261 | 473 | 2.04ms | my (@arg) = @_ ; | ||
262 | 473 | 13.8ms | 473 | 2.72ms | my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ; # spent 2.72ms making 473 calls to DB_File::CORE:match, avg 6µs/call |
263 | |||||
264 | 2 | 3.11ms | 1 | 19µs | # spent 19µs within DB_File::BEGIN@264 which was called:
# once (19µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 264 # spent 19µs making 1 call to DB_File::BEGIN@264 |
265 | 473 | 5.73ms | 473 | 27.5ms | $arg[1] = File::Spec->rel2abs($arg[1]) # spent 27.5ms making 473 calls to File::Spec::Unix::rel2abs, avg 58µs/call |
266 | if defined $arg[1] ; | ||||
267 | |||||
268 | $arg[4] = tied %{ $arg[4] } | ||||
269 | 473 | 1.17ms | if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ; | ||
270 | |||||
271 | 473 | 1.23ms | $arg[2] = O_CREAT()|O_RDWR() if @arg >=3 && ! defined $arg[2]; | ||
272 | 473 | 1.17ms | $arg[3] = 0666 if @arg >=4 && ! defined $arg[3]; | ||
273 | |||||
274 | # make recno in Berkeley DB version 2 (or better) work like | ||||
275 | # recno in version 1. | ||||
276 | 473 | 1.09ms | if ($db_version >= 4 and ! $tieHASH) { | ||
277 | $arg[2] |= O_CREAT(); | ||||
278 | } | ||||
279 | |||||
280 | 473 | 973µs | if ($db_version > 1 and defined $arg[4] and $arg[4] =~ /RECNO/ and | ||
281 | $arg[1] and ! -e $arg[1]) { | ||||
282 | open(FH, ">$arg[1]") or return undef ; | ||||
283 | close FH ; | ||||
284 | chmod $arg[3] ? $arg[3] : 0666 , $arg[1] ; | ||||
285 | } | ||||
286 | |||||
287 | 473 | 33.8ms | 473 | 25.3ms | DoTie_($tieHASH, @arg) ; # spent 25.3ms making 473 calls to DB_File::DoTie_, avg 54µs/call |
288 | } | ||||
289 | |||||
290 | sub TIEHASH | ||||
291 | # spent 97.4ms (7.61+89.8) within DB_File::TIEHASH which was called 473 times, avg 206µs/call:
# 468 times (7.53ms+88.8ms) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 182 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 206µs/call
# 4 times (57µs+865µs) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 301 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 230µs/call
# once (19µs+223µs) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 88 of Mail/SpamAssassin/DBBasedAddrList.pm | ||||
292 | 473 | 22.3ms | 473 | 89.8ms | tie_hash_or_array(@_) ; # spent 89.8ms making 473 calls to DB_File::tie_hash_or_array, avg 190µs/call |
293 | } | ||||
294 | |||||
295 | sub TIEARRAY | ||||
296 | { | ||||
297 | tie_hash_or_array(@_) ; | ||||
298 | } | ||||
299 | |||||
300 | sub CLEAR | ||||
301 | { | ||||
302 | my $self = shift; | ||||
303 | my $key = 0 ; | ||||
304 | my $value = "" ; | ||||
305 | my $status = $self->seq($key, $value, R_FIRST()); | ||||
306 | my @keys; | ||||
307 | |||||
308 | while ($status == 0) { | ||||
309 | push @keys, $key; | ||||
310 | $status = $self->seq($key, $value, R_NEXT()); | ||||
311 | } | ||||
312 | foreach $key (reverse @keys) { | ||||
313 | my $s = $self->del($key); | ||||
314 | } | ||||
315 | } | ||||
316 | |||||
317 | sub EXTEND { } | ||||
318 | |||||
319 | sub STORESIZE | ||||
320 | { | ||||
321 | my $self = shift; | ||||
322 | my $length = shift ; | ||||
323 | my $current_length = $self->length() ; | ||||
324 | |||||
325 | if ($length < $current_length) { | ||||
326 | my $key ; | ||||
327 | for ($key = $current_length - 1 ; $key >= $length ; -- $key) | ||||
328 | { $self->del($key) } | ||||
329 | } | ||||
330 | elsif ($length > $current_length) { | ||||
331 | $self->put($length-1, "") ; | ||||
332 | } | ||||
333 | } | ||||
334 | |||||
335 | |||||
336 | sub SPLICE | ||||
337 | { | ||||
338 | my $self = shift; | ||||
339 | my $offset = shift; | ||||
340 | if (not defined $offset) { | ||||
341 | warnings::warnif('uninitialized', 'Use of uninitialized value in splice'); | ||||
342 | $offset = 0; | ||||
343 | } | ||||
344 | |||||
345 | my $has_length = @_; | ||||
346 | my $length = @_ ? shift : 0; | ||||
347 | # Carping about definedness comes _after_ the OFFSET sanity check. | ||||
348 | # This is so we get the same error messages as Perl's splice(). | ||||
349 | # | ||||
350 | |||||
351 | my @list = @_; | ||||
352 | |||||
353 | my $size = $self->FETCHSIZE(); | ||||
354 | |||||
355 | # 'If OFFSET is negative then it start that far from the end of | ||||
356 | # the array.' | ||||
357 | # | ||||
358 | if ($offset < 0) { | ||||
359 | my $new_offset = $size + $offset; | ||||
360 | if ($new_offset < 0) { | ||||
361 | die "Modification of non-creatable array value attempted, " | ||||
362 | . "subscript $offset"; | ||||
363 | } | ||||
364 | $offset = $new_offset; | ||||
365 | } | ||||
366 | |||||
367 | if (not defined $length) { | ||||
368 | warnings::warnif('uninitialized', 'Use of uninitialized value in splice'); | ||||
369 | $length = 0; | ||||
370 | } | ||||
371 | |||||
372 | if ($offset > $size) { | ||||
373 | $offset = $size; | ||||
374 | warnings::warnif('misc', 'splice() offset past end of array') | ||||
375 | if $has_length ? $splice_end_array : $splice_end_array_no_length; | ||||
376 | } | ||||
377 | |||||
378 | # 'If LENGTH is omitted, removes everything from OFFSET onward.' | ||||
379 | if (not defined $length) { | ||||
380 | $length = $size - $offset; | ||||
381 | } | ||||
382 | |||||
383 | # 'If LENGTH is negative, leave that many elements off the end of | ||||
384 | # the array.' | ||||
385 | # | ||||
386 | if ($length < 0) { | ||||
387 | $length = $size - $offset + $length; | ||||
388 | |||||
389 | if ($length < 0) { | ||||
390 | # The user must have specified a length bigger than the | ||||
391 | # length of the array passed in. But perl's splice() | ||||
392 | # doesn't catch this, it just behaves as for length=0. | ||||
393 | # | ||||
394 | $length = 0; | ||||
395 | } | ||||
396 | } | ||||
397 | |||||
398 | if ($length > $size - $offset) { | ||||
399 | $length = $size - $offset; | ||||
400 | } | ||||
401 | |||||
402 | # $num_elems holds the current number of elements in the database. | ||||
403 | my $num_elems = $size; | ||||
404 | |||||
405 | # 'Removes the elements designated by OFFSET and LENGTH from an | ||||
406 | # array,'... | ||||
407 | # | ||||
408 | my @removed = (); | ||||
409 | foreach (0 .. $length - 1) { | ||||
410 | my $old; | ||||
411 | my $status = $self->get($offset, $old); | ||||
412 | if ($status != 0) { | ||||
413 | my $msg = "error from Berkeley DB on get($offset, \$old)"; | ||||
414 | if ($status == 1) { | ||||
415 | $msg .= ' (no such element?)'; | ||||
416 | } | ||||
417 | else { | ||||
418 | $msg .= ": error status $status"; | ||||
419 | if (defined $! and $! ne '') { | ||||
420 | $msg .= ", message $!"; | ||||
421 | } | ||||
422 | } | ||||
423 | die $msg; | ||||
424 | } | ||||
425 | push @removed, $old; | ||||
426 | |||||
427 | $status = $self->del($offset); | ||||
428 | if ($status != 0) { | ||||
429 | my $msg = "error from Berkeley DB on del($offset)"; | ||||
430 | if ($status == 1) { | ||||
431 | $msg .= ' (no such element?)'; | ||||
432 | } | ||||
433 | else { | ||||
434 | $msg .= ": error status $status"; | ||||
435 | if (defined $! and $! ne '') { | ||||
436 | $msg .= ", message $!"; | ||||
437 | } | ||||
438 | } | ||||
439 | die $msg; | ||||
440 | } | ||||
441 | |||||
442 | -- $num_elems; | ||||
443 | } | ||||
444 | |||||
445 | # ...'and replaces them with the elements of LIST, if any.' | ||||
446 | my $pos = $offset; | ||||
447 | while (defined (my $elem = shift @list)) { | ||||
448 | my $old_pos = $pos; | ||||
449 | my $status; | ||||
450 | if ($pos >= $num_elems) { | ||||
451 | $status = $self->put($pos, $elem); | ||||
452 | } | ||||
453 | else { | ||||
454 | $status = $self->put($pos, $elem, $self->R_IBEFORE); | ||||
455 | } | ||||
456 | |||||
457 | if ($status != 0) { | ||||
458 | my $msg = "error from Berkeley DB on put($pos, $elem, ...)"; | ||||
459 | if ($status == 1) { | ||||
460 | $msg .= ' (no such element?)'; | ||||
461 | } | ||||
462 | else { | ||||
463 | $msg .= ", error status $status"; | ||||
464 | if (defined $! and $! ne '') { | ||||
465 | $msg .= ", message $!"; | ||||
466 | } | ||||
467 | } | ||||
468 | die $msg; | ||||
469 | } | ||||
470 | |||||
471 | die "pos unexpectedly changed from $old_pos to $pos with R_IBEFORE" | ||||
472 | if $old_pos != $pos; | ||||
473 | |||||
474 | ++ $pos; | ||||
475 | ++ $num_elems; | ||||
476 | } | ||||
477 | |||||
478 | if (wantarray) { | ||||
479 | # 'In list context, returns the elements removed from the | ||||
480 | # array.' | ||||
481 | # | ||||
482 | return @removed; | ||||
483 | } | ||||
484 | elsif (defined wantarray and not wantarray) { | ||||
485 | # 'In scalar context, returns the last element removed, or | ||||
486 | # undef if no elements are removed.' | ||||
487 | # | ||||
488 | if (@removed) { | ||||
489 | my $last = pop @removed; | ||||
490 | return "$last"; | ||||
491 | } | ||||
492 | else { | ||||
493 | return undef; | ||||
494 | } | ||||
495 | } | ||||
496 | elsif (not defined wantarray) { | ||||
497 | # Void context | ||||
498 | } | ||||
499 | else { die } | ||||
500 | } | ||||
501 | sub ::DB_File::splice { &SPLICE } | ||||
502 | |||||
503 | sub find_dup | ||||
504 | { | ||||
505 | croak "Usage: \$db->find_dup(key,value)\n" | ||||
506 | unless @_ == 3 ; | ||||
507 | |||||
508 | my $db = shift ; | ||||
509 | my ($origkey, $value_wanted) = @_ ; | ||||
510 | my ($key, $value) = ($origkey, 0); | ||||
511 | my ($status) = 0 ; | ||||
512 | |||||
513 | for ($status = $db->seq($key, $value, R_CURSOR() ) ; | ||||
514 | $status == 0 ; | ||||
515 | $status = $db->seq($key, $value, R_NEXT() ) ) { | ||||
516 | |||||
517 | return 0 if $key eq $origkey and $value eq $value_wanted ; | ||||
518 | } | ||||
519 | |||||
520 | return $status ; | ||||
521 | } | ||||
522 | |||||
523 | sub del_dup | ||||
524 | { | ||||
525 | croak "Usage: \$db->del_dup(key,value)\n" | ||||
526 | unless @_ == 3 ; | ||||
527 | |||||
528 | my $db = shift ; | ||||
529 | my ($key, $value) = @_ ; | ||||
530 | my ($status) = $db->find_dup($key, $value) ; | ||||
531 | return $status if $status != 0 ; | ||||
532 | |||||
533 | $status = $db->del($key, R_CURSOR() ) ; | ||||
534 | return $status ; | ||||
535 | } | ||||
536 | |||||
537 | sub get_dup | ||||
538 | { | ||||
539 | croak "Usage: \$db->get_dup(key [,flag])\n" | ||||
540 | unless @_ == 2 or @_ == 3 ; | ||||
541 | |||||
542 | my $db = shift ; | ||||
543 | my $key = shift ; | ||||
544 | my $flag = shift ; | ||||
545 | my $value = 0 ; | ||||
546 | my $origkey = $key ; | ||||
547 | my $wantarray = wantarray ; | ||||
548 | my %values = () ; | ||||
549 | my @values = () ; | ||||
550 | my $counter = 0 ; | ||||
551 | my $status = 0 ; | ||||
552 | |||||
553 | # iterate through the database until either EOF ($status == 0) | ||||
554 | # or a different key is encountered ($key ne $origkey). | ||||
555 | for ($status = $db->seq($key, $value, R_CURSOR()) ; | ||||
556 | $status == 0 and $key eq $origkey ; | ||||
557 | $status = $db->seq($key, $value, R_NEXT()) ) { | ||||
558 | |||||
559 | # save the value or count number of matches | ||||
560 | if ($wantarray) { | ||||
561 | if ($flag) | ||||
562 | { ++ $values{$value} } | ||||
563 | else | ||||
564 | { push (@values, $value) } | ||||
565 | } | ||||
566 | else | ||||
567 | { ++ $counter } | ||||
568 | |||||
569 | } | ||||
570 | |||||
571 | return ($wantarray ? ($flag ? %values : @values) : $counter) ; | ||||
572 | } | ||||
573 | |||||
574 | |||||
575 | sub STORABLE_freeze | ||||
576 | { | ||||
577 | my $type = ref shift; | ||||
578 | croak "Cannot freeze $type object\n"; | ||||
579 | } | ||||
580 | |||||
581 | sub STORABLE_thaw | ||||
582 | { | ||||
583 | my $type = ref shift; | ||||
584 | croak "Cannot thaw $type object\n"; | ||||
585 | } | ||||
586 | |||||
- - | |||||
589 | 1 | 74µs | 1; | ||
590 | __END__ | ||||
# spent 2.92ms (2.91+9µs) within DB_File::CORE:match which was called 543 times, avg 5µs/call:
# 473 times (2.72ms+0s) by DB_File::tie_hash_or_array at line 262, avg 6µs/call
# 68 times (135µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 249, avg 2µs/call
# once (50µs+9µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 172
# once (6µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 178 | |||||
# spent 15.2ms within DB_File::DELETE which was called 880 times, avg 17µs/call:
# 438 times (8.46ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 159 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 19µs/call
# 438 times (6.67ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 160 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 15µs/call
# 4 times (37µs+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 171 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 9µs/call | |||||
# spent 5.88s within DB_File::DESTROY which was called 473 times, avg 12.4ms/call:
# 468 times (5.49s+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 180 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 11.7ms/call
# 4 times (390ms+0s) by Mail::SpamAssassin::BayesStore::DBM::untie_db at line 620 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 97.5ms/call
# once (3.82ms+0s) by Mail::SpamAssassin::DBBasedAddrList::finish at line 110 of Mail/SpamAssassin/DBBasedAddrList.pm | |||||
# spent 25.3ms within DB_File::DoTie_ which was called 473 times, avg 54µs/call:
# 473 times (25.3ms+0s) by DB_File::tie_hash_or_array at line 287, avg 54µs/call | |||||
# spent 214s within DB_File::FETCH which was called 23307361 times, avg 9µs/call:
# 23298310 times (213s+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 9µs/call
# 3118 times (248ms+0s) by Mail::SpamAssassin::DBBasedAddrList::get_addr_entry at line 128 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 79µs/call
# 3118 times (232ms+0s) by Mail::SpamAssassin::DBBasedAddrList::get_addr_entry at line 129 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 74µs/call
# 2106 times (61.2ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 937 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 29µs/call
# 460 times (20.7ms+0s) by Mail::SpamAssassin::BayesStore::DBM::seen_get at line 841 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 45µs/call
# 236 times (12.1ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 910 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 51µs/call
# 12 times (121µs+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 954 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 10µs/call
# once (5µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 320 of Mail/SpamAssassin/BayesStore/DBM.pm | |||||
# spent 37.4ms within DB_File::FIRSTKEY which was called 438 times, avg 85µs/call:
# 438 times (37.4ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 85µs/call | |||||
# spent 158s within DB_File::NEXTKEY which was called 23298310 times, avg 7µs/call:
# 23298310 times (158s+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 7µs/call | |||||
# spent 80.2ms within DB_File::STORE which was called 5798 times, avg 14µs/call:
# 2898 times (42.8ms+0s) by Mail::SpamAssassin::DBBasedAddrList::add_score at line 148 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 15µs/call
# 2898 times (37.4ms+0s) by Mail::SpamAssassin::DBBasedAddrList::add_score at line 149 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 13µs/call
# once (6µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 320 of Mail/SpamAssassin/BayesStore/DBM.pm
# once (4µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 321 of Mail/SpamAssassin/BayesStore/DBM.pm |