Commit | Line | Data |
---|---|---|
351625bd SP |
1 | |
2 | require 5; | |
3 | package Pod::Simple::Progress; | |
4 | $VERSION = "1.01"; | |
5 | use strict; | |
6 | ||
7 | # Objects of this class are used for noting progress of an | |
8 | # operation every so often. Messages delivered more often than that | |
9 | # are suppressed. | |
10 | # | |
11 | # There's actually nothing in here that's specific to Pod processing; | |
12 | # but it's ad-hoc enough that I'm not willing to give it a name that | |
13 | # implies that it's generally useful, like "IO::Progress" or something. | |
14 | # | |
15 | # -- sburke | |
16 | # | |
17 | #-------------------------------------------------------------------------- | |
18 | ||
19 | sub new { | |
20 | my($class,$delay) = @_; | |
21 | my $self = bless {'quiet_until' => 1}, ref($class) || $class; | |
22 | $self->to(*STDOUT{IO}); | |
23 | $self->delay(defined($delay) ? $delay : 5); | |
24 | return $self; | |
25 | } | |
26 | ||
27 | sub copy { | |
28 | my $orig = shift; | |
29 | bless {%$orig, 'quiet_until' => 1}, ref($orig); | |
30 | } | |
31 | #-------------------------------------------------------------------------- | |
32 | ||
33 | sub reach { | |
34 | my($self, $point, $note) = @_; | |
35 | if( (my $now = time) >= $self->{'quiet_until'}) { | |
36 | my $goal; | |
37 | my $to = $self->{'to'}; | |
38 | print $to join('', | |
39 | ($self->{'quiet_until'} == 1) ? () : '... ', | |
40 | (defined $point) ? ( | |
41 | '#', | |
42 | ($goal = $self->{'goal'}) ? ( | |
43 | ' ' x (length($goal) - length($point)), | |
44 | $point, '/', $goal, | |
45 | ) : $point, | |
46 | $note ? ': ' : (), | |
47 | ) : (), | |
48 | $note || '', | |
49 | "\n" | |
50 | ); | |
51 | $self->{'quiet_until'} = $now + $self->{'delay'}; | |
52 | } | |
53 | return $self; | |
54 | } | |
55 | ||
56 | #-------------------------------------------------------------------------- | |
57 | ||
58 | sub done { | |
59 | my($self, $note) = @_; | |
60 | $self->{'quiet_until'} = 1; | |
61 | return $self->reach( undef, $note ); | |
62 | } | |
63 | ||
64 | #-------------------------------------------------------------------------- | |
65 | # Simple accessors: | |
66 | ||
67 | sub delay { | |
68 | return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] } | |
69 | sub goal { | |
70 | return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] } | |
71 | sub to { | |
72 | return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] } | |
73 | ||
74 | #-------------------------------------------------------------------------- | |
75 | ||
76 | unless(caller) { # Simple self-test: | |
77 | my $p = __PACKAGE__->new->goal(5); | |
78 | $p->reach(1, "Primus!"); | |
79 | sleep 1; | |
80 | $p->reach(2, "Secundus!"); | |
81 | sleep 3; | |
82 | $p->reach(3, "Tertius!"); | |
83 | sleep 5; | |
84 | $p->reach(4); | |
85 | $p->reach(5, "Quintus!"); | |
86 | sleep 1; | |
87 | $p->done("All done"); | |
88 | } | |
89 | ||
90 | #-------------------------------------------------------------------------- | |
91 | 1; | |
92 | __END__ | |
93 |