File Coverage

lib/App/TimeTracker.pm
Criterion Covered Total %
statement 94 135 69.6
branch 33 54 61.1
condition 8 19 42.1
subroutine 17 19 89.4
pod 0 6 0.0
total 152 233 65.2


line stmt bran cond sub pod time code
1             package App::TimeTracker;
2 12     12   1383746 use strict;
  12         43  
  12         319  
3 12     12   54 use warnings;
  12         22  
  12         259  
4 12     12   195 use 5.010;
  12         36  
5              
6             our $VERSION = "3.004";
7             # ABSTRACT: time tracking for impatient and lazy command line lovers
8              
9 12     12   1131 use App::TimeTracker::Data::Task;
  12         34  
  12         410  
10              
11 12     12   5279 use DateTime;
  12         2788985  
  12         442  
12 12     12   83 use Moose;
  12         27  
  12         101  
13 12     12   74668 use Moose::Util::TypeConstraints;
  12         26  
  12         108  
14 12     12   28044 use Path::Class qw();
  12         85507  
  12         279  
15 12     12   6434 use Path::Class::Iterator;
  12         95058  
  12         91  
16 12     12   4618 use MooseX::Storage::Format::JSONpm;
  12         709255  
  12         432  
17 12     12   80 use JSON::XS;
  12         24  
  12         5812  
18              
19             our $HOUR_RE = qr/(?<hour>[012]?\d)/;
20             our $MINUTE_RE = qr/(?<minute>[0-5]?\d)/;
21             our $DAY_RE = qr/(?<day>[0123]?\d)/;
22             our $MONTH_RE = qr/(?<month>[01]?\d)/;
23             our $YEAR_RE = qr/(?<year>2\d{3})/;
24              
25             with qw(
26             MooseX::Getopt
27             );
28              
29             subtype 'TT::DateTime' => as class_type('DateTime');
30             subtype 'TT::RT' => as 'Int';
31             subtype 'TT::Duration' => as enum( [qw(day week month year)] );
32              
33             coerce 'TT::RT' => from 'Str' => via {
34             my $raw = $_;
35             $raw =~ s/\D//g;
36             return $raw;
37             };
38              
39             coerce 'TT::DateTime' => from 'Str' => via {
40             my $raw = $_;
41             my $dt = DateTime->now;
42             $dt->set_time_zone('local');
43             $dt->set( second => 0 );
44              
45             if ($raw) {
46             if ( $raw =~ /^ $HOUR_RE : $MINUTE_RE $/x ) { # "13:42"
47 11     11   4737 $dt->set( hour => $+{hour}, minute => $+{minute} );
  11         3939  
  11         2891  
48             }
49             elsif ( $raw =~ /^ $YEAR_RE [-.]? $MONTH_RE [-.]? $DAY_RE $/x )
50             { # "2010-02-26"
51             $dt->set( year => $+{year}, month => $+{month}, day => $+{day} );
52             $dt->truncate( to => 'day' );
53             }
54             elsif ( $raw
55             =~ /^ $YEAR_RE [-.]? $MONTH_RE [-.]? $DAY_RE \s+ $HOUR_RE : $MINUTE_RE $/x
56             )
57             { # "2010-02-26 12:34"
58             $dt->set(
59             year => $+{year},
60             month => $+{month},
61             day => $+{day},
62             hour => $+{hour},
63             minute => $+{minute} );
64             }
65             elsif ( $raw =~ /^ $DAY_RE [-.]? $MONTH_RE [-.]? $YEAR_RE $/x )
66             { # "26-02-2010"
67             $dt->set( year => $+{year}, month => $+{month}, day => $+{day} );
68             $dt->truncate( to => 'day' );
69             }
70             elsif ( $raw
71             =~ /^ $DAY_RE [-.]? $MONTH_RE [-.]? $YEAR_RE \s $HOUR_RE : $MINUTE_RE $/x
72             )
73             { # "26-02-2010 12:34"
74             $dt->set(
75             year => $+{year},
76             month => $+{month},
77             day => $+{day},
78             hour => $+{hour},
79             minute => $+{minute} );
80             }
81             else {
82             confess "Invalid date format '$raw'";
83             }
84             }
85             return $dt;
86             };
87              
88             MooseX::Getopt::OptionTypeMap->add_option_type_to_map( 'TT::DateTime' => '=s',
89             );
90             MooseX::Getopt::OptionTypeMap->add_option_type_to_map( 'TT::RT' => '=i', );
91              
92 12     12   89 no Moose::Util::TypeConstraints;
  12         26  
  12         114  
