summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:32:35 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:32:35 +0000
commit539135f1864a2356d0eb3666e0f5b335680872a4 (patch)
tree3b214294c17073dfdfbdba13b72b6fa2d10a0a6e /Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm
parent227723589c9564b9b2b7042dd27eb9aad56a560a (diff)
New tlperl part XII
git-svn-id: svn://tug.org/texlive/trunk@21434 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm93
1 files changed, 93 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm
new file mode 100644
index 00000000000..7de46d5696b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm
@@ -0,0 +1,93 @@
+
+require 5;
+package Pod::Simple::Progress;
+$VERSION = '3.14';
+use strict;
+
+# Objects of this class are used for noting progress of an
+# operation every so often. Messages delivered more often than that
+# are suppressed.
+#
+# There's actually nothing in here that's specific to Pod processing;
+# but it's ad-hoc enough that I'm not willing to give it a name that
+# implies that it's generally useful, like "IO::Progress" or something.
+#
+# -- sburke
+#
+#--------------------------------------------------------------------------
+
+sub new {
+ my($class,$delay) = @_;
+ my $self = bless {'quiet_until' => 1}, ref($class) || $class;
+ $self->to(*STDOUT{IO});
+ $self->delay(defined($delay) ? $delay : 5);
+ return $self;
+}
+
+sub copy {
+ my $orig = shift;
+ bless {%$orig, 'quiet_until' => 1}, ref($orig);
+}
+#--------------------------------------------------------------------------
+
+sub reach {
+ my($self, $point, $note) = @_;
+ if( (my $now = time) >= $self->{'quiet_until'}) {
+ my $goal;
+ my $to = $self->{'to'};
+ print $to join('',
+ ($self->{'quiet_until'} == 1) ? () : '... ',
+ (defined $point) ? (
+ '#',
+ ($goal = $self->{'goal'}) ? (
+ ' ' x (length($goal) - length($point)),
+ $point, '/', $goal,
+ ) : $point,
+ $note ? ': ' : (),
+ ) : (),
+ $note || '',
+ "\n"
+ );
+ $self->{'quiet_until'} = $now + $self->{'delay'};
+ }
+ return $self;
+}
+
+#--------------------------------------------------------------------------
+
+sub done {
+ my($self, $note) = @_;
+ $self->{'quiet_until'} = 1;
+ return $self->reach( undef, $note );
+}
+
+#--------------------------------------------------------------------------
+# Simple accessors:
+
+sub delay {
+ return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] }
+sub goal {
+ return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] }
+sub to {
+ return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] }
+
+#--------------------------------------------------------------------------
+
+unless(caller) { # Simple self-test:
+ my $p = __PACKAGE__->new->goal(5);
+ $p->reach(1, "Primus!");
+ sleep 1;
+ $p->reach(2, "Secundus!");
+ sleep 3;
+ $p->reach(3, "Tertius!");
+ sleep 5;
+ $p->reach(4);
+ $p->reach(5, "Quintus!");
+ sleep 1;
+ $p->done("All done");
+}
+
+#--------------------------------------------------------------------------
+1;
+__END__
+