view release on metacpan or  search on metacpan

utilities/totals  view on Meta::CPAN

}
continue
{
	# check for errors/warnings
	if ($@)
	{
		if ($@ =~ /^error:/i)
		{
			push (@error, ["$f[0]:$.", $@]);
		}
		else
		{
			push (@warn, ["$f[0]:$.", $@]);
		}
	}

	# get filename and reset line numbering w/ each file
	if (eof)	# test end of each @ARGV file (eof, *not* eof())
	{
		shift @f;
		close ARGV;
	}
}

print "\n";

$SIG{__WARN__} = sub { warn @_ };

# warn if no transactions have been seen
# - the log file was empty?
if ($DEBUG)
{
	warn "Warning: the given log file/s appear to be devoid of transactions!\n"
 		unless scalar %txn;
}

# add incomplete requests to suspect list
# - i.e. I've seen a PURCHASE/REFUND/COMPLETION request but haven't
#   seen a corresponding RESPONSE (approved or otherwise)
push @error, map {['-', "incomplete transaction, no RESPONSE for [$_]"]} 
	grep {defined $txn{$_}} keys %txn;

# print warnings
if (@warn)
{
	warn "Warning/s:\n";
	foreach my $t (@warn) { warn "  @{$t}\n"; }
}

# exit on errors, unless 'force' option is given
if (@error)
{
	warn "Error/s:\n";
	foreach my $t (@error) { warn "  @{$t}\n"; }
	exit 1 unless $opt{'force'};
}

# ok, print results

sub commify
# based on the "Perl Cookbook" recipe 2.17
{
	my $s;
	return map
	{
		$s = reverse $_;
		$s =~ s/(\w{3})(?=\w)(?!\w*\.)/$1,/g;
		scalar reverse $s;
	} @_;
}

sub print_summary
# print a  totals summary for a given 'summary structure'
# - [<unused>, AmtPurch, NumPurch, AmtRef, NumRef]
{
	my ($s) = @_;
	my ($ptot, $pnum, $pavg, $rtot, $rnum, $ravg, $nett);

	$ptot = sprintf '%.2f', ($s->[1] || 0) / 100;	# cents -> $
	$pnum = $s->[2] || 0;
	$pavg = sprintf '%.2f', $pnum ? $ptot / $pnum : 0;
	$rtot = sprintf '%.2f', ($s->[3] || 0) / 100;	# cents -> $
	$rnum = $s->[4] || 0;
	$ravg = sprintf '%.2f', $rnum ? $rtot / $rnum : 0;
	$nett = sprintf '%.2f', $ptot - $rtot;

	$_ =<<'	.';	s/^\t//mg;
	
	  Purchases: Total amount $%8s  Count %3s (Avg. $%6s)
	    Refunds: Total amount $%8s  Count %3s (Avg. $%6s)
	  --------------------------------------------------------------
	       Nett:              $%8s        %3s

	.
	printf $_, commify($ptot, $pnum, $pavg, $rtot, $rnum, $ravg, 
		$nett, $pnum + $rnum);
}


my $s;
# extract 'grand summary'
$s = delete $summary{'summary'};

my @a = sort keys %summary;

unless (@a)	# no results
{
	print "There were no transactions for ";
	print "Account [$account] " if defined $account;
	if (defined $date)
	{
		$date_re ? 
			print "Dates matching /$date/" :
			printf ('Date [%4d-%02d-%02d]', unpack('A4A2A2', $date));
	}
	print "all Accounts and Dates" unless (defined $account or defined $date);
	print ".\n\n";
}

# print 'grand summary' if more than one account has been extracted
if (@a > 1)