← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:20 2017

Filename/usr/local/lib/perl5/5.24/mach/DB_File.pm
StatementsExecuted 4779 statements in 74.7ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
92474028288.0s88.0sDB_File::::FETCH DB_File::FETCH (xsub)
92401881159.6s59.6sDB_File::::NEXTKEY DB_File::NEXTKEY (xsub)
469321.18s1.18sDB_File::::DESTROY DB_File::DESTROY (xsub)
42444263.1ms63.1msDB_File::::STORE DB_File::STORE (xsub)
4691132.0ms98.8msDB_File::::tie_hash_or_array DB_File::tie_hash_or_array
4691126.2ms26.2msDB_File::::DoTie_ DB_File::DoTie_ (xsub)
1751115.0ms15.0msDB_File::::FIRSTKEY DB_File::FIRSTKEY (xsub)
469326.21ms105msDB_File::::TIEHASH DB_File::TIEHASH
350216.11ms6.11msDB_File::::DELETE DB_File::DELETE (xsub)
539413.05ms3.06msDB_File::::CORE:match DB_File::CORE:match (opcode)
11171µs71µsDB_File::RECNOINFO::::TIEHASHDB_File::RECNOINFO::TIEHASH
33168µs170µsDB_File::HASHINFO::::new DB_File::HASHINFO::new
11148µs82µsDB_File::HASHINFO::::BEGIN@14 DB_File::HASHINFO::BEGIN@14
11133µs99µsDB_File::::BEGIN@240 DB_File::BEGIN@240
11132µs52µsDB_File::::BEGIN@159 DB_File::BEGIN@159
11131µs31µsDB_File::::BEGIN@189 DB_File::BEGIN@189
11130µs68µsDB_File::BTREEINFO::::BEGIN@133DB_File::BTREEINFO::BEGIN@133
11130µs58µsDB_File::RECNOINFO::::BEGIN@115DB_File::RECNOINFO::BEGIN@115
11128µs35µsDB_File::::BEGIN@160 DB_File::BEGIN@160
11126µs41µsDB_File::BTREEINFO::::BEGIN@134DB_File::BTREEINFO::BEGIN@134
11125µs40µsDB_File::HASHINFO::::BEGIN@15 DB_File::HASHINFO::BEGIN@15
11125µs229µsDB_File::HASHINFO::::BEGIN@16 DB_File::HASHINFO::BEGIN@16
11124µs230µsDB_File::::BEGIN@163 DB_File::BEGIN@163
11120µs28µsDB_File::RECNOINFO::::BEGIN@116DB_File::RECNOINFO::BEGIN@116
11117µs17µsDB_File::::BEGIN@264 DB_File::BEGIN@264
11117µs17µsDB_File::BTREEINFO::::TIEHASHDB_File::BTREEINFO::TIEHASH
11114µs14µsDB_File::HASHINFO::::TIEHASH DB_File::HASHINFO::TIEHASH
1119µs9µsDB_File::::__ANON__[:170] DB_File::__ANON__[:170]
1117µs7µ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
12134µsrequire 5.008003;
13
14263µs2116µs
# spent 82µs (48+34) within DB_File::HASHINFO::BEGIN@14 which was called: # once (48µs+34µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 14
use warnings;
# spent 82µs making 1 call to DB_File::HASHINFO::BEGIN@14 # spent 34µs making 1 call to warnings::import
15282µs255µs
# spent 40µs (25+15) within DB_File::HASHINFO::BEGIN@15 which was called: # once (25µs+15µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 15
use strict;
# spent 40µs making 1 call to DB_File::HASHINFO::BEGIN@15 # spent 15µs making 1 call to strict::import
162943µs2433µs
# spent 229µs (25+204) within DB_File::HASHINFO::BEGIN@16 which was called: # once (25µs+204µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 16
use Carp;
# spent 229µs making 1 call to DB_File::HASHINFO::BEGIN@16 # spent 204µs making 1 call to Exporter::import
1713µsrequire Tie::Hash;
18116µs@DB_File::HASHINFO::ISA = qw(Tie::Hash);
19
20sub new
21
# spent 170µs (68+102) within DB_File::HASHINFO::new which was called 3 times, avg 57µs/call: # once (20µs+71µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 185 # once (29µs+17µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 183 # once (20µs+14µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 184
{
2236µs my $pkg = shift ;
2335µs my %x ;
24333µs3102µs tie %x, $pkg ;
# spent 71µs making 1 call to DB_File::RECNOINFO::TIEHASH # spent 17µs making 1 call to DB_File::BTREEINFO::TIEHASH # spent 14µs making 1 call to DB_File::HASHINFO::TIEHASH
25326µs bless \%x, $pkg ;
26}
27
28
29sub TIEHASH
30
# spent 14µs within DB_File::HASHINFO::TIEHASH which was called: # once (14µs+0s) by DB_File::HASHINFO::new at line 24
{
3112µs my $pkg = shift ;
32
33116µ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µs287µs
# spent 58µs (30+29) within DB_File::RECNOINFO::BEGIN@115 which was called: # once (30µs+29µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 115
use warnings;
# spent 58µs making 1 call to DB_File::RECNOINFO::BEGIN@115 # spent 29µs making 1 call to warnings::import
1162216µs237µs
# spent 28µs (20+9) within DB_File::RECNOINFO::BEGIN@116 which was called: # once (20µs+9µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 116
use strict ;
# spent 28µs making 1 call to DB_File::RECNOINFO::BEGIN@116 # spent 9µs making 1 call to strict::import
117
11819µs@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;
119
120sub TIEHASH
121
# spent 71µs within DB_File::RECNOINFO::TIEHASH which was called: # once (71µs+0s) by DB_File::HASHINFO::new at line 24
{
12212µs my $pkg = shift ;
123
124867µ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
133262µs2105µs
# spent 68µs (30+38) within DB_File::BTREEINFO::BEGIN@133 which was called: # once (30µs+38µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 133
use warnings;
# spent 68µs making 1 call to DB_File::BTREEINFO::BEGIN@133 # spent 38µs making 1 call to warnings::import
1342198µs257µs
# spent 41µs (26+16) within DB_File::BTREEINFO::BEGIN@134 which was called: # once (26µs+16µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 134
use strict ;
# spent 41µs making 1 call to DB_File::BTREEINFO::BEGIN@134 # spent 16µs making 1 call to strict::import
135
136113µs@DB_File::BTREEINFO::ISA = qw(DB_File::HASHINFO) ;
137
138sub TIEHASH
139
# spent 17µs within DB_File::BTREEINFO::TIEHASH which was called: # once (17µs+0s) by DB_File::HASHINFO::new at line 24
{
14012µs my $pkg = shift ;
141
142123µ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
159257µs273µs
# spent 52µs (32+20) within DB_File::BEGIN@159 which was called: # once (32µs+20µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 159
use warnings;
# spent 52µs making 1 call to DB_File::BEGIN@159 # spent 20µs making 1 call to warnings::import
1602164µs242µs
# spent 35µs (28+7) within DB_File::BEGIN@160 which was called: # once (28µs+7µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 160
use strict;
# spent 35µs making 1 call to DB_File::BEGIN@160 # spent 7µ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);
1632511µs2436µs
# spent 230µs (24+206) within DB_File::BEGIN@163 which was called: # once (24µs+206µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 163
use Carp;
# spent 230µs making 1 call to DB_File::BEGIN@163 # spent 206µs making 1 call to Exporter::import
164
165
16612µs$VERSION = "1.835" ;
167139µs$VERSION = eval $VERSION; # needed for dev releases
# spent 6µs executing statements in string eval
168
169{
170233µ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
local $SIG{__WARN__} = sub {$splice_end_array_no_length = join(" ",@_);};
17129µs my @a =(1); splice(@a, 3);
172163µs269µs $splice_end_array_no_length =
# spent 60µ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{
176433µs
# spent 7µs within DB_File::__ANON__[/usr/local/lib/perl5/5.24/mach/DB_File.pm:176] which was called: # once (7µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 177
local $SIG{__WARN__} = sub {$splice_end_array = join(" ", @_);};
177224µs17µs my @a =(1); splice(@a, 3, 1);
# spent 7µs making 1 call to DB_File::__ANON__[DB_File.pm:176]
178121µs18µs $splice_end_array =
# spent 8µ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;
183121µs146µs$DB_BTREE = new DB_File::BTREEINFO ;
# spent 46µs making 1 call to DB_File::HASHINFO::new
18416µs133µs$DB_HASH = new DB_File::HASHINFO ;
# spent 33µs making 1 call to DB_File::HASHINFO::new
185119µs191µs$DB_RECNO = new DB_File::RECNOINFO ;
# spent 91µs making 1 call to DB_File::HASHINFO::new
186
18713µsrequire Tie::Hash;
18818µsrequire Exporter;
189
# spent 31µs within DB_File::BEGIN@189 which was called: # once (31µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 198
BEGIN {
19012µs $use_XSLoader = 1 ;
191419µs { local $SIG{__DIE__} ; eval { require XSLoader } ; }
192
193110µs if ($@) {
194 $use_XSLoader = 0 ;
195 require DynaLoader;
196 @ISA = qw(DynaLoader);
197 }
1981255µs131µs}
# spent 31µs making 1 call to DB_File::BEGIN@189
199
200119µ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;
2402364µs2165µs
# spent 99µs (33+66) within DB_File::BEGIN@240 which was called: # once (33µs+66µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 240
no strict 'refs';
# spent 99µs making 1 call to DB_File::BEGIN@240 # spent 66µ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
248111µs require Fcntl;
2491563µs68134µs my @O = grep /^O_/, @Fcntl::EXPORT;
# spent 134µs making 68 calls to DB_File::CORE:match, avg 2µs/call
25019µs1997µs Fcntl->import(@O); # first we import what we want to export
# spent 997µs making 1 call to Exporter::import
251111µs push(@EXPORT, @O);
252};
253
25417µsif ($use_XSLoader)
2551506µs1493µs { XSLoader::load("DB_File", $VERSION)}
# spent 493µs making 1 call to XSLoader::load
256else
257 { bootstrap DB_File $VERSION }
258
259sub tie_hash_or_array
260
# spent 98.8ms (32.0+66.9) within DB_File::tie_hash_or_array which was called 469 times, avg 211µs/call: # 469 times (32.0ms+66.9ms) by DB_File::TIEHASH at line 292, avg 211µs/call
{
2614692.16ms my (@arg) = @_ ;
26246913.9ms4692.86ms my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
# spent 2.86ms making 469 calls to DB_File::CORE:match, avg 6µs/call
263
26423.02ms117µs
# spent 17µs within DB_File::BEGIN@264 which was called: # once (17µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 264
use File::Spec;
# spent 17µs making 1 call to DB_File::BEGIN@264
2654695.75ms46937.8ms $arg[1] = File::Spec->rel2abs($arg[1])
# spent 37.8ms making 469 calls to File::Spec::Unix::rel2abs, avg 81µs/call
266 if defined $arg[1] ;
267
268 $arg[4] = tied %{ $arg[4] }
2694691.20ms if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
270
2714691.24ms $arg[2] = O_CREAT()|O_RDWR() if @arg >=3 && ! defined $arg[2];
2724691.25ms $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.
2764691.12ms if ($db_version >= 4 and ! $tieHASH) {
277 $arg[2] |= O_CREAT();
278 }
279
280469981µ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
28746933.0ms46926.2ms DoTie_($tieHASH, @arg) ;
# spent 26.2ms making 469 calls to DB_File::DoTie_, avg 56µs/call
288}
289
290sub TIEHASH
291
# spent 105ms (6.21+98.8) within DB_File::TIEHASH which was called 469 times, avg 224µs/call: # 466 times (6.17ms+98.0ms) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 182 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 224µs/call # 2 times (27µs+560µs) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 301 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 294µs/call # once (18µs+244µs) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 88 of Mail/SpamAssassin/DBBasedAddrList.pm
{
2924696.35ms46998.8ms tie_hash_or_array(@_) ;
# spent 98.8ms making 469 calls to DB_File::tie_hash_or_array, avg 211µ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
- -
589158µs1;
590__END__
 
# spent 3.06ms (3.05+9µs) within DB_File::CORE:match which was called 539 times, avg 6µs/call: # 469 times (2.86ms+0s) by DB_File::tie_hash_or_array at line 262, avg 6µs/call # 68 times (134µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 249, avg 2µs/call # once (51µs+9µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 172 # once (8µs+0s) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 at line 178
sub DB_File::CORE:match; # opcode
# spent 6.11ms within DB_File::DELETE which was called 350 times, avg 17µs/call: # 175 times (3.41ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 159 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 19µs/call # 175 times (2.70ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 160 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 15µs/call
sub DB_File::DELETE; # xsub
# spent 1.18s within DB_File::DESTROY which was called 469 times, avg 2.52ms/call: # 466 times (1.16s+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 180 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 2.48ms/call # 2 times (195µs+0s) by Mail::SpamAssassin::BayesStore::DBM::untie_db at line 620 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 97µs/call # once (24.7ms+0s) by Mail::SpamAssassin::DBBasedAddrList::finish at line 110 of Mail/SpamAssassin/DBBasedAddrList.pm
sub DB_File::DESTROY; # xsub
# spent 26.2ms within DB_File::DoTie_ which was called 469 times, avg 56µs/call: # 469 times (26.2ms+0s) by DB_File::tie_hash_or_array at line 287, avg 56µs/call
sub DB_File::DoTie_; # xsub
# spent 88.0s within DB_File::FETCH which was called 9247402 times, avg 10µs/call: # 9240188 times (87.5s+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 9µs/call # 2209 times (207ms+0s) by Mail::SpamAssassin::DBBasedAddrList::get_addr_entry at line 128 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 94µs/call # 2209 times (174ms+0s) by Mail::SpamAssassin::DBBasedAddrList::get_addr_entry at line 129 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 79µs/call # 2097 times (63.8ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 937 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 30µs/call # 458 times (20.5ms+0s) by Mail::SpamAssassin::BayesStore::DBM::seen_get at line 841 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 45µs/call # 234 times (12.9ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 910 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 55µs/call # 6 times (27µs+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 954 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 4µs/call # once (5µ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 15.0ms within DB_File::FIRSTKEY which was called 175 times, avg 86µs/call: # 175 times (15.0ms+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 86µs/call
sub DB_File::FIRSTKEY; # xsub
# spent 59.6s within DB_File::NEXTKEY which was called 9240188 times, avg 6µs/call: # 9240188 times (59.6s+0s) by Mail::SpamAssassin::DBBasedAddrList::remove_entry at line 168 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 6µs/call
sub DB_File::NEXTKEY; # xsub
# spent 63.1ms within DB_File::STORE which was called 4244 times, avg 15µs/call: # 2121 times (34.1ms+0s) by Mail::SpamAssassin::DBBasedAddrList::add_score at line 148 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 16µs/call # 2121 times (29.0ms+0s) by Mail::SpamAssassin::DBBasedAddrList::add_score at line 149 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 14µs/call # once (11µ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.