File Coverage

blib/lib/Cog/App.pm
Criterion Covered Total %
statement 33 131 25.1
branch 0 34 0.0
condition 0 15 0.0
subroutine 11 26 42.3
pod 0 14 0.0
total 44 220 20.0


line stmt bran cond sub pod time code
1             package Cog::App;
2 2     2   2336 use Mo qw'build default';
  2         350  
  2         12  
3             extends 'Cog::Base';
4              
5 2     2   2160 use Getopt::Long qw(:config pass_through);
  2         8389  
  2         15  
6 2     2   1309 use IO::All;
  2         8881  
  2         14  
7 2     2   559 use YAML::XS;
  2         1880  
  2         163  
8 2     2   9 use Cwd 'abs_path';
  2         3  
  2         63  
9 2     2   8 use File::Basename;
  2         4  
  2         95  
10 2     2   7 use File::Spec;
  2         3  
  2         229  
11              
12             has Name => sub {
13             my $Name = ref($_[0]);
14             $Name =~ s/::App\b//;
15             return $Name if $Name =~ /^\w+$/;
16             die "Can't determine 'Name' attribute for '${\ref($_[0])}'";
17             };
18              
19             has app_script => basename $0;
20              
21             has app_root => sub {
22             my $root = abs_path(dirname($_[0]->config_file));
23             return $root if -d $root;
24             die "Can't determine 'app_root' for '${\ref($_[0])}'";
25             };
26              
27             has build_root => sub {
28             $_[0]->app_root;
29             };
30              
31             has webapp_root => sub {
32             my $root = $_[0]->app_root;
33             File::Spec->catdir($root, 'webapp');
34             };
35              
36             has config_file => sub {
37             abs_path($_[0]->app_script . '.yaml');
38             };
39              
40 2     2   281 use constant config_class => 'Cog::Config';
  2         3  
  2         88  
41 2     2   8 use constant maker_class => 'Cog::Maker';
  2         5  
  2         84  
42 2     2   9 use constant webapp_class => '';
  2         2  
  2         87  
43 2     2   8 use constant runner_class => 'Cog::Runner';
  2         3  
  2         2929  
