File Coverage

blib/lib/Log/Progress/Parser.pm

Criterion	Covered	Total	%
statement	57	61	93.4
branch	25	34	73.5
condition	8	12	66.6
subroutine	5	5	100.0
pod	2	2	100.0
total	97	114	85.0

package Log::Progress::Parser;
$Log::Progress::Parser::VERSION = '0.11';
use Moo 2;
use JSON;

# ABSTRACT: Parse progress data from a file


has input     => ( is => 'rw' );
has input_pos => ( is => 'rw' );
has state     => ( is => 'rw', default => sub { {} } );
*status= *state;  # alias, since I changed the API
has sticky_message => ( is => 'rw' );
has on_data   => ( is => 'rw' );


sub parse {
	my $self= shift;
	my $fh= $self->input;
	if (!ref $fh) {
		my $input= $fh;
		undef $fh;
		open $fh, '<', \$input or die "open(scalar): $!";
	}
	if ($self->input_pos) {
		seek($fh, $self->input_pos, 0)
			or die "seek: $!";
	}
	# TODO: If input is seekable, then seek to end and work backward
	#  Substeps will make that rather complicated.
	my $pos;
	my %parent_cleanup;
	local $_;
	while (<$fh>) {
		last unless substr($_,-1) eq "\n";
		$pos= tell($fh);
		next unless $_ =~ /^progress: (([[:alpha:]][\w.]*) )?(.*)/;
		my ($step_id, $remainder)= ($2, $3);
		my $state= $self->step_state($step_id, 1, \my @state_parent);
		# First, check for progress number followed by optional message
		if ($remainder =~ m,^([\d.]+)(/(\d+))?( (.*))?,) {
			my ($num, $denom, $message)= ($1, $3, $5);
			if (defined $message) {
				$message =~ s/^- //; # "- " is optional syntax
				$state->{message}= $message;
			} else {
				$state->{message}= '' if !defined $state->{message} or !$self->sticky_message;
			}
			$state->{progress}= $num+0;
			if (defined $denom) {
				$state->{current}= $num;
				$state->{total}= $denom;
				$state->{progress} /= $denom;
			}
			if ($state->{contribution}) {
				# Need to apply progress to parent nodes at end
				$parent_cleanup{$state_parent[$_]}= [ $_, $state_parent[$_] ]
					for 0..$#state_parent;
			}
		}
		elsif ($remainder =~ m,^\(([\d.]+)\) (.*),) {
			my ($contribution, $title)= ($1, $2);
			$title =~ s/^- //; # "- " is optional syntax
			$state->{title}= $title;
			$state->{contribution}= $contribution+0;
		}
		elsif ($remainder =~ /^\{/) {
			my $data= JSON->new->decode($remainder);
			$state->{data}= !defined $self->on_data? $data
				: $self->on_data->($self, $step_id, $data);
		}
		else {
			warn "can't parse progress message \"$remainder\"\n";
		}
	}
	# Mark file position for next call
	$self->input_pos($pos);
	# apply child progress contributions to parent nodes
	for (sort { $b->[0] <=> $a->[0] } values %parent_cleanup) {
		my $state= $_->[1];
		$state->{progress}= 0;
		for (values %{$state->{step}}) {
			$state->{progress} += $_->{progress} * $_->{contribution}
				if $_->{progress} && $_->{contribution};
		}
	}
	return $self->state;
}


sub step_state {
	my ($self, $step_id, $create, $path)= @_;
	my $state= $self->state;
	if (defined $step_id and length $step_id) {
		for (split /\./, $step_id) {
			push @$path, $state if $path;
			$state= ($state->{step}{$_} or do {
				return undef unless $create;
				my $idx= scalar(keys %{$state->{step}});
				$state->{step}{$_}= { idx => $idx };
			});
		}
	}
	$state;
}

1;

__END__