Filename | /usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Util/Progress.pm |
Statements | Executed 14 statements in 2.73ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 3.14ms | 4.74ms | BEGIN@52 | Mail::SpamAssassin::Util::Progress::
1 | 1 | 1 | 49µs | 64µs | BEGIN@45 | Mail::SpamAssassin::Util::Progress::
1 | 1 | 1 | 45µs | 84µs | BEGIN@46 | Mail::SpamAssassin::Util::Progress::
1 | 1 | 1 | 39µs | 44µs | BEGIN@47 | Mail::SpamAssassin::Util::Progress::
1 | 1 | 1 | 26µs | 368µs | BEGIN@50 | Mail::SpamAssassin::Util::Progress::
1 | 1 | 1 | 23µs | 94µs | BEGIN@48 | Mail::SpamAssassin::Util::Progress::
0 | 0 | 0 | 0s | 0s | final | Mail::SpamAssassin::Util::Progress::
0 | 0 | 0 | 0s | 0s | init_bar | Mail::SpamAssassin::Util::Progress::
0 | 0 | 0 | 0s | 0s | new | Mail::SpamAssassin::Util::Progress::
0 | 0 | 0 | 0s | 0s | update | Mail::SpamAssassin::Util::Progress::
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 | |||||
20 | Mail::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 | |||||
37 | This module implements a progress bar for use in SpamAssassin scripts and | ||||
38 | modules. It allows you to create the progress bar, update it and print | ||||
39 | out the final results of a particular run. | ||||
40 | |||||
41 | =cut | ||||
42 | |||||
43 | package Mail::SpamAssassin::Util::Progress; | ||||
44 | |||||
45 | 2 | 71µs | 2 | 80µs | # spent 64µs (49+16) within Mail::SpamAssassin::Util::Progress::BEGIN@45 which was called:
# once (49µs+16µs) by main::BEGIN@69 at line 45 # spent 64µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@45
# spent 16µs making 1 call to strict::import |
46 | 2 | 101µs | 2 | 124µs | # spent 84µs (45+39) within Mail::SpamAssassin::Util::Progress::BEGIN@46 which was called:
# once (45µs+39µs) by main::BEGIN@69 at line 46 # spent 84µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@46
# spent 39µs making 1 call to warnings::import |
47 | 2 | 68µs | 2 | 49µ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 # spent 44µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@47
# spent 5µs making 1 call to bytes::import |
48 | 2 | 66µs | 2 | 166µs | # spent 94µs (23+72) within Mail::SpamAssassin::Util::Progress::BEGIN@48 which was called:
# once (23µs+72µs) by main::BEGIN@69 at line 48 # spent 94µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@48
# spent 72µs making 1 call to re::import |
49 | |||||
50 | 2 | 96µs | 2 | 710µs | # spent 368µs (26+342) within Mail::SpamAssassin::Util::Progress::BEGIN@50 which was called:
# once (26µs+342µs) by main::BEGIN@69 at line 50 # spent 368µs making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@50
# spent 342µs making 1 call to Time::HiRes::import |
51 | |||||
52 | 3 | 2.33ms | 2 | 4.92ms | # spent 4.74ms (3.14+1.59) within Mail::SpamAssassin::Util::Progress::BEGIN@52 which was called:
# once (3.14ms+1.59ms) by main::BEGIN@69 at line 52 # spent 4.74ms making 1 call to Mail::SpamAssassin::Util::Progress::BEGIN@52
# spent 187µs making 1 call to constant::import |
53 | |||||
54 | =head2 new | ||||
55 | |||||
56 | public class (Mail::SpamAssassin::Util::Progress) new (\% $args) | ||||
57 | |||||
58 | Description: | ||||
59 | Creates a new Mail::SpamAssassin::Util::Progress object, valid values for | ||||
60 | the $args hashref are: | ||||
61 | |||||
62 | =over 4 | ||||
63 | |||||
64 | =item total (required) | ||||
65 | |||||
66 | The total number of messages expected to be processed. This item is | ||||
67 | required. | ||||
68 | |||||
69 | =item fh [optional] | ||||
70 | |||||
71 | An optional filehandle may be passed in, otherwise STDERR will be used by | ||||
72 | default. | ||||
73 | |||||
74 | =item term [optional] | ||||
75 | |||||
76 | The module will attempt to determine if a valid terminal exists on the | ||||
77 | STDIN filehandle. This item allows you to override that value. | ||||
78 | |||||
79 | =back | ||||
80 | |||||
81 | =cut | ||||
82 | |||||
83 | sub 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 | |||||
109 | public instance () init_bar() | ||||
110 | |||||
111 | Description: | ||||
112 | This method creates the initial progress bar and is called automatically from new. In addition | ||||
113 | you can call init_bar on an existing object to reset the bar to it's original state. | ||||
114 | |||||
115 | =cut | ||||
116 | |||||
117 | sub 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 | |||||
195 | public instance () update ([Integer $num_done]) | ||||
196 | |||||
197 | Description: | ||||
198 | This method is what gets called to update the progress bar. You may optionally pass in | ||||
199 | an integer value that indicates how many messages have been processed. If you do not pass | ||||
200 | anything in then the num_done value will be incremented by one. | ||||
201 | |||||
202 | =cut | ||||
203 | |||||
204 | sub 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 | |||||
260 | public instance () final ([Integer $num_done]) | ||||
261 | |||||
262 | Description: | ||||
263 | This method should be called once all processing has finished. | ||||
264 | It will print out the final msgs per sec calculation and the total time taken. | ||||
265 | You can optionally pass in a num_done value, otherwise it will use the value | ||||
266 | calculated from the last call to update. | ||||
267 | |||||
268 | =cut | ||||
269 | |||||
270 | sub 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 | |||||
313 | 1 | 6µs | 1; |