3 package Pod::Simple::Progress;
7 # Objects of this class are used for noting progress of an
8 # operation every so often. Messages delivered more often than that
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.
17 #--------------------------------------------------------------------------
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);
29 bless {%$orig, 'quiet_until' => 1}, ref($orig);
31 #--------------------------------------------------------------------------
34 my($self, $point, $note) = @_;
35 if( (my $now = time) >= $self->{'quiet_until'}) {
37 my $to = $self->{'to'};
39 ($self->{'quiet_until'} == 1) ? () : '... ',
42 ($goal = $self->{'goal'}) ? (
43 ' ' x (length($goal) - length($point)),
51 $self->{'quiet_until'} = $now + $self->{'delay'};
56 #--------------------------------------------------------------------------
59 my($self, $note) = @_;
60 $self->{'quiet_until'} = 1;
61 return $self->reach( undef, $note );
64 #--------------------------------------------------------------------------
68 return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] }
70 return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] }
72 return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] }
74 #--------------------------------------------------------------------------
76 unless(caller) { # Simple self-test:
77 my $p = __PACKAGE__->new->goal(5);
78 $p->reach(1, "Primus!");
80 $p->reach(2, "Secundus!");
82 $p->reach(3, "Tertius!");
85 $p->reach(5, "Quintus!");
90 #--------------------------------------------------------------------------