File Coverage

blib/lib/App/JobLog/Log/Synopsis.pm
Criterion Covered Total %
statement 145 176 82.3
branch 26 38 68.4
condition 19 36 52.7
subroutine 26 29 89.6
pod 11 15 73.3
total 227 294 77.2


line stmt bran cond sub pod time code
1             package App::JobLog::Log::Synopsis;
2             $App::JobLog::Log::Synopsis::VERSION = '1.040';
3             # ABSTRACT: consolidates App::JobClock::Log::Event objects for display
4              
5              
6 2     2   1427 use Exporter 'import';
  2         3  
  2         165  
7             our @EXPORT_OK = qw(
8             collect
9             MERGE_ALL
10             MERGE_ADJACENT
11             MERGE_ADJACENT_SAME_TAGS
12             MERGE_SAME_TAGS
13             MERGE_SAME_DAY
14             MERGE_SAME_DAY_SAME_TAGS
15             MERGE_NONE
16             );
17             our %EXPORT_TAGS = (
18             merge => [
19             qw(
20             MERGE_ALL
21             MERGE_ADJACENT
22             MERGE_ADJACENT_SAME_TAGS
23             MERGE_SAME_TAGS
24             MERGE_SAME_DAY
25             MERGE_SAME_DAY_SAME_TAGS
26             MERGE_NONE
27             )
28             ]
29             );
30              
31 2     2   10 use Modern::Perl;
  2         4  
  2         17  
32 2     2   309 use autouse 'Carp' => qw(carp);
  2         4  
  2         15  
33 2     2   186 use autouse 'App::JobLog::Time' => qw(now);
  2         4  
  2         9  
34 2     2   152 use Class::Autouse qw(DateTime);
  2         8  
  2         14  
35 2     2   120 no if $] >= 5.018, warnings => "experimental::smartmatch";
  2         12  
  2         24  
36              
37 2     2   144 use constant MERGE_ALL => 1;
  2         4  
  2         135  
38 2     2   10 use constant MERGE_ADJACENT => 2;
  2         4  
  2         123  
39 2     2   10 use constant MERGE_ADJACENT_SAME_TAGS => 3;
  2         7  
  2         85  
40 2     2   11 use constant MERGE_SAME_TAGS => 4;
  2         3  
  2         116  
41 2     2   9 use constant MERGE_SAME_DAY => 5;
  2         2  
  2         88  
42 2     2   10 use constant MERGE_SAME_DAY_SAME_TAGS => 6;
  2         4  
  2         86  
43 2     2   9 use constant MERGE_NONE => 0;
  2         5  
  2         4687  
