File Coverage

lib/App/TimeTracker/Proto.pm
Criterion Covered Total %
statement 128 154 83.1
branch 24 36 66.6
condition 15 29 51.7
subroutine 26 29 89.6
pod 0 5 0.0
total 193 253 76.2


line stmt bran cond sub pod time code
1             package App::TimeTracker::Proto;
2 5     5   918719 use strict;
  5         33  
  5         139  
3 5     5   22 use warnings;
  5         11  
  5         145  
4 5     5   95 use 5.010;
  5         16  
5              
6             # ABSTRACT: App::TimeTracker Proto Class
7              
8 5     5   1426 use App::TimeTracker::Utils qw(error_message);
  5         12  
  5         301  
9              
10 5     5   2299 use Moose;
  5         1754184  
  5         31  
11 5     5   34390 use MooseX::Types::Path::Class;
  5         1643456  
  5         59  
12 5     5   6336 use File::HomeDir ();
  5         14446  
  5         112  
13 5     5   29 use Path::Class;
  5         10  
  5         322  
14 5     5   2391 use Hash::Merge qw(merge);
  5         34088  
  5         293  
15 5     5   2541 use JSON::XS;
  5         18014  
  5         529  
16 5     5   34 use Carp;
  5         11  
  5         269  
17 5     5   27 use Try::Tiny;
  5         29  
  5         234  
18              
19 5     5   1893 use App::TimeTracker::Data::Task;
  5         16  
  5         6537  
