File Coverage

lib/Term/ProgressBar/Simple.pm
Criterion Covered Total %
statement 31 31 100.0
branch 3 6 50.0
condition 2 2 100.0
subroutine 8 8 100.0
pod 3 3 100.0
total 47 50 94.0


line stmt bran cond sub pod time code
1             package Term::ProgressBar::Simple;
2              
3 1     1   39232 use strict;
  1         3  
  1         38  
4 1     1   6 use warnings;
  1         2  
  1         55  
5              
6 1     1   898 use Term::ProgressBar::Quiet;
  1         121322  
  1         47  
7              
8             use overload #
9 1         10 '++' => \&increment, #
10 1     1   1719 '+=' => \&increment; #
  1         1227  
11             # '--' => \&decrement; # add later
12              
13             our $VERSION = '0.03';
14              
15             =head1 NAME
16              
17             Term::ProgressBar::Simple - simpler progress bars
18              
19             =head1 SYNOPSIS
20              
21             # create some things to loop over
22             my @things = (...);
23             my $number_of_things = scalar @things;
24              
25             # create the progress bar object
26             my $progress = Term::ProgressBar::Simple->new( $number_of_things );
27              
28             # loop
29             foreach my $thing (@things) {
30              
31             # do some work
32             $thing->do_something();
33              
34             # increment the progress bar object to tell it a step has been taken.
35             $progress++;
36             }
37              
38             # See also use of '$progress += $number' later in pod
39              
40             =head1 DESCRIPTION
41              
42             Progress bars are handy - they tell you how much work has been done, how much is
43             left to do and estimate how long it will take.
44              
45             But they can be fiddly!
46              
47             This module does the right thing in almost all cases in a really convenient way.
48              
49             =head1 FEATURES
50              
51             Lots - does all the best practice:
52              
53             Wraps L so there is no output unless the code is
54             running interactively - lets you put them in cron scripts.
55              
56             Deals with minor updates - only refreshes the screen when it will change what
57             the user sees so it is efficient.
58              
59             Completes the progress bar when the progress object is destroyed (explicitly or
60             by going out of scope) - no more '99%' done.
61              
62              
63             =head1 METHODS
64              
65             =head2 new
66              
67             # Either...
68             my $progress = Term::ProgressBar::Simple->new($count);
69              
70             # ... or
71             my $progress = Term::ProgressBar::Simple->new(
72             {
73             count => $count, #
74             name => 'descriptive text',
75             }
76             );
77              
78             Create a new progress bar. Either just pass in the number of things to do, or a
79             config hash. See L for details.
80              
81             =cut
82              
83             sub new {
84 4     4 1 14061 my $class = shift;
85 4         10 my $input = shift;
86              
87             # if we didn't get a hashref assume we got a count
88 4 50       27 $input = { count => $input } unless ref $input;
89              
90             # create the T::PB::Q args with defaults.
91 4         29 my $args = {
92             ETA => 'linear', # only sensible choice
93             name => 'progress', # seems reasonable
94             %$input,
95             };
96              
97 4         35 my $tpq = Term::ProgressBar::Quiet->new($args);
98              
99 4         515 my $self = {
100             args => $args,
101             tpq => $tpq,
102             count_so_far => 0,
103             next_update => 0,
104             };
105              
106 4         32 return bless $self, $class;
107             }
108              
109             =head2 increment ( ++ )
110              
111             $progress++;
112              
113             Incrementing the object causes the progress display to be updated. It is smart
114             about checking to see if the display needs to be updated.
115              
116             =head2 increment ( += )
117              
118             $progress += $number_done;
119              
120             Sometimes you'll have done more than one step between updates. A good example is
121             processing logfiles, where the time taken is relative to the size of the file.
122             In this case code like this would give a better feel for the progress made:
123              
124             # Get the total size of all the files
125             my $total_size = sum map { -s } @filenames;
126              
127             # Set up object with total size as steps to do
128             my $progress = Term::ProgressBar::Simple->new($total_size);
129              
130             # process each file and increment by the size of each file
131             foreach my $filename (@filenames) {
132             process_the_file($filename);
133             $progress += -s $filename;
134             }
135              
136             =cut
137              
138             sub increment {
139 20022     20022 1 4084282 my $self = shift;
140 20022   100     83049 my $increment = shift || 1;
141              
142 20022         31030 $self->{count_so_far} += $increment;
143 20022         34580 my $now = $self->{count_so_far};
144              
145 20022 50       53891 if ( $now >= $self->{next_update} ) {
146 20022         119005 $self->{next_update} = $self->{tpq}->update($now);
147             }
148              
149 20022         1214537 return $self;
150             }
151              
152             =head2 message
153              
154             $progress->message('Copying $filename');
155              
156             Output a message. This is very much like print, but we try not to
157             disturb the terminal.
158              
159             =cut
160              
161             sub message {
162 3     3 1 14 my($self, $message) = @_;
163 3         22 $self->{tpq}->message($message);
164             }
165              
166             # want to add this in a later version.
167             #
168             # while ( $progress-- ) {
169             # # do something
170             # }
171             #
172             # =head2 decrement
173             #
174             #
175             # =cut
176             #
177             # sub _decrement {
178             # my $self = shift;
179             #
180             # # increment and get the number done
181             # my $number_done = $self->increment;
182             #
183             # # return number remaining, or zero if overshot
184             # my $remaining = $self->{args}{count} - $number_done;
185             # $remaining = 0 if $remaining < 0;
186             #
187             # return $self;
188             # }
189              
190             sub DESTROY {
191 4     4   4309 my $self = shift;
192              
193 4 50       826 $self->{tpq}->update( $self->{args}{count} ) if $self->{tpq};
194              
195 4         275 return;
196             }
197              
198             =head1 SEE ALSO
199              
200             L & L
201              
202             =head1 GOTCHAS
203              
204             Not all operators are overloaded, so things might blow up in interesting ways.
205             Patches welcome.
206              
207             =head1 THANKS
208              
209             Martyn J. Pearce for the orginal and great L.
210              
211             Leon Brocard for doing the hard work in L, and for
212             submitting a patch with the code for C<+=>..
213              
214             YAPC::EU::2008 for providing the venue and coffee whilst the first version of
215             this module was written.
216              
217             =head1 AUTHOR
218              
219             Edmund von der Burg C<< >>.
220              
221             L
222              
223             =head1 BUGS
224              
225             There are no tests - there should be. The smart way would be to trap the output
226             and check it is right.
227              
228             =head1 LICENCE AND COPYRIGHT
229              
230             Copyright (c) 2008, Edmund von der Burg C<< >>.
231             All rights reserved.
232              
233             This module is free software; you can redistribute it and/or modify it under
234             the same terms as Perl itself.
235              
236             =cut
237              
238             1;