93              
94             has 'home' => (
95             is => 'ro',
96             isa => 'Path::Class::Dir',
97             traits => ['NoGetopt'],
98             required => 1,
99             );
100             has 'config' => (
101             is => 'ro',
102             isa => 'HashRef',
103             required => 1,
104             traits => ['NoGetopt'],
105             );
106             has '_current_project' => (
107             is => 'ro',
108             isa => 'Str',
109             predicate => 'has_current_project',
110             traits => ['NoGetopt'],
111             );
112              
113             has 'tags' => (
114             isa => 'ArrayRef',
115             is => 'ro',
116             traits => ['Array'],
117             default => sub { [] },
118             handles => {
119             insert_tag => 'unshift',
120             add_tag => 'push',
121             },
122             documentation => 'Tags [Multiple]',
123             );
124              
125             has '_current_command' => (
126             isa => 'Str',
127             is => 'rw',
128             traits => ['NoGetopt'],
129             );
130              
131             has '_current_task' => (
132             isa => 'App::TimeTracker::Data::Task',
133             is => 'rw',
134             traits => ['NoGetopt'],
135             );
136              
137             has '_previous_task' => (
138             isa => 'App::TimeTracker::Data::Task',
139             is => 'rw',
140             traits => ['NoGetopt'],
141             );
142              
143             sub run {
144 1     1 0 18 my $self = shift;
145 1   50     25 my $command = 'cmd_' . ( $self->extra_argv->[0] || 'missing' );
146              
147 1 50       22 $self->cmd_commands()
148             unless $self->can($command);
149 0         0 $self->_current_command($command);
150 0         0 $self->$command;
151             }
152              
153             sub now {
154 2     2 0 4753 my $dt = DateTime->now();
155 2         538 $dt->set_time_zone('local');
156 2         4322 return $dt;
157             }
158              
159             sub beautify_seconds {
160 10     10 0 5709 my ( $self, $s ) = @_;
161 10 100       25 return '0' unless $s;
162 8         16 my ( $m, $h ) = ( 0, 0 );
163              
164 8 100       20 if ( $s >= 60 ) {
165 7         14 $m = int( $s / 60 );
166 7         12 $s = $s - ( $m * 60 );
167             }
168 8 100 100     42 if ( $m && $m >= 60 ) {
169 4         8 $h = int( $m / 60 );
170 4         6 $m = $m - ( $h * 60 );
171             }
172 8         40 return sprintf( "%02d:%02d:%02d", $h, $m, $s );
173             }
174              
175             sub find_task_files {
176 3     3 0 7271 my ( $self, $args ) = @_;
177              
178 3         93 my $root = $self->home;
179 3         7 my ( $cmp_from, $cmp_to );
180              
181 3 100       14 if ( my $from = $args->{from} ) {
182 2   66     19 my $to = $args->{to} || $self->now;
183 2 100       18 $to->set( hour => 23, minute => 59, second => 59 ) unless $to->hour;
184 2         630 $cmp_from = $from->strftime("%Y%m%d%H%M%S");
185 2         186 $cmp_to = $to->strftime("%Y%m%d%H%M%S");
186              
187 2 100       109 if ( $from->year == $to->year ) {
188 1         9 $root = $root->subdir( $from->year );
189 1 50       68 if ( $from->month == $to->month ) {
190 1         11 $root = $root->subdir( $from->strftime("%m") );
191             }
192             }
193             }
194              
195 3         76 my $projects;
196 3 100       12 if ( $args->{projects} ) {
197 2         4 $projects = join( '|', map { s/-/./g; $_ } @{ $args->{projects} } );
  2         5  
  2         8  
  2         6  
198             }
199              
200 3         5 my $children;
201 3 50       9 if ($args->{parent}) {
202 0         0 my @kids = $args->{parent};
203 0         0 $self->all_childs_of($args->{parent},\@kids);
204 0         0 $children = join( '|', map { s/-/./g; $_ } @kids );
  0         0  
  0         0  
205             }
206              
207 3         5 my $tags;
208 3 50       10 if ( $args->{tags} ) {
209 0         0 $tags = join( '|', @{ $args->{tags} } );
  0         0  
210             }
211              
212 3         7 my @found;
213 3         27 my $iterator = Path::Class::Iterator->new( root => $root, );
214 3   66     11053 until ( !$iterator || $iterator->done ) {
215 73         2209 my $file = $iterator->next;
216              
217 73 100       33890 next unless -f $file;
218 69         2826 my $name = $file->basename;
219 69 50       473 next unless $name =~ /\.trc$/;
220              
221 69 100       136 if ($cmp_from) {
222 46         90 $file =~ /(\d{8})-(\d{6})/;
223 46         1247 my $time = $1 . $2;
224 46 100       177 next if $time < $cmp_from;
225 35 100       87 next if $time > $cmp_to;
226             }
227              
228 52 100       89 if ($projects) {
229 46 100       254 next unless ( $name =~ m/$projects/i );
230             }
231              
232 29 50       52 if ($children) {
233 0 0       0 next unless ( $name =~ m/$children/i );
234             }
235              
236 29 50       47 if ($tags) {
237 0         0 my $raw_content = $file->slurp;
238 0 0       0 next unless $raw_content =~ /$tags/i;
239             }
240              
241 29         123 push( @found, $file );
242             }
243 3         97 return sort @found;
244             }
245              
246             sub project_tree {
247 0     0 0 0 my $self = shift;
248 0         0 my $file = $self->home->file('projects.json');
249 0 0 0     0 return unless -e $file && -s $file;
250 0         0 my $decoder = JSON::XS->new->utf8->pretty->relaxed;
251 0         0 my $projects = $decoder->decode( scalar $file->slurp );
252              
253 0         0 my %tree;
254             my $depth;
255 0         0 while ( my ( $project, $location ) = each %$projects ) {
256 0   0     0 $tree{$project} //= { parent => undef, children => {} };
257             # check config file for parent
258 0 0       0 if ( -e $location ) {
259 0         0 my $this_config = $decoder->decode(
260             scalar Path::Class::file($location)->slurp );
261 0 0       0 if ( my $parent = $this_config->{parent} ) {
262 0         0 $tree{$project}->{parent} = $parent;
263 0         0 $tree{$parent}->{children}{$project} = 1;
264 0         0 next;
265             }
266             }
267             # check path for parent
268 0         0 my @parts = Path::Class::file($location)->parent->parent->dir_list;
269 0         0 foreach my $dir (@parts) {
270 0 0 0     0 if ( $project ne $dir and my $parent = $projects->{$dir} ) {
271 0         0 $tree{$project}->{parent} = $dir;
272 0         0 $tree{$dir}->{children}{$project} = 1;
273             }
274             }
275             }
276              
277 0         0 return \%tree;
278             }
279              
280             sub all_childs_of {
281 0     0 0 0 my ($self, $parent, $collector) = @_;
282              
283 0         0 my $tree = $self->project_tree;
284 0         0 my $this = $tree->{$parent};
285              
286 0         0 my @kids = keys %{$this->{children}};
  0         0  
287              
288 0 0       0 if (@kids) {
289 0         0 push(@$collector, @kids);
290 0         0 foreach my $kid (@kids) {
291 0         0 $self->all_childs_of($kid, $collector);
292             }
293             }
294             }
295              
296             1;
297              
298             __END__
299              
300             =pod
301              
302             =encoding UTF-8
303              
304             =head1 NAME
305              
306             App::TimeTracker - time tracking for impatient and lazy command line lovers
307              
308             =head1 VERSION
309              
310             version 3.004
311              
312             =head1 SYNOPSIS
313              
314             Backend for the C<tracker> command. See L<tracker> and/or C<perldoc tracker> for details.
315              
316             =head1 CONTRIBUTORS
317              
318             Maros Kollar, Klaus Ita, Yanick Champoux, Lukas Rampa, David Schmidt, Michael Kröll, Thomas Sibley, Nelo Onyiah, Jozef Kutej, Roland Lammel, Ruslan Zakirov, Kartik Thakore, Tokuhiro Matsuno, Paul Cochrane, David Provost, Mohammad S Anwar, Håkon Hægland
319              
320             =head1 AUTHOR
321              
322             Thomas Klausner <domm@cpan.org>
323              
324             =head1 COPYRIGHT AND LICENSE
325              
326             This software is copyright (c) 2011 - 2020 by Thomas Klausner.
327              
328             This is free software; you can redistribute it and/or modify it under
329             the same terms as the Perl 5 programming language system itself.
330              
331             =cut