← 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/site_perl/Mail/SpamAssassin/AICache.pm
StatementsExecuted 17 statements in 2.14ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11134µs34µsMail::SpamAssassin::AICache::::BEGIN@38Mail::SpamAssassin::AICache::BEGIN@38
11125µs47µsMail::SpamAssassin::AICache::::BEGIN@44Mail::SpamAssassin::AICache::BEGIN@44
11123µs167µsMail::SpamAssassin::AICache::::BEGIN@40Mail::SpamAssassin::AICache::BEGIN@40
11122µs135µsMail::SpamAssassin::AICache::::BEGIN@39Mail::SpamAssassin::AICache::BEGIN@39
11122µs67µsMail::SpamAssassin::AICache::::BEGIN@45Mail::SpamAssassin::AICache::BEGIN@45
11120µs28µsMail::SpamAssassin::AICache::::BEGIN@43Mail::SpamAssassin::AICache::BEGIN@43
11119µs136µsMail::SpamAssassin::AICache::::BEGIN@41Mail::SpamAssassin::AICache::BEGIN@41
11118µs91µsMail::SpamAssassin::AICache::::BEGIN@46Mail::SpamAssassin::AICache::BEGIN@46
0000s0sMail::SpamAssassin::AICache::::canonMail::SpamAssassin::AICache::canon
0000s0sMail::SpamAssassin::AICache::::checkMail::SpamAssassin::AICache::check
0000s0sMail::SpamAssassin::AICache::::countMail::SpamAssassin::AICache::count
0000s0sMail::SpamAssassin::AICache::::finishMail::SpamAssassin::AICache::finish
0000s0sMail::SpamAssassin::AICache::::newMail::SpamAssassin::AICache::new
0000s0sMail::SpamAssassin::AICache::::updateMail::SpamAssassin::AICache::update
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# <@LICENSE>
2# Licensed to the Apache Software Foundation (ASF) under one or more
3# contributor license agreements. See the NOTICE file distributed with
4# this work for additional information regarding copyright ownership.
5# The ASF licenses this file to you under the Apache License, Version 2.0
6# (the "License"); you may not use this file except in compliance with
7# the License. You may obtain a copy of the License at:
8#
9# http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing, software
12# distributed under the License is distributed on an "AS IS" BASIS,
13# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14# See the License for the specific language governing permissions and
15# limitations under the License.
16# </@LICENSE>
17
18=head1 NAME
19
20Mail::SpamAssassin::AICache - provide access to cached information for
21ArchiveIterator
22
23=head1 SYNOPSIS
24
25=head1 DESCRIPTION
26
27This module allows ArchiveIterator to use cached atime information instead of
28having to read every message separately.
29
30=head1 PUBLIC METHODS
31
32=over 4
33
34=cut
35
36package Mail::SpamAssassin::AICache;
37
38260µs134µs
# spent 34µs within Mail::SpamAssassin::AICache::BEGIN@38 which was called: # once (34µs+0s) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 38
use File::Spec;
# spent 34µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@38
39257µs2248µs
# spent 135µs (22+113) within Mail::SpamAssassin::AICache::BEGIN@39 which was called: # once (22µs+113µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 39
use File::Path;
# spent 135µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@39 # spent 113µs making 1 call to Exporter::import
40265µs2312µs
# spent 167µs (23+145) within Mail::SpamAssassin::AICache::BEGIN@40 which was called: # once (23µs+145µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 40
use File::Basename;
# spent 167µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@40 # spent 145µs making 1 call to Exporter::import
41256µs2254µs
# spent 136µs (19+118) within Mail::SpamAssassin::AICache::BEGIN@41 which was called: # once (19µs+118µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 41
use Mail::SpamAssassin::Logger;
# spent 136µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@41 # spent 118µs making 1 call to Exporter::import
42
43256µs235µs
# spent 28µs (20+7) within Mail::SpamAssassin::AICache::BEGIN@43 which was called: # once (20µs+7µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 43
use strict;
# spent 28µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@43 # spent 8µs making 1 call to strict::import
44255µs270µs
# spent 47µs (25+23) within Mail::SpamAssassin::AICache::BEGIN@44 which was called: # once (25µs+23µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 44
use warnings;
# spent 47µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@44 # spent 23µs making 1 call to warnings::import
45255µs2113µs
# spent 67µs (22+46) within Mail::SpamAssassin::AICache::BEGIN@45 which was called: # once (22µs+46µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 45
use re 'taint';
# spent 67µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@45 # spent 46µs making 1 call to re::import
4621.73ms2164µs
# spent 91µs (18+73) within Mail::SpamAssassin::AICache::BEGIN@46 which was called: # once (18µs+73µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@31 at line 46
use Errno qw(EBADF);
# spent 91µs making 1 call to Mail::SpamAssassin::AICache::BEGIN@46 # spent 73µs making 1 call to Exporter::import
47
48=item new()
49
50Generates a new cache object.
51
52=back
53
54=cut
55
56sub new {
57 my $class = shift;
58 $class = ref($class) || $class;
59
60 my $self = shift;
61 if (!defined $self) { $self = {}; }
62
63 $self->{cache} = {};
64 $self->{dirty} = 0;
65 $self->{prefix} ||= '/';
66
67 my $use_cache = 1;
68
69 # be sure to use rel2abs() here, since otherwise relative paths
70 # are broken by the prefix stuff
71 if ($self->{type} eq 'dir') {
72 $self->{cache_file} = File::Spec->catdir(
73 $self->{prefix},
74 File::Spec->rel2abs($self->{path}),
75 '.spamassassin_cache');
76
77 my @stat = stat($self->{cache_file});
78 @stat or dbg("AIcache: no access to %s: %s", $self->{cache_file}, $!);
79 $self->{cache_mtime} = $stat[9] || 0;
80 }
81 else {
82 my @split = File::Spec->splitpath($self->{path});
83 $self->{cache_file} = File::Spec->catdir(
84 $self->{prefix},
85 File::Spec->rel2abs($split[1]),
86 join('_', '.spamassassin_cache', $self->{type}, $split[2]));
87
88 my @stat = stat($self->{cache_file});
89 @stat or dbg("AIcache: no access to %s: %s", $self->{cache_file}, $!);
90 $self->{cache_mtime} = $stat[9] || 0;
91
92 # for mbox and mbx, verify whether mtime on cache file is >= mtime of
93 # messages file. if it is, use it, otherwise don't.
94 @stat = stat($self->{path});
95 @stat or dbg("AIcache: no access to %s: %s", $self->{path}, $!);
96 if ($stat[9] > $self->{cache_mtime}) {
97 $use_cache = 0;
98 }
99 }
100 $self->{cache_file} = File::Spec->canonpath($self->{cache_file});
101
102 # go ahead and read in the cache information
103 local *CACHE;
104 if (!$use_cache) {
105 # not in use
106 } elsif (!open(CACHE, $self->{cache_file})) {
107 dbg("AIcache: cannot open AI cache file (%s): %s", $self->{cache_file},$!);
108 } else {
109 for ($!=0; defined($_=<CACHE>); $!=0) {
110 my($k,$v) = split(/\t/, $_);
111 next unless (defined $k && defined $v);
112 $self->{cache}->{$k} = $v;
113 }
114 defined $_ || $!==0 or
115 $!==EBADF ? dbg("AIcache: error reading from AI cache file: $!")
116 : warn "error reading from AI cache file: $!";
117 close CACHE
118 or die "error closing AI cache file (".$self->{cache_file}."): $!";
119 }
120
121 bless($self,$class);
122 $self;
123}
124
125sub count {
126 my ($self) = @_;
127 return keys %{$self->{cache}};
128}
129
130sub check {
131 my ($self, $name) = @_;
132
133 return $self->{cache} unless $name;
134
135 # for dir collections: just use the info on a file, if an entry
136 # exists for that file. it's very unlikely that a file will be
137 # changed to contain a different Date header, and it's slow to check.
138 # return if ($self->{type} eq 'dir' && (stat($name))[9] > $self->{cache_mtime});
139
140 $name = $self->canon($name);
141 return $self->{cache}->{$name};
142}
143
144sub update {
145 my ($self, $name, $date) = @_;
146
147 return unless $name;
148 $name = $self->canon($name);
149
150 # if information is different than cached version, set dirty and update
151 if (!exists $self->{cache}->{$name} || $self->{cache}->{$name} != $date) {
152 $self->{cache}->{$name} = $date;
153 $self->{dirty} = 1;
154 }
155}
156
157sub finish {
158 my ($self) = @_;
159
160 return unless $self->{dirty};
161
162 # Cache is dirty, so write out new file
163
164 # create enclosing dir tree, if required
165 eval {
166 mkpath(dirname($self->{cache_file}));
167 1;
168 } or do {
169 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
170 warn "cannot mkpath for AI cache file ($self->{cache_file}): $eval_stat\n";
171 };
172
173 my $towrite = '';
174 while(my($k,$v) = each %{$self->{cache}}) {
175 $towrite .= "$k\t$v\n";
176 }
177
178 {
179 # ignore signals while we're writing this file
180 local $SIG{'INT'} = 'IGNORE';
181 local $SIG{'TERM'} = 'IGNORE';
182
183 if (!open(CACHE, ">".$self->{cache_file}))
184 {
185 warn "creating AI cache file failed (".$self->{cache_file}."): $!";
186 # TODO: should we delete it/clean it up?
187 }
188 else {
189 print CACHE $towrite
190 or warn "error writing to AI cache file: $!";
191 close CACHE
192 or warn "error closing AI cache file (".$self->{cache_file}."): $!";
193 }
194 }
195
196 return;
197}
198
199sub canon {
200 my ($self, $name) = @_;
201
202 if ($self->{type} eq 'dir') {
203 # strip off dirs, just look at filename
204 $name = (File::Spec->splitpath($name))[2];
205 }
206 else {
207 # we may get in a "/path/mbox.offset", so trim to just offset as necessary
208 $name =~ s/^.+\.(\d+)$/$1/;
209 }
210 return $name;
211}
212
213# ---------------------------------------------------------------------------
214
21517µs1;
216__END__
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.