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