[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