bc42a952dc356aeb2eea05d75e0ccaa192d94041
[perl.git] / ext / Pod-Simple / lib / Pod / Simple / Progress.pm
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