r38960 - in /branches/upstream/libtime-progress-perl: ./ current/ current/Changes current/MANIFEST current/META.yml current/Makefile.PL current/Progress.pm current/README current/test.pl

nhandler-guest at users.alioth.debian.org nhandler-guest at users.alioth.debian.org
Tue Jun 30 02:30:08 UTC 2009


Author: nhandler-guest
Date: Tue Jun 30 02:30:00 2009
New Revision: 38960

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38960
Log:
[svn-inject] Installing original source of libtime-progress-perl

Added:
    branches/upstream/libtime-progress-perl/
    branches/upstream/libtime-progress-perl/current/
    branches/upstream/libtime-progress-perl/current/Changes
    branches/upstream/libtime-progress-perl/current/MANIFEST
    branches/upstream/libtime-progress-perl/current/META.yml
    branches/upstream/libtime-progress-perl/current/Makefile.PL
    branches/upstream/libtime-progress-perl/current/Progress.pm
    branches/upstream/libtime-progress-perl/current/README
    branches/upstream/libtime-progress-perl/current/test.pl

Added: branches/upstream/libtime-progress-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-progress-perl/current/Changes?rev=38960&op=file
==============================================================================
--- branches/upstream/libtime-progress-perl/current/Changes (added)
+++ branches/upstream/libtime-progress-perl/current/Changes Tue Jun 30 02:30:00 2009
@@ -1,0 +1,24 @@
+Revision history for Perl extension Time::Progress.
+
+1.5   Wed Feb  6 2009
+
+  - %LlEe formats can take optional width (%10e for example)
+
+1.4   Wed Feb  4 2009
+
+  - relicensed under same terms as Perl (i.e. incl. Artistic)
+
+1.3   Thu Nov 29 2007
+
+  - examples use positive numbers (note by  Johan Lindstrom)
+  - reset() may be used as attr()
+
+1.2   Fri Aug 26 2005
+
+  - estimate_str() fixed
+  - example in POD fixed
+
+0.01  Sun Oct 21 2001
+	- original version; created by h2xs 1.21 with options
+	- -X Time::Progress
+

Added: branches/upstream/libtime-progress-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-progress-perl/current/MANIFEST?rev=38960&op=file
==============================================================================
--- branches/upstream/libtime-progress-perl/current/MANIFEST (added)
+++ branches/upstream/libtime-progress-perl/current/MANIFEST Tue Jun 30 02:30:00 2009
@@ -1,0 +1,7 @@
+Changes
+Makefile.PL
+MANIFEST
+Progress.pm
+README
+test.pl
+META.yml                                 Module meta-data (added by MakeMaker)

Added: branches/upstream/libtime-progress-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-progress-perl/current/META.yml?rev=38960&op=file
==============================================================================
--- branches/upstream/libtime-progress-perl/current/META.yml (added)
+++ branches/upstream/libtime-progress-perl/current/META.yml Tue Jun 30 02:30:00 2009
@@ -1,0 +1,19 @@
+--- #YAML:1.0
+name:               Time-Progress
+version:            1.5
+abstract:           Elapsed and estimated finish time reporting.
+author:
+    - Vladi Belperchinov-Shabanski <cade at biscom.net>
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+requires:  {}
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.48
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Added: branches/upstream/libtime-progress-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-progress-perl/current/Makefile.PL?rev=38960&op=file
==============================================================================
--- branches/upstream/libtime-progress-perl/current/Makefile.PL (added)
+++ branches/upstream/libtime-progress-perl/current/Makefile.PL Tue Jun 30 02:30:00 2009
@@ -1,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'Time::Progress',
+    'VERSION_FROM'	=> 'Progress.pm', # finds $VERSION
+    'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => 'Progress.pm', # retrieve abstract from module
+       AUTHOR     => 'Vladi Belperchinov-Shabanski <cade at biscom.net>') : ()),
+);

