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


line stmt bran cond sub pod time code
1             package Log::Progress;
2             $Log::Progress::VERSION = '0.13';
3 6     6   7986 use Moo 2;
  6         36327  
  6         72  
4 6     6   5528 use Carp;
  6         16  
  6         313  
5 6     6   1745 use IO::Handle; # for 'autoflush'
  6         20046  
  6         1359  
6 6     6   2167 use JSON;
  6         25818  
  6         41  
7              
8             # ABSTRACT: Conveniently write progress messages to logger or file handle
9              
10              
11             has to => ( is => 'rw', isa => \&_assert_valid_output, default => sub { \*STDERR },
12             trigger => sub { delete $_[0]{_writer} } );
13             sub squelch {
14 1284     1284 1 1882 my $self= shift;
15 1284 50       2575 if (@_) { $self->_squelch(shift); $self->_calc_precision_squelch() }
  0         0  
  0         0  
16 1284         2657 $self->{squelch};
17             }
18             sub precision {
19 1295     1295 1 1888 my $self= shift;
20 1295 50       2726 if (@_) { $self->_precision(shift); $self->_calc_precision_squelch() }
  0         0  
  0         0  
21 1295         5975 $self->{precision};
22             }
23             has step_id => ( is => 'rw', default => sub { $ENV{PROGRESS_STEP_ID} },
24             trigger => sub { delete $_[0]{_writer} } );
25              
26             has current => ( is => 'rw' );
27             has total => ( is => 'rw' );
28              
29             has _writer => ( is => 'lazy' );
30             has _squelch => ( is => 'rw', init_arg => 'squelch' );
31             has _precision => ( is => 'rw', init_arg => 'precision' );
32             has _last_progress => ( is => 'rw' );
33              
34             sub BUILD {
35 33     33 0 299 shift->_calc_precision_squelch();
36             }
37              
38             sub _calc_precision_squelch {
39 33     33   60 my $self= shift;
40 33         177 my $squelch= $self->_squelch;
41 33         64 my $precision= $self->_precision;
42 33 100 100     187 if (!defined $squelch && !defined $precision) {
43 16         32 $squelch= .01;
44 16         26 $precision= 2;
45             } else {
46             # calculation for digit length of number of steps
47 17 100       77 defined $precision or $precision= int(log(1/$squelch)/log(10) + .99999);
48 17 100       53 defined $squelch or $squelch= 1/(10**$precision);
49             }
50 33         96 $self->{squelch}= $squelch;
51 33         435 $self->{precision}= $precision;
52             }
53              
54             sub _assert_valid_output {
55 33     33   745 my $to= shift;
56 33         137 my $type= ref $to;
57 33 50 66     1090 $type && (
      66        
58             $type eq 'GLOB'
59             or $type eq 'CODE'
60             or $type->can('print')
61             or $type->can('info')
62             ) or die "$to is not a file handle, logger object, or code reference";
63             }
64              
65             sub _build__writer {
66 17     17   262 my $self= shift;
67            
68 17 100       361 my $prefix= "progress: ".(defined $self->step_id? $self->step_id.' ' : '');
69 17         685 my $to= $self->to;
70 17         126 my $type= ref $to;
71 17 100 100     548 $to->autoflush(1) if $type eq 'GLOB' or $type->can('autoflush');
72 2     2   13 return ($type eq 'GLOB')? sub { print $to $prefix.join('', @_)."\n"; }
73 24     24   205 : ($type eq 'CODE')? sub { $to->($prefix.join('', @_)); }
74 118     118   2375 : ($type->can('print'))? sub { $to->print($prefix.join('', @_)."\n"); }
75 1     1   6 : ($type->can('info'))? sub { $to->info($prefix.join('', @_)); }
76 17 50       1405 : die "unhandled case";
    100          
    100          
    100          
77             }
78              
79              
80             sub at {
81 1281     1281 1 3427586 my ($self, $current, $total, $message)= @_;
82 1281 100       2495 if (defined $total) {
83 123         823 $self->total($total);
84             } else {
85 1158         1815 $total= $self->total;
86 1158 50       2142 $total= 1 unless defined $total;
87             }
88 1281         2714 $self->current($current);
89 1281 50       2636 my $progress= $total? $current / $total : 0;
90 1281         2315 my $sq= $self->squelch;
91 1281         2426 my $formatted= sprintf("%.*f", $self->precision, int($progress/$sq + .0000000001)*$sq);
92 1281 100 100     7244 return if defined $self->_last_progress
93             and abs($formatted - $self->_last_progress)+.0000000001 < $sq;
94 138         733 $self->_last_progress($formatted);
95 138 100       427 if ($total != 1) {
96 101 50       521 $formatted= (int($current) == $current)? "$current/$total"
97             : sprintf("%.*f/%d", $self->precision, $current, $total);
98             }
99 138 100       6866 $self->_writer->($formatted . ($message? " - $message":''));
100             }
101              
102             # backward compatibility with version <= 0.03
103             sub progress {
104 0     0 1 0 my ($self, $current, $total, $message)= @_;
105 0 0       0 $total= 1 unless defined $total;
106 0         0 $self->at($current, $total, $message);
107             }
108              
109              
110             sub inc {
111 0     0 1 0 my ($self, $offset, $message)= @_;
112 0 0       0 $offset= 1 unless defined $offset;
113 0   0     0 $self->at(($self->current || 0) + $offset, undef, $message);
114             }
115              
116              
117             sub data {
118 0     0 1 0 my ($self, $data)= @_;
119 0 0       0 ref $data eq 'HASH' or croak "data must be a hashref";
120 0         0 $self->_writer->(JSON->new->ascii->encode($data));
121             }
122              
123              
124             sub substep {
125 7     7 1 90 my ($self, $step_id, $step_contribution, $title)= @_;
126 7 50       48 length $title or croak "sub-step title is required";
127            
128 7 50 33     179 $step_id= $self->step_id . '.' . $step_id
129             if defined $self->step_id and length $self->step_id;
130            
131 7         207 my $sub_progress= ref($self)->new(
132             to => $self->to,
133             squelch => $self->_squelch,
134             precision => $self->_precision,
135             step_id => $step_id,
136             );
137            
138 7 50       25 if ($step_contribution) {
139 7         22 $sub_progress->_writer->(sprintf("(%.*f) %s", $self->precision, $step_contribution, $title));
140             } else {
141 0         0 $sub_progress->_writer->("- $title");
142             }
143            
144 7         435 return $sub_progress;
145             }
146              
147             1;
148              
149             __END__