44              
45              
46             # takes in a bunch of App::JobClock::Log::Event objects
47             # returns a bunch of App::JobClock::Log::Synopsis objects
48             sub collect {
49 7970     7970 1 18912 my ( $day, $merge_level ) = @_;
50 7970         11422 my ( @synopses, $previous, @current_day );
51 7970         11781 for my $e ( @{ $day->events }, @{ $day->vacation } ) {
  7970         23934  
  7970         21050  
52 200         285 my $do_merge = 0;
53 200         1447 my $mergand = $previous;
54 200 100       513 if ($previous) {
55 124         212 for ($merge_level) {
56 124         169 when (MERGE_ALL) { $do_merge = 1 }
  0         0  
57 124         152 when (MERGE_ADJACENT) { $do_merge = $previous->adjacent($e) }
  0         0  
58 124         147 when (MERGE_SAME_TAGS) {
59 0         0 for my $o (@synopses) {
60 0 0       0 if ( $o->same_tags($e) ) {
61 0         0 $mergand = $o;
62 0         0 $do_merge = 1;
63 0         0 last;
64             }
65             }
66             }
67 124         169 when (MERGE_SAME_DAY) { $do_merge = 1 }
  0         0  
68 124         168 when (MERGE_SAME_DAY_SAME_TAGS) {
69 0         0 for my $s (@current_day) {
70 0 0       0 if ( $s->same_tags($e) ) {
71 0         0 $do_merge = 1;
72 0         0 $mergand = $s;
73 0         0 last;
74             }
75             }
76             }
77 124         170 when (MERGE_ADJACENT_SAME_TAGS) {
78 124   33     265 $do_merge = $previous->adjacent($e)
79             && $previous->same_tags($e)
80             }
81 0         0 when (MERGE_NONE) { $do_merge = 0 }
  0         0  
82 0         0 default { carp 'unfamiliar merge level' };
  0         0  
83             }
84             }
85              
86             # keep vacation and regular events apart
87 200   66     575 $do_merge &&= ref $mergand->last_event eq ref $e;
88              
89 200 100       418 if ($do_merge) {
90 124         234 $mergand->merge($e);
91             }
92             else {
93 76         266 $previous = _new( $e, $merge_level );
94 76         209 push @synopses, $previous;
95 76         181 push @current_day, $previous;
96             }
97             }
98 7970         44259 $day->{synopses} = \@synopses;
99             }
100              
101             # test to make sure this and the given event
102             sub same_tags {
103 124     124 0 9370 my ( $self, $event ) = @_;
104 124         252 for my $e ( $self->events ) {
105             return 0
106 217         577 unless $e->all_tags( @{ $event->tags } )
107 217 50 33     254 && $event->all_tags( @{ $e->tags } );
  217         540  
108             }
109 124         754 return 1;
110             }
111              
112             sub same_day {
113 0     0 0 0 my ( $self, $event ) = @_;
114 0         0 my $d1 = ( $self->events )[-1]->end;
115 0         0 my $d2 = $event->start;
116             return
117 0   0     0 $d1->day == $d2->day
118             && $d1->month == $d2->month
119             && $d1->year == $d2->year;
120             }
121              
122             # whether given event is immediately adjacent to last event in synopsis
123             sub adjacent {
124 124     124 0 177 my ( $self, $event ) = @_;
125 124 100       381 return 1 if !$event->can('end'); # notes are always considered adjacent
126 93   33     1007 my $d1 = ( $self->events )[-1]->end || now;
127 93         3514 my $d2 = $event->start;
128 93         265 return DateTime->compare( $d1, $d2 ) == 0;
129             }
130              
131             # add an event to the events described
132 124     124 0 124 sub merge { push @{ $_[0]{events} }, $_[1] }
  124         409  
