File Coverage

blib/lib/Log/Progress.pm

Criterion	Covered	Total	%
statement	63	77	81.8
branch	34	50	68.0
condition	14	20	70.0
subroutine	16	19	84.2
pod	7	8	87.5
total	134	174	77.0

package Log::Progress;
$Log::Progress::VERSION = '0.13';
use Moo 2;
use Carp;
use IO::Handle; # for 'autoflush'
use JSON;

# ABSTRACT: Conveniently write progress messages to logger or file handle


has to         => ( is => 'rw', isa => \&_assert_valid_output, default => sub { \*STDERR },
                    trigger => sub { delete $_[0]{_writer} } );
sub squelch    {
	my $self= shift;
	if (@_) { $self->_squelch(shift); $self->_calc_precision_squelch() }
	$self->{squelch};
}
sub precision  {
	my $self= shift;
	if (@_) { $self->_precision(shift); $self->_calc_precision_squelch() }
	$self->{precision};
}
has step_id    => ( is => 'rw', default => sub { $ENV{PROGRESS_STEP_ID} },
                    trigger => sub { delete $_[0]{_writer} } );

has current    => ( is => 'rw' );
has total      => ( is => 'rw' );

has _writer    => ( is => 'lazy' );
has _squelch   => ( is => 'rw', init_arg => 'squelch' );
has _precision => ( is => 'rw', init_arg => 'precision' );
has _last_progress => ( is => 'rw' );

sub BUILD {
	shift->_calc_precision_squelch();
}

sub _calc_precision_squelch {
	my $self= shift;
	my $squelch= $self->_squelch;
	my $precision= $self->_precision;
	if (!defined $squelch && !defined $precision) {
		$squelch= .01;
		$precision= 2;
	} else {
		# calculation for digit length of number of steps
		defined $precision or $precision= int(log(1/$squelch)/log(10) + .99999);
		defined $squelch or $squelch= 1/(10**$precision);
	}
	$self->{squelch}= $squelch;
	$self->{precision}= $precision;
}

sub _assert_valid_output {
	my $to= shift;
	my $type= ref $to;
	$type && (
		$type eq 'GLOB'
		or $type eq 'CODE'
		or $type->can('print')
		or $type->can('info')
	) or die "$to is not a file handle, logger object, or code reference";
}

sub _build__writer {
	my $self= shift;

	my $prefix= "progress: ".(defined $self->step_id? $self->step_id.' ' : '');
	my $to= $self->to;
	my $type= ref $to;
	$to->autoflush(1) if $type eq 'GLOB' or $type->can('autoflush');
	return ($type eq 'GLOB')? sub { print $to $prefix.join('', @_)."\n"; }
		:  ($type eq 'CODE')? sub { $to->($prefix.join('', @_)); }
		:  ($type->can('print'))? sub { $to->print($prefix.join('', @_)."\n"); }
		:  ($type->can('info'))? sub { $to->info($prefix.join('', @_)); }
		: die "unhandled case";
}


sub at {
	my ($self, $current, $total, $message)= @_;
	if (defined $total) {
		$self->total($total);
	} else {
		$total= $self->total;
		$total= 1 unless defined $total;
	}
	$self->current($current);
	my $progress= $total? $current / $total : 0;
	my $sq= $self->squelch;
	my $formatted= sprintf("%.*f", $self->precision, int($progress/$sq + .0000000001)*$sq);
	return if defined $self->_last_progress
	      and abs($formatted - $self->_last_progress)+.0000000001 < $sq;
	$self->_last_progress($formatted);
	if ($total != 1) {
		$formatted= (int($current) == $current)? "$current/$total"
			: sprintf("%.*f/%d", $self->precision, $current, $total);
	}
	$self->_writer->($formatted . ($message? " - $message":''));
}

# backward compatibility with version <= 0.03
sub progress {
	my ($self, $current, $total, $message)= @_;
	$total= 1 unless defined $total;
	$self->at($current, $total, $message);
}


sub inc {
	my ($self, $offset, $message)= @_;
	$offset= 1 unless defined $offset;
	$self->at(($self->current || 0) + $offset, undef, $message);
}


sub data {
	my ($self, $data)= @_;
	ref $data eq 'HASH' or croak "data must be a hashref";
	$self->_writer->(JSON->new->ascii->encode($data));
}


sub substep {
	my ($self, $step_id, $step_contribution, $title)= @_;
	length $title or croak "sub-step title is required";

	$step_id= $self->step_id . '.' . $step_id
		if defined $self->step_id and length $self->step_id;

	my $sub_progress= ref($self)->new(
		to        => $self->to,
		squelch   => $self->_squelch,
		precision => $self->_precision,
		step_id   => $step_id,
	);

	if ($step_contribution) {
		$sub_progress->_writer->(sprintf("(%.*f) %s", $self->precision, $step_contribution, $title));
	} else {
		$sub_progress->_writer->("- $title");
	}

	return $sub_progress;
}

1;

__END__