File Coverage

lib/Mail/SpamAssassin/Util/Progress.pm
Criterion Covered Total %
statement 16 104 15.3
branch 0 42 0.0
condition 0 27 0.0
subroutine 5 9 55.5
pod 4 4 100.0
total 25 186 13.4


line stmt bran cond sub pod time 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 1     1   6 use strict;
  1         2  
  1         28  
46 1     1   5 use warnings;
  1         2  
  1         36  
47             # use bytes;
48 1     1   6 use re 'taint';
  1         2  
  1         30  
49              
50 1     1   14 use Time::HiRes qw(time);
  1         2  
  1         6  
51              
52 1     1   136 use constant HAS_TERM_READKEY => eval { require Term::ReadKey };
  1         2  
  1         1  
  1         1408  
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 0     0 1   my ($class, $args) = @_;
85 0   0       $class = ref($class) || $class;
86              
87 0 0 0       if (!exists($args->{total}) || $args->{total} < 1) {
88 0           warn "progress: must provide a total value > 1";
89 0           return;
90             }
91              
92             my $self = {
93             'total' => $args->{total},
94             'fh' => $args->{fh} || \*STDERR,
95 0   0       'itemtype' => $args->{itemtype} || 'msgs'
      0        
96             };
97              
98 0           bless ($self, $class);
99              
100 0   0       $self->{term} = $args->{term} || (-t STDIN);
101              
102 0           $self->init_bar(); # this will give us the initial progress bar
103            
104 0           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 0     0 1   my ($self) = @_;
119              
120 0           my $fh = $self->{fh};
121              
122 0           $self->{prev_num_done} = 0; # 0 for now, maybe allow this to be passed in
123 0           $self->{num_done} = 0; # 0 for now, maybe allow this to be passed in
124              
125 0           $self->{avg_msgs_per_sec} = undef;
126              
127 0           $self->{start_time} = time();
128 0           $self->{prev_time} = $self->{start_time};
129              
130 0 0         return unless ($self->{term});
131              
132 0           my $term_size;
133              
134             # If they have set the COLUMNS environment variable, respect it and move on
135 0 0         if ($ENV{COLUMNS}) {
136 0           $term_size = $ENV{COLUMNS};
137             }
138              
139             # The ideal case would be if they happen to have Term::ReadKey installed
140 0 0 0       if (!defined($term_size) && HAS_TERM_READKEY) {
141 0           my $term_readkey_term_size;
142             eval {
143             $term_readkey_term_size =
144 0           (Term::ReadKey::GetTerminalSize($self->{fh}))[0];
145 0           1;
146 0 0         } or do { # an error will just keep the default
147 0 0         my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
  0            
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 0 0         $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 0 0         if ($^O !~ /^(mswin|dos|os2)/i) {
157 0 0         if (!defined $term_size) {
158 0           my $data = `stty -a`;
159 0 0 0       if (defined $data && $data =~ /columns (\d+)/) {
160 0           $term_size = $1;
161             }
162             }
163              
164 0 0         if (!defined $term_size) {
165 0           my $data = `tput cols`;
166 0 0 0       if (defined $data && $data =~ /^(\d+)/) {
167 0           $term_size = $1;
168             }
169             }
170             }
171              
172             # fall back on the default
173 0 0         if (!defined($term_size)) {
174 0           $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 0           $self->{bar_size} = $term_size - 37;
184              
185 0           my @chars = (' ') x $self->{bar_size};
186              
187             print $fh sprintf("\r%3d%% [%s] %6.2f %s/sec %sm%ss LEFT",
188 0           0, join('', @chars), 0, $self->{itemtype}, '--', '--');
189              
190 0           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 0     0 1   my ($self, $num_done) = @_;
206              
207 0           my $fh = $self->{fh};
208 0           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 0 0         unless(defined($num_done)) {
212 0           $num_done = $self->{prev_num_done} + 1;
213             }
214              
215 0           my $msgs_since = $num_done - $self->{prev_num_done};
216 0           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 0 0 0       if ($msgs_since > 0 && $time_since > .5) {
220              
221 0 0         if ($self->{term}) {
222 0 0         my $percentage = $num_done != 0 ? int(($num_done / $self->{total}) * 100) : 0;
223              
224 0           my @chars = (' ') x $self->{bar_size};
225 0           my $used_bar = $num_done * ($self->{bar_size} / $self->{total});
226 0           for (0..$used_bar-1) {
227 0           $chars[$_] = '=';
228             }
229 0           my $rate = $msgs_since/$time_since;
230 0           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 0         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 0           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 0           my $min = int($eta/60) % 60;
241 0           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 0           $self->{itemtype}, $min, $sec);
246             }
247             else { # we have no term, so fake it
248 0           print $fh '.' x $msgs_since;
249             }
250              
251 0           $self->{prev_time} = $time_now;
252 0           $self->{prev_num_done} = $num_done;
253             }
254 0           $self->{num_done} = $num_done;
255 0           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 0     0 1   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 0 0         unless (defined($num_done)) {
276 0           $num_done = $self->{num_done};
277             }
278              
279 0           my $fh = $self->{fh};
280              
281 0           my $time_taken = time() - $self->{start_time};
282 0   0       $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 0 0         my $percentage = $num_done != 0 ? int(($num_done / $self->{total}) * 100) : 0;
287              
288 0           my $msgs_per_sec = $num_done / $time_taken;
289              
290 0           my $min = int($time_taken/60) % 60;
291 0           my $sec = $time_taken % 60;
292              
293 0 0         if ($self->{term}) {
294 0           my @chars = (' ') x $self->{bar_size};
295 0           my $used_bar = $num_done * ($self->{bar_size} / $self->{total});
296 0           for (0..$used_bar-1) {
297 0           $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 0           $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 0           $self->{itemtype}, $min, $sec);
308             }
309              
310 0           return;
311             }
312              
313             1;