File Coverage

blib/lib/App/JobLog/Log/Line.pm
Criterion Covered Total %
statement 157 165 95.1
branch 52 74 70.2
condition 10 25 40.0
subroutine 28 28 100.0
pod 21 22 95.4
total 268 314 85.3


line stmt bran cond sub pod time code
1             package App::JobLog::Log::Line;
2             $App::JobLog::Log::Line::VERSION = '1.040';
3             # ABSTRACT: encapsulates one line of log text
4              
5              
6 5     5   4679 use Modern::Perl;
  5         13239  
  5         29  
7 5     5   1559 use Class::Autouse qw{DateTime};
  5         6709  
  5         34  
8 5     5   1944 use autouse 'App::JobLog::Time' => qw(now tz);
  5         761  
  5         36  
9              
10             # represents a single non-comment line in the log
11             # not using Moose to keep CLI snappy
12              
13             # to_string method for convenience
14 5     5   2018 use overload '""' => \&to_string;
  5         1112  
  5         41  
15 5     5   380 use overload 'bool' => sub { 1 };
  5     4358   9  
  5         27  
  4358         22518  
16              
17             # some global variables for use in BNF regex
18             our ( $date, @tags, @description, $is_beginning, $is_note );
19              
20             # log line parser
21             our $re = qr{
22             ^ (?&ts) (?&non_ts) $
23             (?(DEFINE)
24 24472         182491 (? (\d{4}\s++\d++\s++\d++\s++\d++\s++\d++\s++\d++) (?{$date = $^N}) )
25             (? (?¬e) | (?&duration_mark) )
26             (? : (?: (?&done) | (?&event) ) )
27             (? DONE )
28 203         1360 (? (?&event) (?{$is_note = 1}) )
29 20363         145996 (? (?&tags) : (?&descriptions) (?{$is_beginning = 1}) )
30             (? (?:(?&tag)(\s++(?&tag))*+)?)
31 19704         452244 (? ((?:[^\s:\\]|(?&escaped))++) (?{push @tags, $^N}))
32             (? \\.)
33             (? (?: (?&description) (?: ; \s*+ (?&description) )*+ )? )
34 18545         89881 (? ((?:[^;\\]|(?&escaped))++) (?{push @description, $^N}))
35             )
36             }xi;
37              
38              
39             sub new {
40 568     568 1 144193 my ( $class, @args ) = @_;
41 568   33     2583 $class = ref $class || $class;
42 568         1679 my %opts = @args;
43              
44             # validate %opts
45 568         1218 my $self = bless {}, $class;
46 568 100       2424 if ( exists $opts{comment} ) {
    100          
    100          
    50          
47 73         224 $self->{comment} = $opts{comment};
48 73         150 delete $opts{comment};
49 73 50       199 die 'inconsistent arguments: ' . join( ', ', @args ) if keys %opts;
50             }
51             elsif ( exists $opts{done} ) {
52 1         3 my $time = $opts{time};
53 1 50 33     4 die "invalid value for time: $time"
54             if $time && ref $time ne 'DateTime';
55 1   33     48 $self->{time} = $time || now;
56 1         39 $self->{done} = 1;
57 1         3 delete $opts{done};
58 1         3 delete $opts{time};
59 1 50       5 die 'inconsistent arguments: ' . join( ', ', @args ) if keys %opts;
60             }
61             elsif ( exists $opts{time} ) {
62 493         885 my $time = $opts{time};
63 493 50 33     1494 die "invalid value for time: $time"
64             if $time && ref $time ne 'DateTime';
65 493         21652 $self->{time} = $time;
66 493         808 my $tags = $opts{tags};
67 493 50 66     1489 die 'invalid value for tags: ' . $tags
68             if defined $tags && ref $tags ne 'ARRAY';
69 493 100       1244 unless ($tags) {
70 486         853 $tags = [];
71 486         1142 $self->{tags_unspecified} = 1;
72             }
73 493         922 $self->{tags} = $tags;
74 493         991 my $description = $opts{description};
75 493 100       1505 if ( my $type = ref $description ) {
    100          
76 1 50       5 die 'invalid type for description: ' . $type
77             unless $type eq 'ARRAY';
78 1         3 $self->{description} = $description;
79             }
80             elsif ( defined $description ) {
81              
82             # normalize whitespace; this is useful for testing
83 401         1748 $description =~ s/^\s++|\s++$//g;
84 401         808 $description =~ s/\s++/ /g;
85            
86 401         1003 $description = [$description];
87             }
88             else {
89 91         159 $description = [];
90             }
91 493         982 $self->{description} = $description;
92 493         1396 delete @opts{qw(time tags description)};
93 493 50       1567 die 'inconsistent arguments: ' . join( ', ', @args ) if keys %opts;
94             }
95             elsif ( exists $opts{text} ) {
96 0 0       0 die 'text lines in log must be blank' if $opts{text} =~ /\S/;
97 0         0 $self->{text} = $opts{text} . '';
98 0         0 delete $opts{text};
99 0 0       0 die 'inconsistent arguments: ' . join( ', ', @args ) if keys %opts;
100             }
101 568         2244 return $self;
102             }
103              
104              
105             sub parse {
106 28745     28745 1 1279084 my ( $class, $text ) = @_;
107 28745         108199 my $obj = bless { text => $text }, $class;
108 28745 100       145936 if ( $text =~ /^\s*(?:#\s*+(.*?)\s*)?$/ ) {
109 4271 100       12995 if ( defined $1 ) {
110 4124         11083 $obj->{comment} = $1;
111 4124         8322 delete $obj->{text};
112             }
113 4271         12392 return $obj;
114             }
115 24474         50583 local ( $date, @tags, @description, $is_beginning, $is_note );
116 24474 100       178271 if ( $text =~ $re ) {
117              
118             # must use to_string to obtain text
119 24470         48957 delete $obj->{text};
120 24470         154217 my @time = split /\s++/, $date;
121 24470         89680 $date = DateTime->new(
122             year => $time[0],
123             month => $time[1],
124             day => $time[2],
125             hour => $time[3],
126             minute => $time[4],
127             second => $time[5],
128             time_zone => tz,
129             );
130 24470         10081908 $obj->{time} = $date;
131 24470 100       47588 if ($is_beginning) {
132 20363         34488 my %tags = map { $_ => 1 } @tags;
  19702         71883  
133             $obj->{tags} =
134 20363         51455 [ map { ( my $v = $_ ) =~ s/\\(.)/$1/g; $v } sort keys %tags ];
  19702         38592  
  19702         63992  
135             $obj->{description} = [
136             map {
137 20363         38014 ( my $v = $_ ) =~ s/\\(.)/$1/g;
  18545         84018  
138 18545         191182 $v =~ s/^\s++|\s++$//g;
139 18545         131960 $v =~ s/\s++/ /g;
140 18545         58570 $v
141             } @description
142             ];
143 20363 100       65076 $obj->{note} = 1 if $is_note;
144             }
145             else {
146 4107         8186 $obj->{done} = 1;
147             }
148 24470         120339 return $obj;
149             }
150             else {
151 4         59 $obj->{malformed} = 1;
152             }
153 4         23 return $obj;
154             }
155              
156              
157             sub clone {
158 1085     1085 1 1666 my ($self) = @_;
159 1085         2529 my $clone = bless {}, ref $self;
160 1085 50       2444 if ( $self->is_malformed ) {
    50          
161 0         0 $clone->{malformed} = 1;
162 0         0 $clone->text = $self->text;
163             }
164             elsif ( $self->is_event ) {
165 1085         38969 $clone->time = $self->time->clone;
166 1085 50       3725 if ( $self->is_beginning ) {
167 1085 50       2861 $clone->{note} = 1 if $self->is_note;
168 1085         1527 $clone->tags = [ @{ $self->tags } ];
  1085         2384  
169 1085         1503 $clone->description = [ @{ $self->description } ];
  1085         2255  
170             }
171             }
172             else {
173 0 0       0 $clone->comment = $self->comment if $self->is_comment;
174 0 0       0 $clone->text = $self->text if exists $self->{text};
175             }
176 1085         4987 return $clone;
177             }
178              
179              
180             sub to_string {
181 496     496 1 139297 my ($self) = @_;
182 496 100       1437 return $self->{text} if exists $self->{text};
183 495 100       1260 if ( $self->is_event ) {
    100          
184 412         16337 my $text = $self->time_stamp;
185 412 100       9188 $text .= $self->is_note ? '' : ':';
186 412 100       1053 if ( $self->is_beginning ) {
187 410   50     926 $self->tags ||= [];
188 410         574 my %tags = map { $_ => 1 } @{ $self->tags };
  16         52  
  410         770  
189 410         1005 $text .= join ' ', map { s/([:\\\s])/\\$1/g; $_ } sort keys %tags;
  16         46  
  16         40  
190 410         625 $text .= ':';
191 410   50     897 $self->description ||= [];
192             $text .= join ';',
193 410         1049 map { ( my $d = $_ ) =~ s/([;\\])/\\$1/g; $d }
  410         1296  
194 410         570 @{ $self->description };
  410         772  
195             }
196             else {
197 2         6 $text .= 'DONE';
198             }
199 412         3277 return $text;
200             }
201             elsif ( $self->is_comment ) {
202 82         220 return '# ' . $self->comment;
203             }
204             }
205              
206              
207             sub time_stamp {
208 412     412 1 688 my ( $self, $time ) = @_;
209 412   33     1429 $time ||= $self->time;
210 412         8557 return sprintf '%d %2s %2s %2s %2s %2s', $time->year, $time->month,
211             $time->day, $time->hour,
212             $time->minute, $time->second;
213             }
214              
215             # a bunch of attributes, here for convenience
216              
217              
218             sub text : lvalue {
219 2     2 1 15 $_[0]->{text};
220             }
221              
222              
223             sub tags : lvalue {
224 3630     3630 1 11006 $_[0]->{tags};
225             }
226              
227              
228             sub comment : lvalue {
229 83     83 1 755 $_[0]->{comment};
230             }
231              
232              
233             sub time : lvalue {
234 51322     51322 1 210073 $_[0]->{time};
235             }
236              
237              
238             sub description : lvalue {
239 3202     3202 1 10398 $_[0]->{description};
240             }
241              
242             # a bunch of tests
243              
244              
245 1096     1096 0 4548 sub is_malformed { exists $_[0]->{malformed} }
246              
247              
248 25550     25550 1 111321 sub is_beginning { exists $_[0]->{tags} }
249              
250              
251 221     221 1 1518 sub is_end { $_[0]->{done} }
252              
253              
254 1857     1857 1 7592 sub is_note { $_[0]->{note} }
255              
256              
257 2467     2467 1 10980 sub is_event { $_[0]->{time} }
258              
259              
260 16997 100   16997 1 67228 sub is_endpoint { $_[0]->{time} && !$_[0]->{note} }
261              
262              
263 85     85 1 444 sub is_comment { exists $_[0]->{comment} }
264              
265              
266 189     189 1 1008 sub tags_unspecified { $_[0]->{tags_unspecified} }
267              
268              
269             sub is_blank {
270 1   33 1 1 18 !( $_[0]->is_malformed || $_[0]->is_comment || $_[0]->is_event );
271             }
272              
273             # some useful methods
274              
275              
276             sub comment_out {
277 3     3 1 5 my ($self) = @_;
278 3         8 my $text = $self->to_string;
279 3         16 delete $self->{$_} for keys %$self;
280 3         8 $self->{comment} = $text;
281 3         12 return $self;
282             }
283              
284              
285             sub all_tags {
286 436     436 1 2369 my ( $self, @tags ) = @_;
287 436 50       806 return unless $self->tags;
288 436         559 my %tags = map { $_ => 1 } @{ $self->{tags} };
  12         24  
  436         852  
289 436         757 for my $tag (@tags) {
290 7 100       23 return unless $tags{$tag};
291             }
292 435         1913 return 1;
293             }
294              
295              
296             sub exists_tag {
297 2     2 1 7 my ( $self, @tags ) = @_;
298 2 50       5 return unless $self->tags;
299 2         3 my %tags = map { $_ => 1 } @{ $self->{tags} };
  12         23  
  2         5  
300 2         6 for my $tag (@tags) {
301 2 100       10 return 1 if $tags{$tag};
302             }
303 1         5 return;
304             }
305              
306             1;
307              
308             __END__