[Summary view] [Print] [Text view]

   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