git.maemo.org Git - pkg-perl/blob - deb-src/libpod-simple-perl/libpod-simple-perl-3.07/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