← 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/site_perl/Mail/SpamAssassin/Util/Progress.pm
StatementsExecuted 14 statements in 2.73ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.22ms4.75msMail::SpamAssassin::Util::Progress::::BEGIN@52Mail::SpamAssassin::Util::Progress::BEGIN@52
11154µs68µsMail::SpamAssassin::Util::Progress::::BEGIN@45Mail::SpamAssassin::Util::Progress::BEGIN@45
11140µs68µsMail::SpamAssassin::Util::Progress::::BEGIN@46Mail::SpamAssassin::Util::Progress::BEGIN@46
11139µs44µsMail::SpamAssassin::Util::Progress::::BEGIN@47Mail::SpamAssassin::Util::Progress::BEGIN@47
11128µs77µsMail::SpamAssassin::Util::Progress::::BEGIN@48Mail::SpamAssassin::Util::Progress::BEGIN@48
11125µs383µsMail::SpamAssassin::Util::Progress::::BEGIN@50Mail::SpamAssassin::Util::Progress::BEGIN@50
0000s0sMail::SpamAssassin::Util::Progress::::finalMail::SpamAssassin::Util::Progress::final
0000s0sMail::SpamAssassin::Util::Progress::::init_barMail::SpamAssassin::Util::Progress::init_bar
0000s0sMail::SpamAssassin::Util::Progress::::newMail::SpamAssassin::Util::Progress::new
0000s0sMail::SpamAssassin::Util::Progress::::updateMail::SpamAssassin::Util::Progress::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::Util::Progress - Progress bar support for SpamAssassin
21
22=head1 SYNOPSIS
23
24 my $progress = Mail::SpamAssassin::Util::Progress->new({total => 100});
25
26 $msgcount = 0;
27 foreach my $message (@messages) {
28 # do something here
29 $msgcount++;
30 $progress->update($msgcount);
31 }
32
33 $progress->final();
34
35=head1 DESCRIPTION
36
37This module implements a progress bar for use in SpamAssassin scripts and
38modules. It allows you to create the progress bar, update it and print
39out the final results of a particular run.
40
41=cut
42
43package Mail::SpamAssassin::Util::Progress;
44
45269µs282µs
# spent 68µs (54+14) within Mail::SpamAssassin::Util::Progress::BEGIN@45 which was called: # once (54µs+14µs) by main::BEGIN@69 at line 45
use strict;
# spent 68µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@45 # spent 14µs making 1 call to strict::import
46271µs295µs
# spent 68µs (40+28) within Mail::SpamAssassin::Util::Progress::BEGIN@46 which was called: # once (40µs+28µs) by main::BEGIN@69 at line 46
use warnings;
# spent 68µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@46 # spent 28µs making 1 call to warnings::import
47259µs249µs
# spent 44µs (39+5) within Mail::SpamAssassin::Util::Progress::BEGIN@47 which was called: # once (39µs+5µs) by main::BEGIN@69 at line 47
use bytes;
# spent 44µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@47 # spent 5µs making 1 call to bytes::import
48272µs2125µs
# spent 77µs (28+49) within Mail::SpamAssassin::Util::Progress::BEGIN@48 which was called: # once (28µs+49µs) by main::BEGIN@69 at line 48
use re 'taint';
# spent 77µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@48 # spent 49µs making 1 call to re::import
49
502102µs2740µs
# spent 383µs (25+357) within Mail::SpamAssassin::Util::Progress::BEGIN@50 which was called: # once (25µs+357µs) by main::BEGIN@69 at line 50
use Time::HiRes qw(time);
# spent 383µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@50 # spent 358µs making 1 call to Time::HiRes::import
51
5232.36ms24.93ms
# spent 4.75ms (3.22+1.53) within Mail::SpamAssassin::Util::Progress::BEGIN@52 which was called: # once (3.22ms+1.53ms) by main::BEGIN@69 at line 52
use constant HAS_TERM_READKEY => eval { require Term::ReadKey };
# spent 4.75ms making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@52 # spent 181µs making 1 call to constant::import
53
54=head2 new
55
56public class (Mail::SpamAssassin::Util::Progress) new (\% $args)
57
58Description:
59Creates a new Mail::SpamAssassin::Util::Progress object, valid values for
60the $args hashref are:
61
62=over 4
63
64=item total (required)
65
66The total number of messages expected to be processed. This item is
67required.
68
69=item fh [optional]
70
71An optional filehandle may be passed in, otherwise STDERR will be used by
72default.
73
74=item term [optional]
75
76The module will attempt to determine if a valid terminal exists on the
77STDIN filehandle. This item allows you to override that value.
78
79=back
80
81=cut
82
83sub new {
84 my ($class, $args) = @_;
85 $class = ref($class) || $class;
86
87 if (!exists($args->{total}) || $args->{total} < 1) {
88 warn "progress: must provide a total value > 1";
89 return;
90 }
91
92 my $self = {
93 'total' => $args->{total},
94 'fh' => $args->{fh} || \*STDERR,
95 'itemtype' => $args->{itemtype} || 'msgs'
96 };
97
98 bless ($self, $class);
99
100 $self->{term} = $args->{term} || (-t STDIN);
101
102 $self->init_bar(); # this will give us the initial progress bar
103
104 return $self;
105}
106
107=head2 init_bar
108
109public instance () init_bar()
110
111Description:
112This method creates the initial progress bar and is called automatically from new. In addition
113you can call init_bar on an existing object to reset the bar to it's original state.
114
115=cut
116
117sub init_bar {
118 my ($self) = @_;
119
120 my $fh = $self->{fh};
121
122 $self->{prev_num_done} = 0; # 0 for now, maybe allow this to be passed in
123 $self->{num_done} = 0; # 0 for now, maybe allow this to be passed in
124
125 $self->{avg_msgs_per_sec} = undef;
126
127 $self->{start_time} = time();
128 $self->{prev_time} = $self->{start_time};
129
130 return unless ($self->{term});
131
132 my $term_size;
133
134 # If they have set the COLUMNS environment variable, respect it and move on
135 if ($ENV{COLUMNS}) {
136 $term_size = $ENV{COLUMNS};
137 }
138
139 # The ideal case would be if they happen to have Term::ReadKey installed
140 if (!defined($term_size) && HAS_TERM_READKEY) {
141 my $term_readkey_term_size;
142 eval {
143 $term_readkey_term_size =
144 (Term::ReadKey::GetTerminalSize($self->{fh}))[0];
145 1;
146 } or do { # an error will just keep the default
147 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
148 # dbg("progress: Term::ReadKey::GetTerminalSize failed: $eval_stat");
149 # GetTerminalSize might have returned an empty array, so check the
150 # value and set if it exists, if not we keep the default
151 $term_size = $term_readkey_term_size if ($term_readkey_term_size);
152 }
153 }
154
155 # only viable on Unix based OS, so exclude windows, etc here
156 if ($^O !~ /^(mswin|dos|os2)/i) {
157 if (!defined $term_size) {
158 my $data = `stty -a`;
159 if (defined $data && $data =~ /columns (\d+)/) {
160 $term_size = $1;
161 }
162 }
163
164 if (!defined $term_size) {
165 my $data = `tput cols`;
166 if (defined $data && $data =~ /^(\d+)/) {
167 $term_size = $1;
168 }
169 }
170 }
171
172 # fall back on the default
173 if (!defined($term_size)) {
174 $term_size = 80;
175 }
176
177
178 # Adjust the bar size based on what all is going to print around it,
179 # do not forget the trailing space. Here is what we have to deal with
180 #1234567890123456789012345678901234567
181 # XXX% [] XXX.XX msgs/sec XXmXXs LEFT
182 # XXX% [] XXX.XX msgs/sec XXmXXs DONE
183 $self->{bar_size} = $term_size - 37;
184
185 my @chars = (' ') x $self->{bar_size};
186
187 print $fh sprintf("\r%3d%% [%s] %6.2f %s/sec %sm%ss LEFT",
188 0, join('', @chars), 0, $self->{itemtype}, '--', '--');
189
190 return;
191}
192
193=head2 update
194
195public instance () update ([Integer $num_done])
196
197Description:
198This method is what gets called to update the progress bar. You may optionally pass in
199an integer value that indicates how many messages have been processed. If you do not pass
200anything in then the num_done value will be incremented by one.
201
202=cut
203
204sub update {
205 my ($self, $num_done) = @_;
206
207 my $fh = $self->{fh};
208 my $time_now = time();
209
210 # If nothing is passed in to update assume we are adding one to the prev_num_done value
211 unless(defined($num_done)) {
212 $num_done = $self->{prev_num_done} + 1;
213 }
214
215 my $msgs_since = $num_done - $self->{prev_num_done};
216 my $time_since = $time_now - $self->{prev_time};
217
218 # we have to have processed at least one message and moved a little time
219 if ($msgs_since > 0 && $time_since > .5) {
220
221 if ($self->{term}) {
222 my $percentage = $num_done != 0 ? int(($num_done / $self->{total}) * 100) : 0;
223
224 my @chars = (' ') x $self->{bar_size};
225 my $used_bar = $num_done * ($self->{bar_size} / $self->{total});
226 for (0..$used_bar-1) {
227 $chars[$_] = '=';
228 }
229 my $rate = $msgs_since/$time_since;
230 my $overall_rate = $num_done/($time_now-$self->{start_time});
231
232 # semi-complicated calculation here so that we get the avg msg per sec over time
233 $self->{avg_msgs_per_sec} = defined($self->{avg_msgs_per_sec}) ?
234 0.5 * $self->{avg_msgs_per_sec} + 0.5 * ($msgs_since / $time_since) : $msgs_since / $time_since;
235
236 # using the overall_rate here seems to provide much smoother eta numbers
237 my $eta = ($self->{total} - $num_done)/$overall_rate;
238
239 # we make the assumption that we will never run > 1 hour, maybe this is bad
240 my $min = int($eta/60) % 60;
241 my $sec = int($eta % 60);
242
243 print $fh sprintf("\r%3d%% [%s] %6.2f %s/sec %02dm%02ds LEFT",
244 $percentage, join('', @chars), $self->{avg_msgs_per_sec},
245 $self->{itemtype}, $min, $sec);
246 }
247 else { # we have no term, so fake it
248 print $fh '.' x $msgs_since;
249 }
250
251 $self->{prev_time} = $time_now;
252 $self->{prev_num_done} = $num_done;
253 }
254 $self->{num_done} = $num_done;
255 return;
256}
257
258=head2 final
259
260public instance () final ([Integer $num_done])
261
262Description:
263This method should be called once all processing has finished.
264It will print out the final msgs per sec calculation and the total time taken.
265You can optionally pass in a num_done value, otherwise it will use the value
266calculated from the last call to update.
267
268=cut
269
270sub final {
271 my ($self, $num_done) = @_;
272
273 # passing in $num_done is optional, and will most likely rarely be used,
274 # we should generally favor the data that has been passed in to update()
275 unless (defined($num_done)) {
276 $num_done = $self->{num_done};
277 }
278
279 my $fh = $self->{fh};
280
281 my $time_taken = time() - $self->{start_time};
282 $time_taken ||= 1; # can't have 0 time, so just make it 1 second
283
284 # in theory this should be 100% and the bar would be completely full, however
285 # there is a chance that we had an early exit so we aren't at 100%
286 my $percentage = $num_done != 0 ? int(($num_done / $self->{total}) * 100) : 0;
287
288 my $msgs_per_sec = $num_done / $time_taken;
289
290 my $min = int($time_taken/60) % 60;
291 my $sec = $time_taken % 60;
292
293 if ($self->{term}) {
294 my @chars = (' ') x $self->{bar_size};
295 my $used_bar = $num_done * ($self->{bar_size} / $self->{total});
296 for (0..$used_bar-1) {
297 $chars[$_] = '=';
298 }
299
300 print $fh sprintf("\r%3d%% [%s] %6.2f %s/sec %02dm%02ds DONE\n",
301 $percentage, join('', @chars), $msgs_per_sec,
302 $self->{itemtype}, $min, $sec);
303 }
304 else {
305 print $fh sprintf("\n%3d%% Completed %6.2f %s/sec in %02dm%02ds\n",
306 $percentage, $msgs_per_sec,
307 $self->{itemtype}, $min, $sec);
308 }
309
310 return;
311}
312
31317µs1;
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.