20              
21             has 'home' => (
22             is => 'ro',
23             isa => 'Path::Class::Dir',
24             lazy_build => 1,
25             );
26              
27             sub _build_home {
28 7     7   1967 my ( $self, $home ) = @_;
29              
30             $home ||=
31 7   33     88 Path::Class::Dir->new( $ENV{TRACKER_HOME} || (File::HomeDir->my_home, '.TimeTracker' ));
      66        
32 7 50       308 unless (-d $home) {
33 0         0 $home->mkpath;
34 0         0 $self->_write_config_file_locations( {} );
35 0         0 my $fh = $self->global_config_file->openw;
36 0         0 print $fh $self->json_decoder->encode( {} );
37 0         0 close $fh;
38             }
39 7         420 return $home;
40             }
41              
42             has 'global_config_file' => (
43             is => 'ro',
44             isa => 'Path::Class::File',
45             lazy_build => 1,
46             );
47              
48             sub _build_global_config_file {
49 13     13   31 my $self = shift;
50 13         305 return $self->home->file('tracker.json');
51             }
52              
53             has 'config_file_locations' => (
54             is => 'ro',
55             isa => 'HashRef',
56             lazy_build => 1,
57             );
58              
59             sub _build_config_file_locations {
60 13     13   34 my $self = shift;
61 13         482 my $file = $self->home->file('projects.json');
62 13 50 33     1033 if ( -e $file && -s $file ) {
63 13         1095 my $decoded_json;
64             try {
65 13     13   5249 $decoded_json = decode_json( $file->slurp );
66             }
67             catch {
68 0     0   0 error_message( "Could not json decode '%s'.\nError: '%s'", $file, $_ );
69 0         0 exit 1;
70 13         164 };
71 13         3453 return $decoded_json;
72             }
73             else {
74 0         0 return {};
75             }
76             }
77              
78             has 'project' => ( is => 'rw', isa => 'Str', predicate => 'has_project' );
79              
80             has 'json_decoder' => ( is => 'ro', isa => 'JSON::XS', lazy_build => 1 );
81              
82             sub _build_json_decoder {
83 13     13   36 my $self = shift;
84 13         456 return JSON::XS->new->utf8->pretty->relaxed;
85             }
86              
87             sub run {
88 1     1 0 9666 my $self = shift;
89              
90             try {
91 1     1   73 my $config = $self->load_config;
92 1         5 my $class = $self->setup_class($config);
93 1 50       37 $class->name->new_with_options( {
94             home => $self->home,
95             config => $config,
96             ( $self->has_project
97             ? ( _current_project => $self->project )
98             : ()
99             ),
100             } )->run;
101             }
102             catch {
103 0     0   0 my $e = $_;
104 0 0 0     0 if ( blessed $e && $e->can('message') ) {
105 0         0 warn $e->message, "\n";
106             }
107             else {
108 0         0 warn "$e\n";
109             }
110             }
111 1         13 }
112              
113             sub setup_class {
114 22     22 0 21829 my ( $self, $config, $command ) = @_;
115              
116             # unique plugins
117 22   100     153 $config->{plugins} ||= [];
118 22         46 my %plugins_unique = map { $_ => 1 } @{ $config->{plugins} };
  0         0  
  22         78  
119 22         80 $config->{plugins} = [ keys %plugins_unique ];
120              
121             my $class = Moose::Meta::Class->create_anon_class(
122             superclasses => ['App::TimeTracker'],
123             roles => [
124 22         295 map { 'App::TimeTracker::Command::' . $_ } 'Core',
125 22         91 @{ $config->{plugins} }
  22         50  
126             ],
127             );
128              
129 22         189982 my %commands;
130 22         146 foreach my $method ( $class->get_all_method_names ) {
131 1650 100       27669 next unless $method =~ /^cmd_/;
132 308         664 $method =~ s/^cmd_//;
133 308         586 $commands{$method} = 1;
134             }
135              
136 22         146 my $load_attribs_for_command;
137 22 100       105 foreach my $cmd ( $command ? $command : @ARGV) {
138 21 50       83 if ( defined $commands{$cmd} ) {
139 21         62 $load_attribs_for_command = '_load_attribs_' . $cmd;
140              
141 21 50 66     227 if ($cmd eq 'start' && !$self->has_project) {
142 0         0 error_message(
143             "Could not find project\nUse --project or chdir into the project directory"
144             );
145 0         0 exit;
146             }
147              
148 21         49 last;
149             }
150             }
151 22 100 100     149 if ( $load_attribs_for_command
152             && $class->has_method($load_attribs_for_command) )
153             {
154 17         491 $class->name->$load_attribs_for_command($class, $config);
155             }
156 22         64601 $class->make_immutable();
157 22         8818 return $class;
158             }
159              
160             sub load_config {
161 14     14 0 70212 my ($self, $dir, $project) = @_;
162 14   66     117 $dir ||= Path::Class::Dir->new->absolute;
163 14         1259 my $config = {};
164 14         34 my @used_config_files;
165 14         470 my $cfl = $self->config_file_locations;
166              
167 14         64 my $projects = $self->slurp_projects;
168 14         184 my $opt_parser = Getopt::Long::Parser->new(
169             config => [qw( no_auto_help pass_through )] );
170 14         1793 $opt_parser->getoptions( "project=s" => \$project );
171              
172 14 100       3690 if ( defined $project ) {
173 8 50       68 if ( my $project_config = $projects->{$project} ) {
174 8         261 $self->project($project);
175 8         50 $dir = Path::Class::Dir->new($project_config);
176             }
177             else {
178 0         0 say "Unknown project: $project";
179 0         0 $self->project($project);
180 0         0 $dir = Path::Class::Dir->new( '/ttfake', $project );
181             }
182             }
183              
184 14         336 my $try = 0;
185 14         62 $dir = $dir->absolute;
186 14         430 WALKUP: while ( $try++ < 30 ) {
187 62         2860 my $config_file = $dir->file('.tracker.json');
188 62         3471 my $this_config;
189 62 100       180 if ( -e $config_file ) {
190 15         642 push( @used_config_files, $config_file->stringify );
191 15         417 $this_config = $self->slurp_config($config_file);
192 15         288 $config = merge( $config, $this_config );
193              
194 15         2111 my @path = $config_file->parent->dir_list;
195 15         215 my $project = $path[-1];
196 15         37 $cfl->{$project} = $config_file->stringify;
197 15 100       898 $self->project($project)
198             unless $self->has_project;
199              
200             }
201 62 100       1898 last WALKUP if $dir->parent eq $dir;
202              
203 48 50       4180 if ( my $parent = $this_config->{'parent'} ) {
204 0 0       0 if ( $projects->{$parent} ) {
205 0         0 $dir = Path::Class::file( $projects->{$parent} )->parent;
206             }
207             else {
208 0         0 $dir = $dir->parent;
209 0         0 say
210             "Cannot find project >$parent< that's specified as a parent in $config_file";
211             }
212             }
213             else {
214 48         104 $dir = $dir->parent;
215             }
216             }
217              
218 14         1178 $self->_write_config_file_locations($cfl);
219              
220 14 100       544 if ( -e $self->global_config_file ) {
221 9         954 push( @used_config_files, $self->global_config_file->stringify );
222 9         444 $config = merge( $config,
223             $self->slurp_config( $self->global_config_file ) );
224             }
225 14         1302 $config->{_used_config_files} = \@used_config_files;
226              
227 14         125 return $config;
228             }
229              
230             sub _write_config_file_locations {
231 14     14   39 my ( $self, $cfl ) = @_;
232 14         411 my $fh = $self->home->file('projects.json')->openw;
233 14   33     3709 print $fh $self->json_decoder->encode( $cfl
234             || $self->config_file_locations );
235 14         1304 close $fh;
236             }
237              
238             sub slurp_config {
239 24     24 0 68 my ( $self, $file ) = @_;
240             try {
241 24     24   1527 my $content = $file->slurp();
242 24         4846 return $self->json_decoder->decode($content);
243             }
244             catch {
245 0     0   0 error_message( "Cannot parse config file $file:\n%s", $_ );
246 0         0 exit;
247 24         216 };
248             }
249              
250             sub slurp_projects {
251 14     14 0 35 my $self = shift;
252 14         344 my $file = $self->home->file('projects.json');
253 14 50 33     935 unless ( -e $file && -s $file ) {
254 0         0 error_message("Cannot find projects.json\n");
255 0         0 exit;
256             }
257 14         1129 my $projects = decode_json( $file->slurp );
258 14         2548 return $projects;
259             }
260              
261             1;
262              
263             __END__
264              
265             =pod
266              
267             =encoding UTF-8
268              
269             =head1 NAME
270              
271             App::TimeTracker::Proto - App::TimeTracker Proto Class
272              
273             =head1 VERSION
274              
275             version 3.004
276              
277             =head1 DESCRIPTION
278              
279             Ugly internal stuff, see L<YAPC::Europe 2011 talk...|https://domm.plix.at/talks/2011_riga_app_timetracker/>
280              
281             =head1 AUTHOR
282              
283             Thomas Klausner <domm@cpan.org>
284              
285             =head1 COPYRIGHT AND LICENSE
286              
287             This software is copyright (c) 2011 - 2020 by Thomas Klausner.
288              
289             This is free software; you can redistribute it and/or modify it under
290             the same terms as the Perl 5 programming language system itself.
291              
292             =cut