← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:48 2017

Filename/usr/local/lib/perl5/5.24/mach/DB_File.pm
StatementsExecuted 36929 statements in 633ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2498207282265s265sDB_File::::FETCH DB_File::FETCH (xsub)
2497283611221s221sDB_File::::NEXTKEY DB_File::NEXTKEY (xsub)
3684439.08s9.08sDB_File::::DESTROY DB_File::DESTROY (xsub)
368411308ms802msDB_File::::tie_hash_or_array DB_File::tie_hash_or_array
368411196ms196msDB_File::::DoTie_ DB_File::DoTie_ (xsub)
36843268.6ms870msDB_File::::TIEHASH DB_File::TIEHASH
37544141.7ms41.7msDB_File::::CORE:match DB_File::CORE:match (opcode)
55344238.5ms38.5msDB_File::::STORE DB_File::STORE (xsub)
4701129.0ms29.0msDB_File::::FIRSTKEY DB_File::FIRSTKEY (xsub)
18383112.2ms12.2msDB_File::::DELETE DB_File::DELETE (xsub)
33168µs153µsDB_File::HASHINFO::::new DB_File::HASHINFO::new
11151µs78µsDB_File::HASHINFO::::BEGIN@14 DB_File::HASHINFO::BEGIN@14
11144µs44µsDB_File::RECNOINFO::::TIEHASHDB_File::RECNOINFO::TIEHASH
11127µs27µsDB_File::::BEGIN@189 DB_File::BEGIN@189
11126µs48µsDB_File::BTREEINFO::::BEGIN@133DB_File::BTREEINFO::BEGIN@133
11124µs48µsDB_File::RECNOINFO::::BEGIN@115DB_File::RECNOINFO::BEGIN@115
11123µs23µsDB_File::BTREEINFO::::TIEHASHDB_File::BTREEINFO::TIEHASH
11122µs153µsDB_File::HASHINFO::::BEGIN@16 DB_File::HASHINFO::BEGIN@16
11121µs27µsDB_File::RECNOINFO::::BEGIN@116DB_File::RECNOINFO::BEGIN@116
11120µs72µsDB_File::::BEGIN@240 DB_File::BEGIN@240
11120µs28µsDB_File::HASHINFO::::BEGIN@15 DB_File::HASHINFO::BEGIN@15
11119µs39µsDB_File::::BEGIN@159 DB_File::BEGIN@159
11119µs25µsDB_File::BTREEINFO::::BEGIN@134DB_File::BTREEINFO::BEGIN@134
11119µs144µsDB_File::::BEGIN@163 DB_File::BEGIN@163
11119µs25µsDB_File::::BEGIN@160 DB_File::BEGIN@160
11119µs19µsDB_File::::BEGIN@264 DB_File::BEGIN@264
11118µs18µsDB_File::HASHINFO::::TIEHASH DB_File::HASHINFO::TIEHASH
11110µs10µsDB_File::::__ANON__[:170] DB_File::__ANON__[:170]
1116µs6µsDB_File::::__ANON__[:176] DB_File::__ANON__[:176]
0000s0sDB_File::::AUTOLOAD DB_File::AUTOLOAD
0000s0sDB_File::::CLEAR DB_File::CLEAR
0000s0sDB_File::::EXTEND DB_File::EXTEND
0000s0sDB_File::HASHINFO::::CLEAR DB_File::HASHINFO::CLEAR
0000s0sDB_File::HASHINFO::::DELETE DB_File::HASHINFO::DELETE
0000s0sDB_File::HASHINFO::::EXISTS DB_File::HASHINFO::EXISTS
0000s0sDB_File::HASHINFO::::FETCH DB_File::HASHINFO::FETCH
0000s0sDB_File::HASHINFO::::FIRSTKEY DB_File::HASHINFO::FIRSTKEY
0000s0sDB_File::HASHINFO::::NEXTKEY DB_File::HASHINFO::NEXTKEY
0000s0sDB_File::HASHINFO::::NotHere DB_File::HASHINFO::NotHere
0000s0sDB_File::HASHINFO::::STORE DB_File::HASHINFO::STORE
0000s0sDB_File::::SPLICE DB_File::SPLICE
0000s0sDB_File::::STORABLE_freeze DB_File::STORABLE_freeze
0000s0sDB_File::::STORABLE_thaw DB_File::STORABLE_thaw
0000s0sDB_File::::STORESIZE DB_File::STORESIZE
0000s0sDB_File::::TIEARRAY DB_File::TIEARRAY
0000s0sDB_File::::__ANON__[:241] DB_File::__ANON__[:241]
0000s0sDB_File::::del_dup DB_File::del_dup
0000s0sDB_File::::find_dup DB_File::find_dup
0000s0sDB_File::::get_dup DB_File::get_dup
0000s0sDB_File::::splice DB_File::splice
Call graph for these subroutines as a Graphviz dot language 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
10package DB_File::HASHINFO ;
11
12139µsrequire 5.008003;
13
14256µs2106µs
# spent 78µs (51+27) within DB_File::HASHINFO::BEGIN@14 which was called: # once (51µs+27µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 14
use warnings;
# spent 78µs making 1 call to DB_File::HASHINFO::BEGIN@14 # spent 27µs making 1 call to warnings::import
15250µs235µs
# spent 28µs (20+8) within DB_File::HASHINFO::BEGIN@15 which was called: # once (20µs+8µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 15
use strict;
# spent 28µs making 1 call to DB_File::HASHINFO::BEGIN@15 # spent 8µs making 1 call to strict::import
162936µs2285µs
# spent 153µs (22+131) within DB_File::HASHINFO::BEGIN@16 which was called: # once (22µs+131µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 16
use Carp;
# spent 153µs making 1 call to DB_File::HASHINFO::BEGIN@16 # spent 131µs making 1 call to Exporter::import
1714µsrequire Tie::Hash;
18125µs@DB_File::HASHINFO::ISA = qw(Tie::Hash);
19
20sub new
21
# spent 153µs (68+85) within DB_File::HASHINFO::new which was called 3 times, avg 51µs/call: # once (19µs+44µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 185 # once (28µs+23µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 183 # once (21µs+18µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 184
{
2237µs my $pkg = shift ;
2336µs my %x ;
24328µs385µs tie %x, $pkg ;
# spent 44µs making 1 call to DB_File::RECNOINFO::TIEHASH # spent 23µs making 1 call to DB_File::BTREEINFO::TIEHASH # spent 18µs making 1 call to DB_File::HASHINFO::TIEHASH
25327µs bless \%x, $pkg ;
26}
27
28
29sub TIEHASH
30
# spent 18µs within DB_File::HASHINFO::TIEHASH which was called: # once (18µs+0s) by DB_File::HASHINFO::new at line 24
{
3112µs my $pkg = shift ;
32
33119µ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
46sub 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
58sub 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
78sub 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
93sub EXISTS
94{
95 my $self = shift ;
96 my $key = shift ;
97
98 exists $self->{VALID}{$key} ;
99}
100
101sub NotHere
102{
103 my $self = shift ;
104 my $method = shift ;
105
106 croak ref($self) . " does not define the method ${method}" ;
107}
108
109sub FIRSTKEY { my $self = shift ; $self->NotHere("FIRSTKEY") }
110sub NEXTKEY { my $self = shift ; $self->NotHere("NEXTKEY") }
111sub CLEAR { my $self = shift ; $self->NotHere("CLEAR") }
112
113package DB_File::RECNOINFO ;
114
115260µs272µs
# spent 48µs (24+24) within DB_File::RECNOINFO::BEGIN@115 which was called: # once (24µs+24µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 115
use warnings;
# spent 48µs making 1 call to DB_File::RECNOINFO::BEGIN@115 # spent 24µs making 1 call to warnings::import
1162195µs234µs
# spent 27µs (21+7) within DB_File::RECNOINFO::BEGIN@116 which was called: # once (21µs+7µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 116
use strict ;
# spent 27µs making 1 call to DB_File::RECNOINFO::BEGIN@116 # spent 7µs making 1 call to strict::import
117
118111µs@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;
119
120sub TIEHASH
121
# spent 44µs within DB_File::RECNOINFO::TIEHASH which was called: # once (44µs+0s) by DB_File::HASHINFO::new at line 24
{
12212µs my $pkg = shift ;
123
124845µs bless { VALID => { map {$_, 1}
125 qw( bval cachesize psize flags lorder reclen bfname )
126 },
127 GOT => {},
128 }, $pkg ;
129}
130
131package DB_File::BTREEINFO ;
132
133255µs269µs
# spent 48µs (26+21) within DB_File::BTREEINFO::BEGIN@133 which was called: # once (26µs+21µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 133
use warnings;
# spent 48µs making 1 call to DB_File::BTREEINFO::BEGIN@133 # spent 21µs making 1 call to warnings::import
1342180µs231µs
# spent 25µs (19+6) within DB_File::BTREEINFO::BEGIN@134 which was called: # once (19µs+6µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 134
use strict ;
# spent 25µs making 1 call to DB_File::BTREEINFO::BEGIN@134 # spent 6µs making 1 call to strict::import
135
13618µs@DB_File::BTREEINFO::ISA = qw(DB_File::HASHINFO) ;
137
138sub TIEHASH
139
# spent 23µs within DB_File::BTREEINFO::TIEHASH which was called: # once (23µs+0s) by DB_File::HASHINFO::new at line 24
{
14012µs my $pkg = shift ;
141
142125µ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
157package DB_File ;
158
159249µs259µs
# spent 39µs (19+20) within DB_File::BEGIN@159 which was called: # once (19µs+20µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 159
use warnings;
# spent 39µs making 1 call to DB_File::BEGIN@159 # spent 20µs making 1 call to warnings::import
1602150µs232µs
# spent 25µs (19+6) within DB_File::BEGIN@160 which was called: # once (19µs+6µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 160
use strict;
# spent 25µs making 1 call to DB_File::BEGIN@160 # spent 6µs making 1 call to strict::import
161our ($VERSION, @ISA, @EXPORT, $AUTOLOAD, $DB_BTREE, $DB_HASH, $DB_RECNO);
162our ($db_version, $use_XSLoader, $splice_end_array_no_length, $splice_end_array, $Error);
1632506µs2270µs
# spent 144µs (19+126) within DB_File::BEGIN@163 which was called: # once (19µs+126µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 163
use Carp;
# spent 144µs making 1 call to DB_File::BEGIN@163 # spent 126µs making 1 call to Exporter::import
164
165
16612µs$VERSION = "1.835" ;
167138µs$VERSION = eval $VERSION; # needed for dev releases
# spent 8µs executing statements in string eval
168
169{
170229µs
# spent 10µs within DB_File::__ANON__[/usr/local/lib/perl5/5.24/mach/DB_File.pm:170] which was called: # once (10µs+0s) by DB_File::CORE:match at line 172
local $SIG{__WARN__} = sub {$splice_end_array_no_length = join(" ",@_);};
17126µs my @a =(1); splice(@a, 3);
172170µs275µs $splice_end_array_no_length =
# spent 65µs making 1 call to DB_File::CORE:match # spent 10µ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{
176426µs
# spent 6µs within DB_File::__ANON__[/usr/local/lib/perl5/5.24/mach/DB_File.pm:176] which was called: # once (6µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 177
local $SIG{__WARN__} = sub {$splice_end_array = join(" ", @_);};
177218µs16µs my @a =(1); splice(@a, 3, 1);
# spent 6µs making 1 call to DB_File::__ANON__[DB_File.pm:176]
178126µs113µs $splice_end_array =
# spent 13µ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;
183115µs151µs$DB_BTREE = new DB_File::BTREEINFO ;
# spent 51µs making 1 call to DB_File::HASHINFO::new
18417µs138µs$DB_HASH = new DB_File::HASHINFO ;
# spent 38µs making 1 call to DB_File::HASHINFO::new
185111µs163µs$DB_RECNO = new DB_File::RECNOINFO ;
# spent 63µs making 1 call to DB_File::HASHINFO::new
186
18712µsrequire Tie::Hash;
18813µsrequire Exporter;
189
# spent 27µs within DB_File::BEGIN@189 which was called: # once (27µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 198
BEGIN {
19012µs $use_XSLoader = 1 ;
191416µs { local $SIG{__DIE__} ; eval { require XSLoader } ; }
192
193110µs if ($@) {
194 $use_XSLoader = 0 ;
195 require DynaLoader;
196 @ISA = qw(DynaLoader);
197 }
1981251µs127µs}
# spent 27µs making 1 call to DB_File::BEGIN@189
199
200121µspush @ISA, qw(Tie::Hash Exporter);
20118µ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
235sub AUTOLOAD {
236 my($constname);
237 ($constname = $AUTOLOAD) =~ s/.*:://;
238 my ($error, $val) = constant($constname);
239 Carp::croak $error if $error;
2402334µs2124µs
# spent 72µs (20+52) within DB_File::BEGIN@240 which was called: # once (20µs+52µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 240
no strict 'refs';
# spent 72µs making 1 call to DB_File::BEGIN@240 # spent 52µs making 1 call to strict::unimport
241 *{$AUTOLOAD} = sub { $val };
242 goto &{$AUTOLOAD};
243}
244
245
24613µseval {
247 # Make all Fcntl O_XXX constants available for importing
24812µs require Fcntl;
2491387µs68132µs my @O = grep /^O_/, @Fcntl::EXPORT;
# spent 132µs making 68 calls to DB_File::CORE:match, avg 2µs/call
250111µs1664µs Fcntl->import(@O); # first we import what we want to export
# spent 664µs making 1 call to Exporter::import
251111µs push(@EXPORT, @O);
252};
253
25417µsif ($use_XSLoader)
2551518µs1499µs { XSLoader::load("DB_File", $VERSION)}
# spent 499µs making 1 call to XSLoader::load
256else
257 { bootstrap DB_File $VERSION }
258
259sub tie_hash_or_array
260
# spent 802ms (308+494) within DB_File::tie_hash_or_array which was called 3684 times, avg 218µs/call: # 3684 times (308ms+494ms) by DB_File::TIEHASH at line 292, avg 218µs/call
{
261368418.5ms my (@arg) = @_ ;
2623684168ms368441.5ms my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
# spent 41.5ms making 3684 calls to DB_File::CORE:match, avg 11µs/call
263
26422.89ms119µ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
use File::Spec;
# spent 19µs making 1 call to DB_File::BEGIN@264
265368455.5ms3684256ms $arg[1] = File::Spec->rel2abs($arg[1])
# spent 256ms making 3684 calls to File::Spec::Unix::rel2abs, avg 70µs/call
266 if defined $arg[1] ;
267
268 $arg[4] = tied %{ $arg[4] }
26936849.75ms if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
270
271368411.8ms $arg[2] = O_CREAT()|O_RDWR() if @arg >=3 && ! defined $arg[2];
272368410.4ms $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.
27636849.92ms if ($db_version >= 4 and ! $tieHASH) {
277 $arg[2] |= O_CREAT();
278 }
279
28036848.36ms 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
2873684268ms3684196ms DoTie_($tieHASH, @arg) ;
# spent 196ms making 3684 calls to DB_File::DoTie_, avg 53µs/call
288}
289
290sub TIEHASH
291
# spent 870ms (68.6+802) within DB_File::TIEHASH which was called 3684 times, avg 236µs/call: # 3216 times (62.8ms+711ms) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 88 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 241µs/call # 466 times (5.79ms+90.1ms) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 182 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 206µs/call # 2 times (23µs+480µs) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 301 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 251µs/call
{
292368464.8ms3684802ms tie_hash_or_array(@_) ;
# spent 802ms making 3684 calls to DB_File::tie_hash_or_array, avg 218µs/call
293}
294
295sub TIEARRAY
296{
297 tie_hash_or_array(@_) ;
298}
299
300sub 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
317sub EXTEND { }
318
319sub 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
336sub 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}
501sub ::DB_File::splice { &SPLICE }
502
503sub 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
523sub 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
537sub 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
575sub STORABLE_freeze
576{
577 my $type = ref shift;
578 croak "Cannot freeze $type object\n";
579}
580
581sub STORABLE_thaw
582{
583 my $type = ref shift;
584 croak "Cannot thaw $type object\n";
585}
586
- -
589159µs1;
590__END__
 
# spent 41.7ms (41.7+10µs) within DB_File::CORE:match which was called 3754 times, avg 11µs/call: # 3684 times (41.5ms+0s) by DB_File::tie_hash_or_array at line 262, avg 11µs/call # 68 times (132µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 249, avg 2µs/call # once (55µs+10µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 172 # once (13µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 178
sub DB_File::CORE:match; # opcode
# spent 12.2ms within DB_File::DELETE which was called 1838 times, avg 7µs/call: # 898 times (6.54ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 171 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 7µs/call # 470 times (3.31ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 159 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 7µs/call # 470 times (2.33ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 160 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 5µs/call
sub DB_File::DELETE; # xsub
# spent 9.08s within DB_File::DESTROY which was called 3684 times, avg 2.46ms/call: # 3215 times (8.90s+0s) by Mail::SpamAssassin::Plugin::TxRep::open_storages at line 1656 of Mail/SpamAssassin/Plugin/TxRep.pm, avg 2.77ms/call # 466 times (178ms+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 180 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 382µs/call # 2 times (194µs+0s) by Mail::SpamAssassin::BayesStore::DBM::untie_db at line 620 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 97µs/call # once (954µs+0s) by Mail::SpamAssassin::DBBasedAddrList::finish at line 110 of Mail/SpamAssassin/DBBasedAddrList.pm
sub DB_File::DESTROY; # xsub
# spent 196ms within DB_File::DoTie_ which was called 3684 times, avg 53µs/call: # 3684 times (196ms+0s) by DB_File::tie_hash_or_array at line 287, avg 53µs/call
sub DB_File::DoTie_; # xsub
# spent 265s within DB_File::FETCH which was called 24982072 times, avg 11µs/call: # 24972836 times (265s+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 11µs/call # 3220 times (266ms+0s) by Mail::SpamAssassin::DBBasedAddrList::get_addr_entry at line 128 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 82µs/call # 3220 times (211ms+0s) by Mail::SpamAssassin::DBBasedAddrList::get_addr_entry at line 129 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 65µs/call # 2097 times (78.3ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 937 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 37µs/call # 458 times (20.4ms+0s) by Mail::SpamAssassin::BayesStore::DBM::seen_get at line 841 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 45µs/call # 234 times (12.3ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 910 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 53µs/call # 6 times (42µs+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 954 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 7µs/call # once (6µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 320 of Mail/SpamAssassin/BayesStore/DBM.pm
sub DB_File::FETCH; # xsub
# spent 29.0ms within DB_File::FIRSTKEY which was called 470 times, avg 62µs/call: # 470 times (29.0ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 62µs/call
sub DB_File::FIRSTKEY; # xsub
# spent 221s within DB_File::NEXTKEY which was called 24972836 times, avg 9µs/call: # 24972836 times (221s+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 9µs/call
sub DB_File::NEXTKEY; # xsub
# spent 38.5ms within DB_File::STORE which was called 5534 times, avg 7µs/call: # 2766 times (21.7ms+0s) by Mail::SpamAssassin::DBBasedAddrList::add_score at line 148 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 8µs/call # 2766 times (16.8ms+0s) by Mail::SpamAssassin::DBBasedAddrList::add_score at line 149 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 6µs/call # once (18µ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
sub DB_File::STORE; # xsub
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.