1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
# This program is copyright 2010-2011 Percona Ireland Ltd.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307 USA.
# ###########################################################################
# Progress package
# ###########################################################################
{
# Package: Progress
# Progress encapsulates a progress report.
package Progress;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
# This module encapsulates a progress report. To create a new object, pass in
# the following:
# jobsize Must be a number; defines the job's completion condition
# report How and when to report progress. Possible values:
# percentage: based on the percentage complete.
# time: based on how much time elapsed.
# iterations: based on how many progress updates have happened.
# interval How many of whatever's specified in 'report' to wait before
# reporting progress: report each X%, each X seconds, or each X
# iterations.
#
# The 'report' and 'interval' can also be omitted, as long the following option
# is passed:
# spec An arrayref of [report,interval]. This is convenient to use from a
# --progress command-line option that is an array.
#
# Optional arguments:
# start The start time of the job; can also be set by calling start()
# fraction How complete the job is, as a number between 0 and 1. Updated by
# calling update(). Normally don't specify this.
# name If you want to use the default progress indicator, by default it
# just prints out "Progress: ..." but you can replace "Progress" with
# whatever you specify here.
sub new {
my ( $class, %args ) = @_;
foreach my $arg (qw(jobsize)) {
die "I need a $arg argument" unless defined $args{$arg};
}
if ( (!$args{report} || !$args{interval}) ) {
if ( $args{spec} && @{$args{spec}} == 2 ) {
@args{qw(report interval)} = @{$args{spec}};
}
else {
die "I need either report and interval arguments, or a spec";
}
}
my $name = $args{name} || "Progress";
$args{start} ||= time();
my $self;
$self = {
last_reported => $args{start},
fraction => 0, # How complete the job is
callback => sub {
my ($fraction, $elapsed, $remaining, $eta) = @_;
printf STDERR "$name: %3d%% %s remain\n",
$fraction * 100,
Transformers::secs_to_time($remaining),
Transformers::ts($eta);
},
%args,
};
return bless $self, $class;
}
# Validates the 'spec' argument passed in from --progress command-line option.
# It calls die with a trailing newline to avoid auto-adding the file/line.
sub validate_spec {
shift @_ if $_[0] eq 'Progress'; # Permit calling as Progress-> or Progress::
my ( $spec ) = @_;
if ( @$spec != 2 ) {
die "spec array requires a two-part argument\n";
}
if ( $spec->[0] !~ m/^(?:percentage|time|iterations)$/ ) {
die "spec array's first element must be one of "
. "percentage,time,iterations\n";
}
if ( $spec->[1] !~ m/^\d+$/ ) {
die "spec array's second element must be an integer\n";
}
}
# Specify your own custom way to report the progress. The default is to print
# the percentage to STDERR. This is created in the call to new(). The
# callback is a subroutine that will receive the fraction complete from 0 to
# 1, seconds elapsed, seconds remaining, and the Unix timestamp of when we
# expect to be complete.
sub set_callback {
my ( $self, $callback ) = @_;
$self->{callback} = $callback;
}
# Set the start timer of when work began. You can either set it to time() which
# is the default, or pass in a value.
sub start {
my ( $self, $start ) = @_;
$self->{start} = $self->{last_reported} = $start || time();
$self->{first_report} = 0;
}
# Provide a progress update. Pass in a callback subroutine which this code can
# use to ask how complete the job is. This callback will be called as
# appropriate. For example, in time-lapse updating, it won't be called unless
# it's time to report the progress. The callback has to return a number that's
# of the same dimensions as the jobsize. For example, if a text file has 800
# lines to process, that's a jobsize of 800; the callback should return how
# many lines we're done processing -- a number between 0 and 800. You can also
# optionally pass in the current time, but this is only for testing.
sub update {
my ( $self, $callback, %args ) = @_;
my $jobsize = $self->{jobsize};
my $now ||= $args{now} || time;
$self->{iterations}++; # How many updates have happened;
# The caller may want to report something special before the actual
# first report ($callback) if, for example, they know that the wait
# could be long. This is called only once; subsequent reports will
# come from $callback after 30s, or whatever the interval is.
if ( !$self->{first_report} && $args{first_report} ) {
$args{first_report}->();
$self->{first_report} = 1;
}
# Determine whether to just quit and return...
if ( $self->{report} eq 'time'
&& $self->{interval} > $now - $self->{last_reported}
) {
return;
}
elsif ( $self->{report} eq 'iterations'
&& ($self->{iterations} - 1) % $self->{interval} > 0
) {
return;
}
$self->{last_reported} = $now;
# Get the updated status of the job
my $completed = $callback->();
$self->{updates}++; # How many times we have run the update callback
# Sanity check: can't go beyond 100%
return if $completed > $jobsize;
# Compute the fraction complete, between 0 and 1.
my $fraction = $completed > 0 ? $completed / $jobsize : 0;
# Now that we know the fraction completed, we can decide whether to continue
# on and report, for percentage-based reporting. Have we crossed an
# interval-percent boundary since the last update?
if ( $self->{report} eq 'percentage'
&& $self->fraction_modulo($self->{fraction})
>= $self->fraction_modulo($fraction)
) {
# We're done; we haven't advanced progress enough to report.
$self->{fraction} = $fraction;
return;
}
$self->{fraction} = $fraction;
# Continue computing the metrics, and call the callback with them.
my $elapsed = $now - $self->{start};
my $remaining = 0;
my $eta = $now;
if ( $completed > 0 && $completed <= $jobsize && $elapsed > 0 ) {
my $rate = $completed / $elapsed;
if ( $rate > 0 ) {
$remaining = ($jobsize - $completed) / $rate;
$eta = $now + int($remaining);
}
}
$self->{callback}->($fraction, $elapsed, $remaining, $eta, $completed);
}
# Returns the number rounded to the nearest lower $self->{interval}, for use
# with interval-based reporting. For example, when you want to report every 5%,
# then 0% through 4% all return 0%; 5% through 9% return 5%; and so on. The
# number needs to be passed as a fraction from 0 to 1.
sub fraction_modulo {
my ( $self, $num ) = @_;
$num *= 100; # Convert from fraction to percentage
return sprintf('%d',
sprintf('%d', $num / $self->{interval}) * $self->{interval});
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
1;
}
# ###########################################################################
# End Progress package
# ###########################################################################
|