Added: branches/upstream/libtime-progress-perl/current/Progress.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-progress-perl/current/Progress.pm?rev=38960&op=file
==============================================================================
--- branches/upstream/libtime-progress-perl/current/Progress.pm (added)
+++ branches/upstream/libtime-progress-perl/current/Progress.pm Tue Jun 30 02:30:00 2009
@@ -1,0 +1,397 @@
+package Time::Progress;
+use Exporter;
+our @ISA = qw( Exporter );
+our @EXPORT = qw(  );
+our $VERSION = '1.5';
+use strict;
+use warnings;
+use Carp;
+
+our %ATTRS =  (
+              min => 1,
+              max => 1,
+              format => 1,
+              );
+
+sub new
+{
+  my $class = shift;
+  my $self = { min => 0, max => 100 };
+  bless $self;
+  $self->attr( @_ );
+  $self->restart();
+  return $self;
+}
+
+sub attr
+{
+  my $self = shift;
+  croak "bad number of attribute/value pairs" unless @_ == 0 or @_ % 2 == 0;
+  my @ret;
+  my %h = @_;
+  for( keys %h )
+    {
+    croak "invalid attribute name: $_" unless $ATTRS{ $_ };
+    $self->{ $_ } = $h{ $_ } if defined $h{ $_ };
+    push @ret, $self->{ $_ };
+    }
+  return @ret;
+}
+
+sub restart
+{
+  my $self = shift;
+  my @ret = $self->attr( @_ );
+  $self->{ 'start' } = time();
+  $self->{ 'stop'  } = undef;
+  return @ret;
+}
+
+sub stop
+{
+  my $self = shift;
+  $self->{ 'stop'  } = time();
+}
+
+sub continue
+{
+  my $self = shift;
+  $self->{ 'stop'  } = undef;
+}
+
+sub report
+{
+  my $self = shift;
+  my $format = shift || $self->{ 'format' };
+  my $cur = shift;
+
+  my $start = $self->{ 'start' };
+
+  my $now = $self->{ 'stop' } || time();
+
+  croak "use restart() first" unless $start > 0;
+  croak "time glitch (running backwards?)" if $now < $start;
+  croak "empty format, use format() first" unless $format;
+
+  my $l = $now - $start;
+  my $L = sprintf "%3d:%02d", int( $l / 60 ), ( $l % 60 );
+
+  my $min = $self->{ 'min' };
+  my $max = $self->{ 'max' };
+  $cur = $min unless defined $cur;
+
+  my $b  = 'n/a';
+  my $bl = 79;
+
+  if ( $format =~ /%(\d*)[bB]/ )
+    {
+    $bl = $1;
+    $bl = 79 if $bl eq '' or $bl < 1;
+    }
+
+  my $e = "n/a";
+  my $E = "n/a";
+  my $f = "n/a";
+  my $p = "n/a";
+
+  if ( (($min <= $cur and $cur <= $max) or ($min >= $cur and $cur >= $max)) )
+    {
+    if ( $cur - $min == 0 )
+      {
+      $e = 0;
+      }
+    else
+      {
+      $e = $l * ( $max - $min ) / ( $cur - $min );
+      $e = int( $e - $l );
+      $e = 0 if $e < 0;
+      }
+    $E = sprintf "%3d:%02d", int( $e / 60 ), ( $e % 60 );
+
+    $f = $now + $e;
+    $f = localtime( $f );
+
+    if ( $max - $min != 0 )
+      {
+      $p = 100 * ( $cur - $min ) / ( $max - $min );
+      $b = '#' x int( $bl * $p / 100 ) . '.' x $bl;
+      $b = substr $b, 0, $bl;
+      $p = sprintf "%5.1f%%", $p;
+      }
+    }
+
+  $format =~ s/%(\d*)l/$self->sp_format( $l, $1 )/ge;
+  $format =~ s/%(\d*)L/$self->sp_format( $L, $1 )/ge;
+  $format =~ s/%(\d*)e/$self->sp_format( $e, $1 )/ge;
+  $format =~ s/%(\d*)E/$self->sp_format( $E, $1 )/ge;
+  $format =~ s/%p/$p/g;
+  $format =~ s/%f/$f/g;
+  $format =~ s/%\d*[bB]/$b/g;
+
+  return $format;
+}
+
+sub sp_format
+{
+  my $self = shift;
+
+  my $val  = shift;
+  my $len  = shift;
+
+  return $val unless $len ne '' and $len > 0;
+  return sprintf( "%${len}s", $val );
+}
+
+sub elapsed
+{ my $self = shift; return $self->report("%l"); }
+
+sub elapsed_str
+{ my $self = shift; return $self->report("elapsed time is %L min.\n"); }
+
+sub estimate
+{ my $self = shift; return $self->report("%e"); }
+
+sub estimate_str
+{ my $self = shift; return $self->report("remaining time is %E min.\n"); }
+
+1;
+
+=pod
+
+=head1 NAME
+
+Time::Progress - Elapsed and estimated finish time reporting.
+
+=head1 SYNOPSIS
+
+  use Time::Progress;
+  # autoflush to get \r working
+  $| = 1;
+  # get new `timer'
+  my $p = new Time::Progress;
+
+  # restart and report progress
+  $p->restart;
+  sleep 5; # or do some work here
+  print $p->report( "done %p elapsed: %L (%l sec), ETA %E (%e sec)\n", 50 );
+
+  # set min and max values
+  $p->attr( min => 2, max => 20 );
+  # restart `timer'
+  $p->restart;
+  my $c;
+  for( $c = 2; $c <= 20; $c++ )
+    {
+    # print progress bar and percentage done
+    print $p->report( "eta: %E min, %40b %p\r", $c );
+    sleep 1; # work...
+    }
+  # stop timer
+  $p->stop;
+
+  # report times
+  print $p->elapsed_str;
+
+=head1 DESCRIPTION
+
+Shortest time interval that can be measured is 1 second. The available methods are:
+
+=over 4
+
+=item new
+
+  my $p = new Time::Progress;
+
+Returns new object of Time::Progress class and starts the timer. It
+also sets min and max values to 0 and 100, so the next B<report> calls will
+default to percents range.
+
+=item restart
+
+restarts the timer and clears the stop mark. optionally restart() may act also
+as attr() for setting attributes:
+
+  $p->restart( min => 1, max => 5 );
+
+is the same as:
+
+  $p->attr( min => 1, max => 5 );
+  $p->restart();
+
+If you need to count things, you can set just 'max' attribute since 'min' is
+already set to 0 when object is constructed by new():
+
+  $p->restart( max => 42 );
+
+=item stop
+
+Sets the stop mark. this is only usefull if you do some work, then finish,
+then do some work that shouldn't be timed and finally report. Something
+like:
+
+  $p->restart;
+  # do some work here...
+  $p->stop;
+  # do some post-work here
+  print $p->report;
+  # `post-work' will not be timed
+
+Stop is useless if you want to report time as soon as work is finished like:
+
+  $p->restart;
+  # do some work here...
+  print $p->report;
+
+=item continue
+
+Clears the stop mark. (mostly useless, perhaps you need to B<restart>?)
+
+=item attr
+
+Sets and returns internal values for attributes. Available attributes are:
+
+=over 4
+
+=item min
+
+This is the min value of the items that will follow (used to calculate
+estimated finish time)
+
+=item max
+
+This is the max value of all items in the even (also used to calculate
+estimated finish time)
+
+=item format
+
+This is the default B<report> format. It is used if B<report> is called
+without parameters.
+
+=back
+
+B<attr> returns array of the set attributes:
+
+  my ( $new_min, $new_max ) = $p->attr( min => 1, max => 5 );
+
+If you want just to get values use undef:
+
+  my $old_format = $p->attr( format => undef );
+
+This way of handling attributes is a bit heavy but saves a lot
+of attribute handling functions. B<attr> will complain if you pass odd number
+of parameters.
+
+=item report
+
+B<report> is the most complex method in this package! :)
+
+expected arguments are:
+
+  $p->report( format, [current_item] );
+
+I<format> is string that will be used for the result string. Recognized
+special sequences are:
+
+=over 4
+
+=item %l
+
+elapsed seconds
+
+=item %L
+
+elapsed time in minutes in format MM:SS
+
+=item %e
+
+remaining seconds
+
+=item %E
+
+remaining time in minutes in format MM:SS
+
+=item %p
+
+percentage done in format PPP.P%
+
+=item %f
+
+estimated finish time in format returned by B<localtime()>
+
+=item %b
+
+=item %B
+
+progress bar which looks like:
+
+  ##############......................
+
+%b takes optional width:
+
+  %40b -- 40-chars wide bar
+  %9b  --  9-chars wide bar
+  %b   -- 79-chars wide bar (default)
+
+=back
+
+Parameters can be ommited and then default format set with B<attr> will
+be used.
+
+Sequences 'L', 'l', 'E' and 'e' can have width also:
+
+  %10e
+  %5l
+  ...
+
+Estimate time calculations can be used only if min and max values are set
+(see B<attr> method) and current item is passed to B<report>! if you want
+to use the default format but still have estimates use it like this:
+
+  $p->format( undef, 45 );
+
+If you don't give current item (step) or didn't set proper min/max value
+then all estimate sequences will have value `n/a'.
+
+You can freely mix reports during the same event.
+
+=item elapsed
+
+=item estimated
+
+=item elapsed_str
+
+=item estimated_str
+
+helpers -- return elapsed/estimated seconds or string in format:
+
+  "elapsed time is MM:SS min.\n"
+  "remaining time is MM:SS min.\n"
+
+=back
+
+=head1 FORMAT EXAMPLES
+
+  # $c is current element (step) reached
+  # for the examples: min = 0, max = 100, $c = 33.3
+
+  print $p->report( "done %p elapsed: %L (%l sec), ETA %E (%e sec)\n", $c );
+  # prints:
+  # done  33.3% elapsed time   0:05 (5 sec), ETA   0:07 (7 sec)
+
+  print $p->report( "%45b %p\r", $c );
+  # prints:
+  # ###############..............................  33.3%
+
+  print $p->report( "done %p ETA %f\n", $c );
+  # prints:
+  # done  33.3% ETA Sun Oct 21 16:50:57 2001
+
+=head1 AUTHOR
+
+  Vladi Belperchinov-Shabanski "Cade"
+
+  <cade at biscom.net> <cade at datamax.bg> <cade at cpan.org>
+
+  http://cade.datamax.bg
+
+=cut

Added: branches/upstream/libtime-progress-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-progress-perl/current/README?rev=38960&op=file
==============================================================================
--- branches/upstream/libtime-progress-perl/current/README (added)
+++ branches/upstream/libtime-progress-perl/current/README Tue Jun 30 02:30:00 2009
@@ -1,0 +1,22 @@
+Time/Progress
+=========================
+
+  Time::Progress - Elapsed and estimated finish time reporting.
+
+INSTALLATION
+
+To install this module type the following:
+
+  perl Makefile.PL
+  make
+  make test
+  make install
+
+COPYRIGHT AND LICENCE
+
+  Copyright (C) 2001-2009 Vladi Belperchinov-Shabanski <cade at biscom.net>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the same terms as Perl itself.
+
+

Added: branches/upstream/libtime-progress-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-progress-perl/current/test.pl?rev=38960&op=file
==============================================================================
--- branches/upstream/libtime-progress-perl/current/test.pl (added)
+++ branches/upstream/libtime-progress-perl/current/test.pl Tue Jun 30 02:30:00 2009
@@ -1,0 +1,17 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+BEGIN { plan tests => 1 };
+use Time::Progress;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+




More information about the Pkg-perl-cvs-commits mailing list