133              
134              
135 0     0 1 0 sub date { $_[0]->{events}[0]->start }
136              
137              
138             sub description {
139 76     76 1 128 my ($self) = @_;
140 76 50       207 unless ( exists $self->{description} ) {
141 76         106 my ( %seen, @descriptions );
142 76         181 for my $e ( $self->events ) {
143 200         261 for my $d ( @{ $e->data->description } ) {
  200         565  
144 200 50       591 unless ( $seen{$d} ) {
145 200         493 $seen{$d} = 1;
146 200         350 chomp $d; # got newline from log
147 200         627 push @descriptions, $d;
148             }
149             }
150             }
151 76         145 my $s = $descriptions[0];
152 76         208 for my $d ( @descriptions[ 1 .. $#descriptions ] ) {
153 124 50       580 $s .= $s =~ /\w$/ ? '; ' : ' ';
154 124         250 $s .= $d;
155             }
156 76         323 $self->{description} = $s;
157             }
158 76         272 return $self->{description};
159             }
160              
161              
162             sub tags {
163 76     76 1 110 my ($self) = @_;
164 76         103 my %seen;
165 76         139 my $s = '';
166 76         184 for my $e ( $self->events ) {
167 200         285 for my $t ( @{ $e->tags } ) {
  200         598  
168 12         101 $seen{$t} = 1;
169             }
170             }
171 76         403 return ( sort keys %seen );
172             }
173              
174              
175             sub tag_string {
176 87     87 1 202 my ($self) = @_;
177             $self->{tag_string} = join ', ', $self->tags
178 87 100       340 unless exists $self->{tag_string};
179 87         361 return $self->{tag_string};
180             }
181              
182              
183 733     733 1 887 sub events { @{ $_[0]->{events} } }
  733         2470  
184              
185              
186 124     124 1 278 sub last_event { ( $_[0]->events )[-1] }
187              
188             # constructs a single-event synopsis
189             # NOTE: not a package method
190             sub _new {
191 76     76   173 my ( $event, $merge_level ) = @_;
192 76 50 33     444 carp 'requires event argument'
193             unless $event && $event->isa('App::JobLog::Log::Note');
194 76         1354 my ( $one_interval, $one_day );
195 76         194 for ($merge_level) {
196 76         192 when (MERGE_ALL) { ( $one_interval, $one_day ) = ( 0, 0 ) }
  0         0  
197 76         114 when (MERGE_ADJACENT) { ( $one_interval, $one_day ) = ( 1, 1 ) }
  0         0  
198 76         155 when (MERGE_ADJACENT_SAME_TAGS) {
199 65         154 ( $one_interval, $one_day ) = ( 1, 1 )
200             }
201 11         46 when (MERGE_SAME_TAGS) { ( $one_interval, $one_day ) = ( 0, 0 ) }
  0         0  
202 11         42 when (MERGE_SAME_DAY) { ( $one_interval, $one_day ) = ( 0, 1 ) }
  0         0  
203 11         48 when (MERGE_SAME_DAY_SAME_TAGS) {
204 0         0 ( $one_interval, $one_day ) = ( 0, 1 )
205             }
206 11         53 when (MERGE_NONE) { ( $one_interval, $one_day ) = ( 1, 1 ) }
  11         87  
207             }
208 76         851 return bless {
209             events => [$event],
210             one_interval => $one_interval,
211             one_day => $one_day
212             },
213             __PACKAGE__;
214             }
215              
216              
217 88     88 1 226 sub single_interval { $_[0]->{one_interval} }
218              
219              
220 0     0 1 0 sub single_day { $_[0]->{one_day} }
221              
222              
223             sub duration {
224 88     88 1 151 my ($self) = @_;
225 88         210 my @events = $self->events;
226 88 50       322 return 0 unless $events[0]->can('end'); # notes have no duration
227 88 50       1071 if ( $self->single_interval ) {
228 88         173 my ( $se, $ee ) = ( $events[0], $events[$#events] );
229 88   66     267 my ( $start, $end ) = ( $se->start, $ee->end || now );
230 88         3849 return $end->epoch - $start->epoch;
231             }
232             else {
233 0         0 my $d = 0;
234 0         0 $d += $_->duration for @events;
235 0         0 return $d;
236             }
237             }
238              
239              
240             sub time_fmt {
241 152     152 1 221 my ($self) = @_;
242 152         352 my @events = $self->events;
243 152         343 my ( $se, $ee ) = ( $events[0], $events[$#events] );
244 152 100 100     818 if ( @events == 1 && !$se->can('end') ) { # single note
245 2         29 return $se->start->strftime('%l:%M %P');
246             }
247 150 100       1051 my ( $start, $end ) =
248             ( $se->start, $ee->can('end') ? $ee->end : $ee->start );
249 150         217 my $s;
250 150 100       526 if ($end) {
251 138 50 33     5838 return 'vacation'
252             if ref $se eq 'App::JobLog::Vacation::Period' && !$se->fixed;
253 138   66     414 my $same_period = $start->hour < 12 && $end->hour < 12
254             || $start->hour >= 12 && $end->hour >= 12;
255 138 100 66     2613 if ( $same_period
      100        
256             && $start->hour == $end->hour
257             && $start->minute == $end->minute )
258             {
259 62         1108 $s = $start->strftime('%l:%M %P');
260             }
261             else {
262 76 100       462 my ( $f1, $f2 ) =
263             ( $same_period ? '%l:%M' : '%l:%M %P', '%l:%M %P' );
264 76         275 $s = $start->strftime($f1) . ' - ' . $end->strftime($f2);
265             }
266             }
267             else {
268 12         134 $s = $start->strftime('%l:%M %P') . ' - ongoing';
269             }
270 150         14490 $s =~ s/ / /; # strftime tends to add in an extra space
271 150         486 $s =~ s/^ //;
272 150         569 return $s;
273             }
274              
275             1;
276              
277             __END__