File Coverage

blib/lib/App/JobLog/Log/Event.pm
Criterion Covered Total %
statement 74 77 96.1
branch 22 28 78.5
condition 13 16 81.2
subroutine 15 16 93.7
pod 9 9 100.0
total 133 146 91.1


line stmt bran cond sub pod time code
1             package App::JobLog::Log::Event;
2             $App::JobLog::Log::Event::VERSION = '1.041';
3             # ABSTRACT: basically adds an end time to App::JobLog::Log::Line events
4              
5              
6 4     4   3016 use parent qw(App::JobLog::Log::Note);
  4         9  
  4         33  
7              
8 4     4   279 use Modern::Perl;
  4         8  
  4         32  
9 4     4   595 use Class::Autouse qw{DateTime};
  4         6  
  4         26  
10 4     4   209 use autouse 'App::JobLog::Time' => qw(now);
  4         8  
  4         29  
11 4     4   562 use autouse 'Carp' => qw(carp);
  4         7  
  4         17  
12              
13             # for debugging
14             use overload '""' => sub {
15 0 0   0   0 $_[0]->data->to_string . '-->'
16             . ( $_[0]->is_closed ? $_[0]->end : 'ongoing' );
17 4     4   543 };
  4         6  
  4         44  
18              
19              
20             sub clone {
21 1085     1085 1 1613 my ($self) = @_;
22 1085         3170 my $clone = $self->new( $self->data->clone );
23 1085 100       2753 $clone->end = $self->end->clone unless $self->is_open;
24 1085         3592 return $clone;
25             }
26              
27              
28             sub overlap {
29 4846     4846 1 8056 my ( $self, $start, $end ) = @_;
30              
31             # if this falls entirely within interval, return this
32 4846   100     13395 my $c1 = DateTime->compare( $start, $self->start ) || 0;
33 4846   100     415741 my $c2 = DateTime->compare( $end, $self->end ) || 0;
34 4846 100 100     416004 if ( $c1 <= 0 && $c2 >= 0 ) {
35 3764         11832 return $self;
36             }
37 1082 50 33     2978 return if $self->start >= $end || $start >= $self->end;
38 1082 100       97107 my $s = $c1 < 0 ? $self->start : $start;
39 1082 100       3122 my $e = $c2 < 0 ? $end : $self->end;
40 1082         2602 my $clone = $self->clone;
41 1082         3277 $clone->start = $s;
42 1082         4282 $clone->end = $e;
43 1082         5736 return $clone;
44             }
45              
46              
47             sub end : lvalue {
48 25323     25323 1 208821 $_[0]->{end};
49             }
50              
51              
52             sub cmp {
53 130     130 1 2715 my ( $self, $other ) = @_;
54 130         370 my $comparison = $self->SUPER::cmp($other);
55 130 100       11621 unless ($comparison) {
56 6 50       20 if ( $other->isa(__PACKAGE__) ) {
57 6 100       89 if ( $self->is_closed ) {
    50          
58 5 50       206 if ( $other->is_closed ) {
59 5         193 return DateTime->compare( $self->end, $other->end );
60             }
61             else {
62 0         0 return 1;
63             }
64             }
65             elsif ( $other->is_closed ) {
66 0         0 return -1;
67             }
68             else {
69 1         7 return 0;
70             }
71             }
72             }
73 124         371 return $comparison;
74             }
75              
76              
77 14387     14387 1 94308 sub is_closed { $_[0]->{end} }
78              
79              
80 14186     14186 1 34145 sub is_open { !$_[0]->is_closed }
81              
82              
83             sub duration {
84 137     137 1 217 my ($self) = @_;
85 137 100       341 my $e = $self->is_open ? now : $self->end;
86 137         542 return $e->epoch - $self->start->epoch;
87             }
88              
89              
90             sub split_days {
91 140     140 1 201 my ($self) = @_;
92 140         371 my $days_end =
93             $self->start->clone->truncate( to => 'day' )->add( days => 1 );
94 140   66     185958 my $e = $self->end || now;
95 140 100       5698 if ( $days_end < $e ) {
96 1         96 my @splits;
97 1         4 my $s = $self->start;
98 1         3 do {
99 2         984 my $clone = $self->clone;
100 2         8 $clone->start = $s;
101 2         10 $s = $days_end->clone;
102 2         30 $clone->end = $s;
103 2         5 push @splits, $clone;
104 2         6 $days_end->add( days => 1 );
105             } while ( $days_end < $e );
106 1         1009 my $clone = $self->clone;
107 1         4 $clone->start = $s;
108 1         6 $clone->end = $self->end;
109 1         2 push @splits, $clone;
110 1         9 return @splits;
111             }
112             else {
113 139         13521 return $self;
114             }
115             }
116              
117              
118             sub intersects {
119 170     170 1 226 my ( $self, $other ) = @_;
120 170 100       470 if ( $self->start > $other->start ) {
121              
122             #rearrange so $self is earlier
123 127         11076 my $t = $other;
124 127         171 $other = $self;
125 127         173 $self = $t;
126             }
127 170   100     4294 return $self->is_open || $self->end > $other->start;
128             }
129              
130             1;
131              
132             __END__