44              
45 0     0 0   sub plugins { [] };
46              
47             has action => ();
48             has time => time();
49              
50             # If we use the generic 'bin/cog' script, we need to determine which Cog
51             # application class we are representing.
52             sub get_app_class {
53 0     0 0   my ($class, @argv) = @_;
54 0           my $app_class;
55 0           @ARGV = @argv;
56 0           Getopt::Long::GetOptions(
57             'app=s' => \$app_class,
58             );
59 0   0       $app_class ||= $ENV{COG_APP} || $class;
      0        
60 0 0         unless ($app_class->can('new')) {
61 0 0         eval "use $app_class; 1"
62             or die $@;
63             }
64 0 0 0       die "$app_class is not a Cog::App application"
65             unless $app_class->isa('Cog::App') and
66             $app_class ne 'Cog::App';
67              
68 0           return $app_class;
69             }
70              
71             sub BUILD {
72 0     0 0   my ($self) = @_;
73              
74 0           my $config_class = $self->config_class;
75 0 0         eval "require $config_class"
76             unless UNIVERSAL::can($config_class, 'new');
77              
78 0           my $config_file = $self->config_file;
79              
80 0 0         my $hash = $config_class->flatten_namespace(
81             -e $config_file ? YAML::XS::LoadFile($config_file) : {}
82             );
83 0   0       my $app_class = $hash->{app_class} ||= ref($self);
84 0 0         if ($app_class ne ref($self)) {
85 0 0         eval "require $app_class; 1" or die $@;
86 0           $self = $_[0] = $app_class->new();
87             }
88              
89 0           $Cog::Base::initialize->(
90             $self,
91             $config_class->new(
92             %$hash,
93             app => $self,
94             cli_args => [@ARGV],
95             ),
96             );
97             }
98              
99             sub run {
100 0     0 0   my $self = shift;
101              
102 0           $self->parse_command_args;
103              
104 0           my $action = $self->action;
105 0           my $method = "handle_$action";
106              
107 0 0         my $function = $self->can($method)
108             or die "'$action' is an invalid action\n";
109              
110 0 0         if ($action ne 'init') {
111 0 0         die "Can't determine 'config_file' for '${\ref($_[0])}'"
  0            
112             unless $self->config_file;
113 0           $self->_chdir_root();
114             }
115              
116 0           $function->($self);
117              
118 0           return 0;
119             }
120              
121             sub parse_command_args {
122 0     0 0   my $self = shift;
123 0           my $argv = $self->config->cli_args;
124 0           my $script = $self->app_script;
125 0           $script =~ s!.*/!!;
126 0           my $action = '';
127 0 0 0       if ($script =~ /^(pre-commit|post-commit)$/) {
    0          
    0          
128 0           $script =~ s/-/_/;
129 0           $self->action($script);
130             }
131             elsif (@$argv and $argv->[0] =~ /^[\w\-]+$/) {
132 0           $action = shift @$argv;
133 0           $action =~ s/-/_/g;
134             }
135             elsif (not @$argv) {
136 0           $action = 'help';
137             }
138             else {
139 0           die "Invalid cog command. Can't parse these arguments: '@_'";
140             }
141 0           $self->action($action);
142             }
143              
144             #-----------------------------------------------------------------------------
145             sub handle_help {
146 0     0 0   my $self = shift;
147 0           print $self->usage;
148             }
149              
150             sub usage {
151 0     0 0   my $self = shift;
152 0           my $Name = $self->Name;
153 0           my $name = $self->app_script;
154 0           $name =~ s!.*/!!;
155 0           return <<"...";
156             Usage: $name <command>
157              
158             Commands:
159             init - Make current directory into a $Name app
160             update - Update the app with the latest assets
161             make - Prepare the app content for the web
162             start - Start the local app server
163             stop - Stop the server
164              
165             ...
166             }
167              
168             sub handle_init {
169 0     0 0   my $self = shift;
170 0           my $root = $self->app_root;
171 0 0         die "Can't init. Cog environment already exists.\n"
172             if $self->config->is_init;
173 0           my $share = $self->config->find_share_dir($self);
174              
175 0           my $config_file = $self->config_file;
176 0 0         if (not -e $config_file) {
177 0           require Template::Toolkit::Simple;
178 0           my $data = +{%$self};
179 0           $data->{app_class} = ref($self);
180 0           my $config = Template::Toolkit::Simple::tt()
181             ->path(["$share/template/"])
182             ->data($data)
183             ->post_chomp
184             ->render('config.yaml');
185 0           io($config_file)->print($config);
186             }
187              
188 0           $self->_chdir_root;
189              
190 0           my $Name = $self->Name;
191 0           my $name = $self->app_script;
192 0           $name =~ s!.*/!!;
193              
194 0           print <<"...";
195              
196             $Name was successfully initialized in:
197              
198             $root
199              
200             The next step is to edit:
201              
202             $config_file
203              
204             Then run:
205              
206             $name update
207              
208             ...
209             }
210              
211             sub handle_update {
212 0     0 0   my $self = shift;
213 0           my $root = $self->app_root;
214              
215 0           $self->maker->make_assets();
216              
217 0           my $Name = $self->Name;
218 0           my $name = $self->app_script;
219 0           $name =~ s!.*/!!;
220              
221 0           print <<"...";
222             $Name was successfully updated in the $root/ subdirectory.
223              
224             Now run:
225              
226             $name make
227              
228             ...
229             }
230              
231             sub handle_make {
232 0     0 0   my $self = shift;
233 0           $self->maker->make;
234 0           my $Name = $self->Name;
235 0           my $name = $self->app_script;
236 0           $name =~ s!.*/!!;
237 0           print <<"...";
238              
239             $Name is up to date and ready to use.
240             To start the web server, run this command:
241              
242             $name start
243              
244             ...
245              
246             }
247              
248             sub handle_start {
249 0     0 0   my $self = shift;
250 0           my $Name = $self->Name;
251 0           print <<"...";
252             $Name web server is starting up...
253              
254             ...
255 0           my @args = @{$self->config->cli_args};
  0            
256 0 0         unshift @args, ('-p' => $self->config->server_port)
257             if $self->config->server_port;
258 0           $self->runner->run(@args);
259             }
260              
261             sub handle_stop {
262 0     0 0   die 'TODO';
263             }
264              
265             sub handle_edit {
266 0     0 0   die 'TODO';
267             }
268              
269             sub handle_clean {
270 0     0 0   my $self = shift;
271 0           $self->maker->make_clean;
272 0           my $Name = $self->Name;
273 0           my $name = $self->app_script;
274 0           $name =~ s!.*/!!;
275 0           print <<"...";
276              
277             $Name is clean. To rebuild, run this command:
278              
279             $name update
280              
281             ...
282              
283             }
284              
285             # Put the App in the context of its defined root directory.
286             sub _chdir_root {
287 0     0     my $self = shift;
288 0           my $app_root = $self->app_root;
289 0 0         chdir $app_root
290             or die "Can't chdir into $app_root";
291             }
292              
293             1;