File Coverage

blib/lib/Algorithm/Step.pm

Criterion	Covered	Total	%
statement	44	49	89.8
branch	6	10	60.0
condition			n/a
subroutine	8	8	100.0
pod	4	6	66.6
total	62	73	84.9

package Algorithm::Step;

use strict;
use warnings;

require Exporter;

our @ISA       = qw(Exporter);
our @EXPORT    = qw(step algorithm statistics end_algorithm);
our $VERSION   = 0.02;

my $algs = {};
my @algstack = ();
my $curralg;

sub algorithm {
	my ($name, $desc) = @_;
	if (!exists $algs->{$name}) {
		$algs->{$name} = {};
		$algs->{$name}->{desc} = $desc;
		$algs->{$name}->{steps} = {};
	}
	push @algstack, $name;
	$curralg = $name;
}

sub step {
	my @args = @_;
	my $argc = @_;
	my $refstep = $algs->{$curralg};
	foreach (0 .. $argc-2) {
		if (!exists $refstep->{steps}) {
			$refstep->{steps} = {};
		}
		$refstep = $refstep->{steps};
		if (!exists $refstep->{$args[$_]}) {
			$refstep->{$args[$_]} = {};
			$refstep->{$args[$_]}->{desc} = $args[$argc-1];
			$refstep->{$args[$_]}->{count} = 0;
		}
		$refstep=$refstep->{$args[$_]};
	}
	$refstep->{count}++;
}

sub statistics {
	print "\nSTATISTICS\n\n";
	foreach (keys %{$algs}) {
		print "Algorithm $_: $algs->{$_}->{desc}\n";
		my $name = $_;
		foreach (sort keys %{$algs->{$name}->{steps}}) {
			print_step($algs->{$name}->{steps}->{$_}, $_, 0);
		}
	}
}

sub print_step {
	my ($step, $id, $indent) = @_;
	my $i;
	for ($i = 0; $i < $indent; $i++) {
		print "  ";
	}
	print pad_dots("STEP $id. $step->{desc} ", 72), " [$step->{count}]\n";
	if (exists $step->{steps}) {
		foreach (sort keys %{$step->{steps}}) {
			print_step($step->{steps}->{$_}, "$id.$_", $indent+1);
		}
	}
}

sub pad_dots {
	my ($s, $len) = @_;
	return $s if $len <= (length $s);
	return $s . "." x ($len - length $s);
}

sub end_algorithm {
	pop @algstack;
	$curralg = pop @algstack;
	push @algstack, $curralg;
}

1;

__END__