[yapc] Damian's .exrc?
Damian Conway
damian at conway.org
Wed Jul 9 11:30:25 CDT 2003
Hi Terry.
> THANK YOU! I've already extracted a few nuggets and posted
> explainations so people in my group can take advantage of some things.
Glad to hear it's been useful to you. :-)
> If you would, kind sir, make available the code that generated the code
> to show a "progress bar" (seen in the last plenary session), I'd be vey
> grateful again. TIA
I've attached an (undocumented) alpha. Good luck! ;-)
Damian
-------------- next part --------------
package IO::Progress;
use base Exporter; @EXPORT = qw(progress);
use Carp;
use Text::Reform 'form';
my $form = "\r<"x78;
my %field = ( msg=>{cnt=>0}, expect=>{fld=>'msg',cnt=>0} );
my @fields = ("");
my ($display, $prevdisplay) = ("","");
my $USAGE_FORM = <<'EOUSAGE';
Usage: progress form=>[$template, 'Field1', 'Field2'...]
Error in call to &progress
EOUSAGE
my $USAGE_NEXT = <<'EOUSAGE';
Usage: progress next=>['Field1', 'Field2', {Field3=>newval}...]
Error in call to &progress
EOUSAGE
my $USAGE_FLD = <<'EOUSAGE';
Usage: progress Field1=>'msg', Field2=>'msg'...]
Error in call to &progress
EOUSAGE
sub check {
my $USAGE = shift;
my @invalid = grep !(length && exists $field{$_}), @_;
croak "Unknown field", (@invalid==1?"":"s"),
": @_\n\n", $USAGE if @invalid;
return @_;
}
my $form_marker = join "|", map quotemeta, qw([[ || ]] << ^^ >> ~);
my $is_form = qr/^$form_marker|[^\\]$form_marker/;
sub desc_time {
my ($seconds) = @_;
return "unknown amount of time" if $seconds eq '???';
my $hours = int($seconds/3600); $seconds -= 3600*$hours;
my $minutes = int($seconds/60); $seconds -= 60*$minutes;
my $remaining;
if ($hours) {
$remaining =
$minutes < 10 ? "about $hours hour".($hours==1?"":"s")
: $minutes < 25 ? "less than $hours.5 hours"
: $minutes < 40 ? "about $hours.5 hours"
: "less than ".($hours+1)." hours";
}
elsif ($minutes) {
$remaining = "about $minutes minutes";
chop $remaining if $minutes == 1;
}
else {
$remaining = "$seconds seconds";
chop $remaining if $seconds == 1;
}
return $remaining;
}
sub set_ETA {
my ($elapsed) = @_;
$field{elapsed}{cnt} = $elapsed;
$field{elapsed}{msg} = desc_time($elapsed);
my $predicted = $field{expect}{cnt} && $field{expect}{cnt} =~ /^\d+$/
? int($field{expect}{cnt} /
($field{$field{expect}{fld}}{cnt}||1) *
$field{elapsed}{cnt} - $field{elapsed}{cnt} + 1)
: "???";
$field{remaining}{cnt} = $predicted;
$field{remaining}{msg} = desc_time($predicted);
}
sub decode {
my ($form_allowed, $form, @fields) = @_;
$form = "%s" unless defined $form;
my $formtype = ref $form;
if ($formtype eq 'CODE') {
local *_ = $fields[0];
return $form->(@fields);
}
if ($formtype eq 'ARRAY') {
my @part = map { defined($_) ? $_ : "" } @$form[0..2];
return $part[0] . ($part[1]x$fields[0]) . $part[2];
}
if ($form_allowed && $form =~ $is_form ) {
return form $form, @fields;
}
if ( $form =~ /%[-+ 0#*hLlqVv0-9.]*[%bcDdEeFfGginOopsUuXx]\b/) {
return sprintf $form, @fields
}
return $form;
}
my $start_time = time();
sub progress {
my %arg = @_;
if ($arg{form}) {
croak $USAGE_FORM if ref($arg{form}) ne 'ARRAY';
($form, @fields, %field) = @{$arg{form}};
@field{@fields} = map {fld=>$_, cnt=>0}, (0..$#fields);
$field{msg} = {cnt=>0};
$field{expect} = {fld=>'msg',cnt=>0};
$start_time = time();
return unless keys %arg > 1;
}
$field{msg}{cnt}++;
if ($arg{next}) {
$arg{next} = [$arg{next}] if ref($arg{next}) eq 'HASH';
croak $USAGE_NEXT if ref($arg{next}) ne 'ARRAY';
my @next = @{$arg{next}};
for my $next (@next) {
if (ref($next) eq 'HASH') {
for (check $USAGE_NEXT, keys %$next) {
$field{$_}{cnt} = $next->{$_};
}
}
else {
check $USAGE_NEXT, $next;
$field{$next}{cnt}++;
}
}
}
if (exists $arg{expect}) {
my $type = ref $arg{expect};
if ($type eq 'ARRAY') {
croak "Only one expectation allowed"
if @{$arg{expect}} > 2;
}
elsif ($type eq 'HASH') {
croak "Only one expectation allowed"
if keys %{$arg{expect}} > 1;
$arg{expect} = [ %{$arg{expect}} ];
}
else {
$arg{expect} = [ 'msg', $arg{expect} ];
}
$field{expect}{fld} = $arg{expect}[0];
$field{expect}{cnt} = $arg{expect}[1];
}
set_ETA(time()-$start_time);
$prevdisplay = $display;
if (exists $arg{msg}) {
$display = decode(1,$arg{msg},$field{msg}{cnt});
goto OUTPUT;
}
for my $field (check $USAGE_FLD, grep /^[A-Z]/, keys %arg) {
$field{$field}{msg} = $arg{$field};
}
($display = decode 1, $form,
map { decode 0, @{$_}{'msg','cnt'} } @field{@fields})
=~ s/\n.*//s;
OUTPUT:
local $|=1;
print "\r", " " x length($prevdisplay), "\r$display" if -t;
select undef, undef, undef, $arg{pause} if $arg{pause};
$start_time = time() if $display =~ /\n\z/;
}
1;
-------------- next part --------------
#! /usr/bin/perl -w
use IO::Progress;
progress msg=>[qw(Loading .)], pause=>1 for 0..5;
progress msg=>[qw(Loading . done)], pause=>2;
for (1..1000) {
$value = rand 30;
progress msg=>[qw(| - |)], next=>{msg=>$value};
}
progress form=>["Volume: 0|<<<<<<<<<<<|11", Volume];
for (1..1000) {
$value = rand 11;
progress Volume=>'*'x$value;
}
progress form=>["L [>>>>>>>>>>] [<<<<<<<<<<<] R", Left, Right ];
for (1..1000) {
($left, $right) = (rand 10, rand 10);
progress Left=>'|'x$left, Right=>'|'x$right;
}
-------------- next part --------------
use IO::Progress;
progress form=>["Step %s, Processed %s of %s in %s (%s to go)",
'msg', 'Seen', 'expect', 'elapsed', 'remaining'];
for (1..20) {
progress next=>['Seen'], expect=>20, pause=>0.4;
}
progress msg=>"Done\n", next=>{Seen=>0}, expect=>{Seen=>200};
for (1..200) {
progress next=>['Seen'], pause=>0.4;
}
-------------- next part --------------
use IO::Progress;
progress form=>[">>>>: phase <<<< [ |||| ]",
Step, Phase, Status,
];
for (1..5) {
progress Status=>"on", Step=>"%d", Phase=>"%d", pause=>1;
progress next=>[Step];
progress next=>[Phase] unless $_%3;
progress Status=>"off", pause=>1;
}
progress msg=>"Done\n";
More information about the yapc
mailing list