File Coverage

blib/lib/Zydeco/Lite/App.pm
Criterion Covered Total %
statement 144 203 70.9
branch 37 108 34.2
condition 21 65 32.3
subroutine 32 50 64.0
pod 5 30 16.6
total 239 456 52.4


line stmt bran cond sub pod time code
1 2     2   1200 use 5.008008;
  2         5  
2 2     2   8 use strict;
  2         3  
  2         32  
3 2     2   7 use warnings;
  2         3  
  2         71  
4              
5             package Zydeco::Lite::App;
6              
7 2     2   820 use Getopt::Kingpin 0.10;
  2         50751  
  2         10  
8 2     2   60 use Path::Tiny 'path';
  2         4  
  2         82  
9 2     2   850 use Type::Utils 'english_list';
  2         40225  
  2         15  
10 2     2   1641 use Types::Path::Tiny -types;
  2         94869  
  2         17  
11 2     2   2490 use Types::Standard -types;
  2         16  
  2         12  
12 2     2   10538 use Zydeco::Lite qw( -all !app );
  2         72801  
  2         12  
13              
14 2     2   9747 use parent 'Zydeco::Lite';
  2         231  
  2         12  
15 2     2   102 use namespace::autoclean;
  2         4  
  2         17  
16              
17             our $AUTHORITY = 'cpan:TOBYINK';
18             our $VERSION = '0.001';
19              
20             our @EXPORT = (
21             @Zydeco::Lite::EXPORT,
22             qw( arg flag command run ),
23             );
24             our @EXPORT_OK = @EXPORT;
25              
26             sub make_fake_call ($) {
27 1     1 0 3 my $pkg = shift;
28 1         83 eval "sub { package $pkg; my \$code = shift; &\$code; }";
29             }
30              
31             our %THIS;
32              
33             sub app {
34 1     1 1 13 local $THIS{MY_SPEC} = {};
35            
36 1   50 0   5 my $orig = Zydeco::Lite::_pop_type( CodeRef, @_ ) || sub { 1 };
  0         0  
37            
38 1         53 my $commands;
39             my $wrapped = sub {
40 1     1   406 $orig->( @_ );
41            
42 1         2 while ( my ( $key, $spec ) = each %{ $Zydeco::Lite::THIS{'APP_SPEC'} } ) {
  7         32  
43 6 100       22 if ( $key =~ /^(class|role):(.+)$/ ) {
44 1 50       4 if ( $spec->{"-IS_COMMAND"} ) {
45 1         6 ( my $cmdname = lc $2 ) =~ s/::/-/g;
46 1   50     3 push @{ $spec->{with} ||= [] }, '::Zydeco::Lite::App::Trait::Command';
  1         6  
47 1   50     13 $spec->{can}{command_name} ||= sub () { $cmdname };
  0         0  
48             }
49 1 0 33     4 if ( $spec->{"-IS_COMMAND"} || $spec->{"-FLAGS"} || $spec->{"-ARGS"} ) {
      0        
50 1   50     16 my $flags = delete( $spec->{"-FLAGS"} ) || {};
51 1   50     5 my $args = delete( $spec->{"-ARGS"} ) || [];
52 1   50     13 push @{ $spec->{symmethod} ||= [] }, (
53 1         78 _flags_spec => sub { $flags },
54 2         124 _args_spec => sub { $args },
55 1         2 );
56             }
57            
58 1         4 delete $spec->{"-IS_COMMAND"};
59 1         2 delete $spec->{"-FLAGS"};
60 1         3 delete $spec->{"-ARGS"};
61             } #/ if ( $key =~ /^(class|role):(.+)$/)
62             } #/ while ( my ( $key, $spec ...))
63            
64 1         3 my $spec = $Zydeco::Lite::THIS{'APP_SPEC'};
65 1   50     2 push @{ $spec->{with} ||= [] }, '::Zydeco::Lite::App::Trait::Application';
  1         6  
66 1 50       7 $spec->{can}{'commands'} = sub { @{ $commands or [] } }
  1         6  
67 1         5 };
  1         8  
68            
69 1   33     6 my $app =
70             make_fake_call( caller )->( \&Zydeco::Lite::app, @_, $wrapped ) || $_[0];
71 1         48307 $commands = $THIS{MY_SPEC}{"-COMMANDS"};
72            
73 1         8 return $app;
74             } #/ sub app
75              
76             sub flag {
77             $Zydeco::Lite::THIS{CLASS_SPEC}
78 2 50   2 1 836 or Zydeco::Lite::confess( "cannot use `flag` outside a role or class" );
79            
80 2 50       5 my $name = Zydeco::Lite::_shift_type( Str, @_ )
81             or Zydeco::Lite::confess( "flags must have a string name" );
82 2 50       34 my %flag_spec = @_ == 1 ? %{ $_[0] } : @_;
  0         0  
83            
84 2         5 my $app = $Zydeco::Lite::THIS{APP};
85 2         5 my $class = $Zydeco::Lite::THIS{CLASS};
86             $flag_spec{kingpin} ||= sub {
87 2     2   16 __PACKAGE__->_kingpin_handle( $app, $class, flag => $name, \%flag_spec, @_ );
88 2   50     19 };
89            
90 2         6 $Zydeco::Lite::THIS{CLASS_SPEC}{"-FLAGS"}{$name} = \%flag_spec;
91            
92 2         7 my %spec = %flag_spec;
93 2         4 delete $spec{short};
94 2         4 delete $spec{env};
95 2         3 delete $spec{placeholder};
96 2         3 delete $spec{hidden};
97 2         4 delete $spec{kingpin};
98 2         3 delete $spec{kingpin_type};
99 2         6 @_ = ( $name, \%spec );
100 2         8 goto \&Zydeco::Lite::has;
101             } #/ sub flag
102              
103             sub arg {
104             $Zydeco::Lite::THIS{CLASS_SPEC}
105 1 50   1 1 3217 or Zydeco::Lite::confess( "cannot use `arg` outside a class" );
106            
107 1 50       5 my $name = Zydeco::Lite::_shift_type( Str, @_ )
108             or Zydeco::Lite::confess( "args must have a string name" );
109 1 50       24 my %arg_spec = @_ == 1 ? %{ $_[0] } : @_;
  0         0  
110            
111 1         3 my $app = $Zydeco::Lite::THIS{APP};
112 1         3 my $class = $Zydeco::Lite::THIS{CLASS};
113 1         3 $arg_spec{name} = $name;
114             $arg_spec{kingpin} ||= sub {
115 1     1   6 __PACKAGE__->_kingpin_handle( $app, $class, arg => $name, \%arg_spec, @_ );
116 1   50     11 };
117            
118 1   50     2 push @{ $Zydeco::Lite::THIS{CLASS_SPEC}{"-ARGS"} ||= [] }, \%arg_spec;
  1         8  
119            
120 1         3 return;
121             } #/ sub arg
122              
123             sub _kingpin_handle {
124 3     3   13 my ( $me, $factory, $class, $kind, $name, $spec, $kingpin ) = ( shift, @_ );
125            
126             my $flag = $kingpin->$kind(
127             $spec->{init_arg} || $name,
128 3   33     33 $spec->{documentation} || 'No description available.',
      50        
129             );
130            
131 3 50       1489 if ( not ref $spec->{kingpin_type} ) {
132            
133 3         22 my $reg = 'Type::Registry'->for_class( $class );
134 3 100       37 $reg->has_parent or $reg->set_parent( 'Type::Registry'->for_class( $factory ) );
135            
136             my $type =
137             $spec->{kingpin_type} ? $reg->lookup( $spec->{kingpin_type} )
138             : ref( $spec->{type} or $spec->{isa} ) ? ( $spec->{type} or $spec->{isa} )
139             : $spec->{type} ? $reg->lookup( $spec->{type} )
140             : $spec->{isa} ? $factory->type_library->get_type_for_package(
141             $factory->get_class( $spec->{isa} ) )
142             : $spec->{does} ? $factory->type_library->get_type_for_package(
143 3 0 33     46 $factory->get_role( $spec->{does} ) )
    0 33        
    0          
    50          
    50          
144             : Str;
145            
146 3         39 $spec->{kingpin_type} = $type;
147             } #/ if ( not ref $spec->{kingpin_type...})
148            
149 3         6 my $type = $spec->{kingpin_type};
150            
151 3 50       13 if ( $type <= ArrayRef ) {
    100          
    50          
    100          
    50          
    50          
    50          
    0          
152 0 0 0     0 if ( $type->is_parameterized and $type->parent == ArrayRef ) {
153 0         0 my $type_parameter = $type->type_parameter;
154 0 0       0 if ( $type_parameter <= File ) {
    0          
    0          
    0          
    0          
155 0         0 $flag->existing_file_list;
156             }
157             elsif ( $type_parameter <= Dir ) {
158 0         0 $flag->existing_dir_list;
159             }
160             elsif ( $type_parameter <= Path ) {
161 0         0 $flag->file_list;
162             }
163             elsif ( $type_parameter <= Int ) {
164 0         0 $flag->int_list;
165             }
166             elsif ( $type_parameter <= Num ) {
167 0         0 $flag->num_list;
168             }
169             else {
170 0         0 $flag->string_list;
171             }
172             } #/ if ( $type->is_parameterized...)
173             else {
174 0         0 $flag->string_list;
175             }
176             } #/ if ( $type <= ArrayRef)
177             elsif ( $type <= HashRef ) {
178 1 50 33     1475 if ( $type->is_parameterized and $type->parent == ArrayRef ) {
179 0         0 my $type_parameter = $type->type_parameter;
180 0 0       0 if ( $type_parameter <= File ) {
    0          
    0          
    0          
    0          
181 0         0 $flag->existing_file_hash;
182             }
183             elsif ( $type_parameter <= Dir ) {
184 0         0 $flag->existing_dir_hash;
185             }
186             elsif ( $type_parameter <= Path ) {
187 0         0 $flag->file_hash;
188             }
189             elsif ( $type_parameter <= Int ) {
190 0         0 $flag->int_hash;
191             }
192             elsif ( $type_parameter <= Num ) {
193 0         0 $flag->num_hash;
194             }
195             else {
196 0         0 $flag->string_hash;
197             }
198             } #/ if ( $type->is_parameterized...)
199             else {
200 1         1137 $flag->string_hash;
201             }
202 1 50       957 $flag->placeholder( 'KEY=VAL' ) if $flag->can( 'placeholder' );
203             } #/ elsif ( $type <= HashRef )
204             elsif ( $type <= Bool ) {
205 0         0 $flag->bool;
206             }
207             elsif ( $type <= File ) {
208 1         4663 $flag->existing_file;
209             }
210             elsif ( $type <= Dir ) {
211 0         0 $flag->existing_dir;
212             }
213             elsif ( $type <= Path ) {
214 0         0 $flag->file;
215             }
216             elsif ( $type <= Int ) {
217 1         10288 $flag->int;
218             }
219             elsif ( $type <= Num ) {
220 0         0 $flag->num;
221             }
222             else {
223 0         0 $flag->string;
224             }
225            
226 3 50       1947 if ( $spec->{required} ) {
227 0         0 $flag->required;
228             }
229            
230 3 50       10 if ( $spec->{hidden} ) {
231 0         0 $flag->hidden;
232             }
233            
234 3 50       7 if ( exists $spec->{short} ) {
235 0         0 $flag->short( $spec->{short} );
236             }
237            
238 3 50       11 if ( exists $spec->{env} ) {
239 0         0 $flag->override_default_from_envar( $spec->{env} );
240             }
241            
242 3 50       8 if ( exists $spec->{placeholder} ) {
243 0         0 $flag->placeholder( $spec->{placeholder} );
244             }
245            
246 3 100       9 if ( $kind eq 'arg' ) {
247 1 50       6 if ( Types::TypeTiny::CodeLike->check( $spec->{default} ) ) {
    50          
    50          
248 0         0 my $cr = $spec->{default};
249            
250             # For flags, MooX::Press does this prefilling
251 0 0 0     0 if ( blessed $cr and $cr->isa( 'Ask::Question' ) ) {
252 0 0       0 $cr->_set_type( $type ) unless $cr->has_type;
253 0 0 0     0 $cr->_set_text( $spec->{documentation} || $name ) unless $cr->has_text;
254 0 0       0 $cr->_set_title( $name ) unless $cr->has_title;
255 0 0       0 $cr->_set_spec( $spec ) unless $cr->has_spec;
256             }
257 0     0   0 $flag->default( sub { $cr->( $class ) } );
  0         0  
258             } #/ if ( Types::TypeTiny::CodeLike...)
259             elsif ( exists $spec->{default} ) {
260 0         0 $flag->default( $spec->{default} );
261             }
262             elsif ( my $builder = $spec->{builder} ) {
263 0 0 0     0 $builder = "_build_$name" if is_Int( $builder ) && $builder eq 1;
264 0     0   0 $flag->default( sub { $class->$builder } );
  0         0  
265             }
266             } #/ if ( $kind eq 'arg' )
267            
268 3         36 return $flag;
269             } #/ sub _kingpin_handle
270              
271             sub command {
272 0   50 0 1 0 my $definition = Zydeco::Lite::_pop_type( CodeRef, @_ ) || sub { 1 };
  1     1   353  
273 1 50       19 my $name = Zydeco::Lite::_shift_type( Str, @_ )
274             or Zydeco::Lite::confess( "commands must have a string name" );
275 1         15 my %args = @_;
276            
277 1         6 Zydeco::Lite::class( $name, %args, $definition );
278            
279 1         297 my $class_spec = $Zydeco::Lite::THIS{APP_SPEC}{"class:$name"};
280 1         2 $class_spec->{'-IS_COMMAND'} = 1;
281            
282 1   50     20 push @{ $THIS{MY_SPEC}{"-COMMANDS"} ||= [] }, $name;
  1         9  
283            
284 1         3 return;
285             } #/ sub command
286              
287             sub run (&) {
288 3     3 1 1547 unshift @_, 'execute';
289 3         11 goto \&Zydeco::Lite::method;
290             }
291              
292             Zydeco::Lite::app( 'Zydeco::Lite::App' => sub {
293            
294             role 'Trait::Application'
295             => sub {
296            
297             requires qw( commands );
298            
299             method '_proto'
300             => sub {
301 5     5   12 my ( $proto ) = ( shift );
302             ref( $proto ) ? $proto : bless( {}, $proto );
303             };
304            
305             method 'stdio'
306             => sub {
307 0     0 0 0 my ( $app, $in, $out, $err ) = ( shift->_proto, @_ );
308             $app->{stdin} = $in if $in;
309             $app->{stdout} = $out if $out;
310             $app->{stderr} = $err if $err;
311             $app;
312             };
313            
314             method 'config_file'
315             => sub {
316 0     0 0 0 return;
317             };
318            
319             method 'find_config'
320             => sub {
321 1     1 0 3 my ( $app ) = ( shift->_proto );
322             my @files = $app->config_file or return;
323             require Perl::OSType;
324             my @dirs = ( path( "." ) );
325             if ( Perl::OSType::is_os_type( 'Unix' ) ) {
326             push @dirs, path( $ENV{XDG_CONFIG_HOME} || '~/.config' );
327             push @dirs, path( '/etc' );
328             }
329             elsif ( Perl::OSType::is_os_type( 'Windows' ) ) {
330             push @dirs,
331             map path( $ENV{$_} ),
332             grep $ENV{$_},
333             qw( LOCALAPPDATA APPDATA PROGRAMDATA );
334             }
335             my @found;
336             for my $dir ( @dirs ) {
337             for my $file ( @files ) {
338             my $found = $dir->child( "$file" );
339             push @found, $found if $found->is_file;
340             }
341             }
342             @found;
343             };
344            
345             method read_config
346             => sub {
347 1     1 0 3 my ( $app ) = ( shift->_proto );
348             my @files = @_ ? map( path( $_ ), @_ ) : $app->find_config;
349             my %config;
350            
351             for my $file ( reverse @files ) {
352             next unless $file->is_file;
353            
354             my $this_config = $app->read_single_config($file);
355             while ( my ( $section, $sconfig ) = each %$this_config ) {
356             $config{$section} = +{
357             %{ $config{$section} or {} },
358             %{ $sconfig or {} },
359             };
360             }
361             } #/ for my $file ( reverse ...)
362            
363             return \%config;
364             };
365            
366             method 'read_single_config'
367             => [ File ]
368             => sub {
369 1   33 1 0 5 my ( $app, $file ) = ( shift->_proto, @_ );
  1         11  
  1         13191  
  1         70  
370            
371             if ( $file =~ /\.json$/i ) {
372             my $decode =
373             eval { require JSON::MaybeXS }
374             ? \&JSON::MaybeXS::decode_json
375             : do { require JSON::PP; \&JSON::PP::decode_json };
376             return $decode->( $file->slurp_utf8 );
377             }
378             elsif ( $file =~ /\.ya?ml/i ) {
379             my $decode =
380             eval { require YAML::XS }
381             ? \&YAML::XS::LoadFile
382             : do { require YAML::PP; \&YAML::PP::LoadFile };
383             return $decode->( $file->slurp_utf8 );
384             }
385             elsif ( $file =~ /\.ini/i ) {
386             require Config::Tiny;
387             my $cfg = 'Config::Tiny'->read( "$file", 'utf8' );
388             $cfg->{'globals'} ||= delete $cfg->{'_'};
389             return +{%$cfg};
390             }
391             else {
392             require TOML::Parser;
393             my $parser = 'TOML::Parser'->new;
394             return $parser->parse_fh( $file->openr_utf8 );
395             }
396             };
397            
398             method 'kingpin'
399             => sub {
400 1     1 0 4 my ( $app ) = ( shift->_proto );
401             my $kingpin = 'Getopt::Kingpin'->new;
402             my $config = $app->read_config;
403             my @commands = $app->commands;
404             for my $cmd ( @commands ) {
405             my $class = $app->get_class( $cmd ) or next;
406             my $cmdname = $class->command_name or next;
407             my $cmdconfig = $config->{$cmdname} || {} or next;
408             my $globalconfig = $config->{'globals'} || {} or next;
409             $class->kingpin( $kingpin, { %$globalconfig, %$cmdconfig } );
410             }
411             $kingpin->terminate( sub { $app->exit( $_[1] or 0 ) } );
412             return $kingpin;
413             };
414            
415             method 'execute_no_subcommand'
416             => sub {
417 0     0 0 0 my ( $app, @args ) = ( shift->_proto, @_ );
418             $app->execute( '--help' );
419             };
420            
421             run {
422 1     1 0 12 my ( $app, @args ) = ( shift->_proto, @_ );
423             my $kingpin = $app->kingpin();
424             # Shortcut for the case of there only being one real command
425             if ( $kingpin->commands->count == 2 ) {
426             my @commands = grep $_->name ne 'help', $kingpin->commands->get_all;
427             my @realargs = grep !/^-/, @args; # naive, but should be okay
428             unless ( @realargs and $realargs[0] eq $commands[0]->name ) {
429             unshift @args, $commands[0]->name;
430             }
431             }
432             my $cmd = $kingpin->parse( @args );
433             my $cmd_class = $cmd->{'zylite_app_class'};
434             if ( not $cmd_class ) {
435             $app->execute_no_subcommand( @args );
436             }
437             my %flags;
438             for my $name ( $cmd->flags->keys ) {
439             my $flag = $cmd->flags->get( $name );
440             $flag->{'_defined'} or next;
441             $flags{$name} = $flag->value;
442             }
443             my $cmd_object = $cmd_class->new( %flags, _app => $app );
444             my @coerced = do {
445             my @values = map $_->value, $cmd->args->get_all;
446             my @args = map @{ $_ or {} }, $cmd_object->_args_spec;
447             my @return;
448             while ( @values ) {
449             my $value = shift @values;
450             my $spec = shift @args;
451             if ( $spec->{type} ) {
452             $value =
453             $spec->{type}->has_coercion
454             ? $spec->{type}->assert_coerce( $value )
455             : $spec->{type}->assert_return( $value );
456             }
457             push @return, $value;
458             } #/ while ( @values )
459             @return;
460             };
461             my $return = $cmd_object->execute( @coerced );
462             $app->exit( $return );
463             };
464            
465             method 'exit'
466             => [ Int ]
467             => sub {
468 1   33 1 0 5 my ( $self, $code ) = ( shift, @_ );
  1         15  
  1         974  
  1         22  
469             return CORE::exit( $code );
470             };
471            
472             method 'stdin'
473             => sub {
474 0     0 0 0 my $self = shift;
475             ref( $self ) && exists( $self->{stdin} ) ? $self->{stdin} : \*STDIN;
476             };
477            
478             method 'stdout'
479             => sub {
480 12     12 0 25 my $self = shift;
481             ref( $self ) && exists( $self->{stdout} ) ? $self->{stdout} : \*STDOUT;
482             };
483            
484             method 'stderr'
485             => sub {
486 0     0 0 0 my $self = shift;
487             ref( $self ) && exists( $self->{stderr} ) ? $self->{stderr} : \*STDERR;
488             };
489            
490             method 'readline'
491             => sub {
492 0     0 0 0 my $in = shift->stdin;
493             my $line = <$in>;
494             chomp $line;
495             return $line;
496             };
497            
498             method 'print'
499             => sub {
500 12     12 0 1404 my $self = shift;
501             $self->stdout->print( "$_\n" ) for @_;
502             return;
503             };
504            
505             method 'debug_mode'
506             => sub {
507 0     0 0 0 return 0;
508             };
509            
510             method 'debug'
511             => sub {
512 0     0 0 0 my $self = shift->_proto;
513             return unless $self->debug_mode;
514             $self->stderr->print( "$_\n" ) for @_;
515             return;
516             };
517            
518             method 'usage'
519             => sub {
520 0     0 0 0 my $self = shift;
521             $self->stderr->print( "$_\n" ) for @_;
522             $self->exit( 1 );
523             };
524            
525             my %colours = (
526             info => 'bright_blue',
527             warn => 'bold bright_yellow',
528             error => 'bold bright_red',
529             fatal => 'bold bright_red',
530             success => 'bold bright_green',
531             );
532            
533             for my $key ( keys %colours ) {
534             my $level = $key;
535             my $colour = $colours{$key};
536            
537             method $level
538             => sub {
539 0     0 0 0 require Term::ANSIColor;
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
540             my $self = shift;
541             $self->stderr->print( Term::ANSIColor::colored( "$_\n", $colour ) ) for @_;
542             $self->exit( 254 ) if $level eq 'fatal';
543             return;
544             };
545             } #/ for my $key ( keys %colours)
546             };
547            
548             role 'Trait::Command'
549             => sub {
550            
551             requires qw( _flags_spec _args_spec execute command_name );
552            
553             has 'app' => (
554             is => 'lazy',
555             isa => ClassName | Object,
556             default => sub { shift->FACTORY },
557             handles => { map +( $_ => $_ ), qw(
558             print debug info warn error fatal usage readline success
559             ) },
560             init_arg => '_app',
561             );
562            
563             has 'config' => (
564             is => 'lazy',
565             type => HashRef,
566             builder => sub {
567             my $self = shift;
568             my $config = $self->app->read_config;
569             my %config = ( %{ $config->{'globals'} or {} },
570             %{ $config->{ $self->command_name } or {} } );
571             \%config;
572             }
573             );
574            
575             method 'documentation'
576             => sub {
577 1     1 0 9 return 'No description available.'
578             };
579            
580             method 'kingpin'
581             => sub {
582 1     1 0 4 my ( $class, $kingpin, $defaults ) = ( shift, @_ );
583            
584             my $cmd = $kingpin->command( $class->command_name, $class->documentation );
585             $cmd->{'zylite_app_class'} = $class;
586            
587             my %specs = map %{ $_ or {} }, $class->_flags_spec;
588             for my $s ( sort keys %specs ) {
589             my $spec = $specs{$s};
590             my $flag = $spec->{'kingpin'}( $cmd );
591             if ( exists $defaults->{ $flag->name } ) {
592             $flag->default( $defaults->{ $flag->name } );
593             }
594             }
595            
596             my @args = map @{ $_ or {} }, $class->_args_spec;
597             for my $spec ( @args ) {
598             $spec->{'kingpin'}( $cmd );
599             }
600            
601             return $cmd;
602             };
603             };
604             } );
605              
606             1;
607              
608             __END__
609              
610             =pod
611              
612             =encoding utf-8
613              
614             =head1 NAME
615              
616             Zydeco::Lite::App - use Zydeco::Lite to quickly develop command-line apps
617              
618             =head1 SYNOPSIS
619              
620             In C<< consumer.pl >>:
621              
622             #! perl
623            
624             use strict;
625             use warnings;
626             use Zydeco::Lite::App;
627             use Types::Standard -types;
628            
629             app 'MyApp' => sub {
630            
631             command 'Eat' => sub {
632            
633             constant documentation => 'Consume some food.';
634            
635             arg 'foods' => (
636             type => ArrayRef[Str],
637             documentation => 'A list of foods.',
638             );
639            
640             run {
641             my ( $self, $foods ) = ( shift, @_ );
642             $self->info( "Eating $_." ) for @$foods;
643             return 0;
644             };
645             };
646            
647             command 'Drink' => sub {
648            
649             constant documentation => 'Consume some drinks.';
650            
651             arg 'drinks' => (
652             type => ArrayRef[Str],
653             documentation => 'A list of drinks.',
654             );
655            
656             run {
657             my ( $self, $drinks ) = ( shift, @_ );
658             $self->info( "Drinking $_." ) for @$drinks;
659             return 0;
660             };
661             };
662             };
663            
664             'MyApp'->execute( @ARGV );
665              
666             At the command line:
667              
668             $ ./consumer.pl help eat
669             usage: consumer.pl eat [<foods>...]
670            
671             Consume some food.
672            
673             Flags:
674             --help Show context-sensitive help.
675            
676             Args:
677             [<foods>] A list of foods.
678              
679             $ ./consumer.pl eat pizza chocolate
680             Eating pizza.
681             Eating chocolate.
682              
683             =head1 DESCRIPTION
684              
685             Zydeco::Lite::App extends L<Zydeco::Lite> to redefine the C<app> keyword to
686             build command-line apps, and add C<command>, C<arg>, C<flag>, and C<run>
687             keywords.
688              
689             It assumes your command-line app will have a single level of subcommands, like
690             many version control and package management tools often do. (You type
691             C<< git add filename.pl >>, not C<< git filename.pl >>. The C<add> part is
692             the subcommand.)
693              
694             It will handle C<< @ARGV >> processing, loading config files, and IO for you.
695              
696             =head2 C<< app >>
697              
698             The C<app> keyword exported by Zydeco::Lite::App is a wrapper for the
699             C<app> keyword provided by L<Zydeco::Lite> which performs additional
700             processing for the C<command> keyword to associate commands with applications,
701             and adds the Zydeco::Lite::App::Trait::Application role (a.k.a. the App trait)
702             to the package it defines.
703              
704             # Named application:
705            
706             app "Local::MyApp", sub {
707             ...; # definition of app
708             }
709            
710             "Local::MyApp"->execute( @ARGV );
711              
712             # Anonymous application:
713            
714             my $app = app sub {
715             ...; # definition of app
716             };
717            
718             $app->execute( @ARGV );
719              
720             An anonymous application will actually have a package name, but it will be an
721             automatically generated string of numbers, letters, and punctuation which you
722             shouldn't rely on being the same from one run to another.
723              
724             Within the coderef passed to C<app>, you can define roles, classes, and
725             commands.
726              
727             The package defined by C<app> will do the App trait.
728              
729             =head3 The App Trait
730              
731             =over
732              
733             =item C<< commands >>
734              
735             The C<commands> method lists the app's subcommands. Subcommands will each
736             be a package, typically with a package name that uses the app's package name as
737             a prefix. So your "add" subcommand might have a package name
738             "Local::MyApp::Add" and your "add-recursive" subcommand might be called
739             "Local::MyApp::Add::Recursive".
740              
741             The C<commands> method will return these packages minus the prefix, so
742             calling C<< 'Local::MyApp'->commands >> would return a list of strings
743             including "Add" and "Add::Recursive".
744              
745             The App trait requires your app package to implement this method, but the
746             C<app> keyword will provide this method for you, so you don't typially need
747             to worry about implementing it yourself.
748              
749             =item C<< execute >>
750              
751             The C<execute> method is the powerhouse of your app. It takes a list of
752             command-line parameters, processes them, loads any config files, figures out
753             which subcommand to run, dispatches to that, and exits.
754              
755             The App trait implements this method for you and you should probably not
756             override it.
757              
758             =item C<< execute_no_subcommand >>
759              
760             In the case where C<execute> cannot figure out what subcommand to dispatch to,
761             C<execute_no_subcommand> is called.
762              
763             The App trait implements this method for you. The default behaviour is to
764             call C<execute> again, passing it "--help". You can override this behaviour
765             though, if some other behaviour would be more useful.
766              
767             =item C<< stdio >>
768              
769             Most of the methods in the App trait are okay to be called as either class
770             methods or instance methods.
771              
772             "Local::MyApp"->execute( @ARGV );
773             bless( {}, "Local::MyApp" )->execute( @ARGV );
774              
775             C<stdio> is for calling on an instance though, and will return an instance if
776             you call it as a class method. The arguments set the filehandles used by the
777             app for input, output, and error messages.
778              
779             my $app = "Local::MyApp"->stdio( $in_fh, $out_fh, $err_fh );
780             $app->execite( @ARGV );
781              
782             =item C<< stdin >>, C<< stdout >>, C<< stderr >>
783              
784             Accessors which return the handles set by C<stdio>. If no filehandles have been
785             given, or called as a class method, return STDIN, STDOUT, and STDERR.
786              
787             =item C<< readline >>
788              
789             A method for reading input.
790              
791             C<< $app->readline() >> is a shortcut for C<< $app->stdin->readline() >> but
792             also calls C<chomp> on the result.
793              
794             =item C<< print >>, C<< debug >>, C<< usage >>, C<< info >>, C<< warn >>, C<< error >>, C<< fatal >>, C<< success >>
795              
796             Methods for printing output.
797              
798             All off them automatically append new lines.
799              
800             C<print> writes lines to C<< $app->stdout >>.
801              
802             C<debug> writes lines to C<< $app->stderr >> but only if C<< $app->debug_mode >>
803             returns true.
804              
805             C<usage> writes lines to C<< $app->stderr >> and then exits with exit code 1.
806              
807             C<info> writes lines in blue text to C<< $app->stderr >>.
808              
809             C<warn> writes lines in yellow text to C<< $app->stderr >>.
810              
811             C<error> writes lines in red text to C<< $app->stderr >>.
812              
813             C<fatal> writes lines in red text to C<< $app->stderr >> and then exits with
814             exit code 254.
815              
816             C<success> writes lines in green text to C<< $app->stderr >>.
817              
818             Any of these methods can be overridden in your app if you prefer different
819             colours or different behaviour.
820              
821             =item C<< debug_mode >>
822              
823             This method returns false by default.
824              
825             You can override it to return true, or do something like this:
826              
827             app "Local::MyApp" => sub {
828             ...;
829            
830             method "debug_mode" => sub {
831             return $ENV{MYAPP_DEBUG} || 0;
832             };
833             };
834              
835             =item C<< config_file >>
836              
837             Returns the empty list by default.
838              
839             If you override it to return a list of filenames (not full path names, just
840             simple filenames like "myapp.json"), your app will use these filenames to
841             find configuration settings.
842              
843             =item C<< find_config >>
844              
845             If C<config_file> returns a non-empty list, this method will check the current
846             working directory, a user-specific config directory (C<< ~/.config/ >> on
847             Linux/Unix, another operating systems will vary), and a system-wide config
848             directory (C<< /etc/ >> on Linux/Unix), and return a list of config files found
849             in those directories as L<Path::Tiny> objects.
850              
851             =item C<< read_config >>
852              
853             If given a list of Path::Tiny objects, will read each file as a config file
854             and attempt to merge the results into a single hashref, which it will return.
855              
856             If an empty list is given, will call C<find_config> to get a list of Path::Tiny
857             objects.
858              
859             This allows your system-wide config in C<< /etc/myapp.json >> to be overridden
860             by user-specific C<< ~/.config/myapp.json >> and a local C<< ./myapp.json >>.
861              
862             You should rarely need to call this manually. (The C<execute> method will call
863             it as needed and pass any relevant configuration to the subcommand that it
864             dispatches to.) It may sometimes be useful to override it if you need to
865             support a different way of merging configuration data from multiple files,
866             or if you need to be able to read configuration data from a non-file source.
867              
868             =item C<< read_single_config >>
869              
870             Helper method called by C<read_config>.
871              
872             Determines config file type by the last part of the filename. Understands
873             JSON, INI, YAML, and TOML, and will assume TOML if the file type cannot be
874             determined from its name.
875              
876             Config::Tiny and YAML::XS or YAML::PP are required for reading those file
877             types, but are not included in Zydeco::Lite::App's list of dependencies.
878             TOML is the generally recommended file format for apps created with this
879             module.
880              
881             This method may be useful to override if you need to be able to handle other
882             file types.
883              
884             =item C<< kingpin >>
885              
886             Returns a L<Getopt::Kingpin> object populated with everything necessary to
887             perform command-line processing for this app.
888              
889             You will rarely need to call this manually or override it.
890              
891             =item C<< exit >>
892              
893             Passed an integer, exits with that exit code.
894              
895             You may want to override this if you wish to perform some cleanup on exit.
896              
897             =back
898              
899             =head2 C<< command >>
900              
901             The C<command> keyword is used to define a subcommand for your app. An app
902             should have one or more subcommands. It is a wrapper for the C<class> keyword
903             exported by L<Zydeco::Lite>.
904              
905             The C<command> keyword adds the Zydeco::Lite::App::Trait::Command role
906             (a.k.a. the Command trait) to the class it defines.
907              
908             Commands may have zero or more args and flags. Args are (roughly speaking)
909             positional parameters, passed to the command's C<execute> method, while flags
910             are named arguments passed the the command's constructor.
911              
912             =head3 The Command Trait
913              
914             =over
915              
916             =item C<< command_name >>
917              
918             The Command trait requires your class to implement the C<command_name> method.
919             However, the C<command> keyword will provide a default implementation for you
920             if you have not. The default implementation uses the class name of the command
921             (minus its app prefix), lowercases it, and replaces "::" with "-".
922              
923             So given the example:
924              
925             app "MyApp::Local", sub {
926             command "Add::Recursive", sub {
927             run { ... };
928             };
929             };
930              
931             The package name of the command will be "MyApp::Local::Add::Recursive", and
932             the command name will be "add-recursive".
933              
934             =item C<< documentation >>
935              
936             This method is called to get a brief one-line description of the command.
937              
938             app "MyApp::Local", sub {
939             command "Add::Recursive", sub {
940            
941             method "documentation" => sub {
942             return "Adds a directory recursively.";
943             };
944            
945             run { ... };
946             };
947             };
948              
949             You may prefer to use C<constant> to define this method in your command class.
950              
951             app "MyApp::Local", sub {
952             command "Add::Recursive", sub {
953            
954             constant "documentation" => "Adds a directory recursively.";
955            
956             run { ... };
957             };
958             };
959              
960             See L<Zydeco::Lite> for more information on the C<method> and C<constant>
961             keywords.
962              
963             =item C<< execute >>
964              
965             Each subcommand is required to implement an C<execute> method.
966              
967             app "MyApp::Local", sub {
968             command "Add::Recursive", sub {
969            
970             method "execute" => sub {
971             ...;
972             };
973             };
974             };
975              
976             The subcommand's C<execute> method is called by the app's C<execute> method.
977             It is passed the subcommand object (C<< $self >>) followed by any command-line
978             arguments that were given, which may have been coerced. (See L</arg>.)
979              
980             It should return the application's exit code; usually 0 for a successful
981             execution, and an integer from 1 to 255 if unsuccessful.
982              
983             The C<run> keyword provides a helpful shortcut for defining the C<execute>
984             method. (See L</run>.)
985              
986             =item C<< app >>
987              
988             Returns the app as an object or package name.
989              
990             app "MyApp::Local", sub {
991             command "Add::Recursive", sub {
992            
993             method "execute" => sub {
994             my ( $self, @args ) = ( shift, @_ );
995             ...;
996             $self->app->success( "Done!" );
997             $self->app->exit( 0 );
998             };
999             };
1000             };
1001              
1002             The C<print>, C<debug>, C<info>, C<warn>, C<error>, C<fatal>, C<usage>,
1003             C<success>, and C<readline> methods are delegated to C<app>, so
1004             C<< $self->app->success(...) >> can just be written as
1005             C<< $self->success(...) >>.
1006              
1007             =item C<< config >>
1008              
1009             Returns the config section as a hashref for this subcommand only.
1010              
1011             So for example, if myapp.json had:
1012              
1013             {
1014             "globals": { "foo": 1, "bar": 2 },
1015             "bumpf": { "bar": 3, "bat": 999 },
1016             "quuux": { "bar": 4, "baz": 5 }
1017             }
1018              
1019             Then the Quuux command would see the following config:
1020              
1021             {
1022             "foo" => 1,
1023             "bar" => 4,
1024             "baz" => 5,
1025             }
1026              
1027             The C<globals> section in a config is special and gets copied to all commands.
1028              
1029             =item C<< kingpin >>
1030              
1031             Utility method used by the app's C<kingpin> method to add a
1032             L<Getopt::Kingpin::Command> object for processing this subcommand's arguments.
1033             You are unlikely to need to override this method or call it directly.
1034              
1035             =back
1036              
1037             =head2 C<< arg >>
1038              
1039             Defines a command-line argument for a subcommand.
1040              
1041             use Zydeco::Lite::App;
1042             use Types::Path::Tiny -types;
1043            
1044             app "Local::MyApp" => sub {
1045             command "Add" => sub {
1046            
1047             arg 'filename' => ( type => File, required => 1 );
1048            
1049             run {
1050             my ( $self, $file ) = ( shift, @_ );
1051             ...;
1052             };
1053             };
1054             };
1055              
1056             Arguments are ordered and are passed on the command line like follows:
1057              
1058             $ ./myapp.pl add myfile.txt
1059              
1060             The C<arg> keyword acts a lot like L<Zydeco::Lite>'s C<has> keyword.
1061              
1062             It supports the following options for an argument:
1063              
1064             =over
1065              
1066             =item C<< type >>
1067              
1068             The type constraint for the argument. The following types (from
1069             L<Types::Standard> and L<Types::Path::Tiny>) are supported:
1070             B<Int>, B<Num>, B<Str>, B<File>, B<Dir>, B<Path>,
1071             B<< ArrayRef[Int] >>, B<< ArrayRef[Num] >>, B<< ArrayRef[Str] >>,
1072             B<< ArrayRef[File] >>, B<< ArrayRef[Dir] >>, B<< ArrayRef[Path] >>,
1073             B<< HashRef[Int] >>, B<< HashRef[Num] >>, B<< HashRef[Str] >>,
1074             B<< HashRef[File] >>, B<< HashRef[Dir] >>, B<< HashRef[Path] >>,
1075             as well as any custom type constraint which can be coerced from strings.
1076              
1077             HashRef types are passed on the command line like:
1078              
1079             ./myapp.pl somecommand key1=value1 key2=value2
1080              
1081             =item C<< kingpin_type >>
1082              
1083             In cases where C<type> is a custom type constraint and Zydeco::Lite::App
1084             cannot figure out what to do with it, you can set C<kingpin_type> to be
1085             one of the above supported types to act as a hint about how to process it.
1086              
1087             =item C<< required >>
1088              
1089             A boolean indicating whether the argument is required. (Optional otherwise.)
1090             Optional arguments may be better as a L</flag>.
1091              
1092             =item C<< documentation >>
1093              
1094             A one-line description of the argument.
1095              
1096             =item C<< placeholder >>
1097              
1098             A string to use as a placeholder value for the argument in help text.
1099              
1100             =item C<< default >>
1101              
1102             A non-reference default value for the argument, or a coderef that when called
1103             will generate a default value (which may be a reference).
1104              
1105             =item C<< env >>
1106              
1107             An environment variable which will override the default value if it is given.
1108              
1109             =back
1110              
1111             Arguments don't need to be defined directly within a command. It is possible
1112             for a command to "inherit" arguments from a role or parent class, but this is
1113             usually undesirable as it may lead to their order being hard to predict.
1114              
1115             =head2 C<< flag >>
1116              
1117             Flags are command-line options which are passed as C<< --someopt >> on the
1118             command line.
1119              
1120             use Zydeco::Lite::App;
1121             use Types::Path::Tiny -types;
1122              
1123             app "Local::MyApp" => sub {
1124             command "Add" => sub {
1125            
1126             arg 'filename' => ( type => File, required => 1 );
1127            
1128             flag 'logfile' => (
1129             init_arg => 'log',
1130             type => File,
1131             handles => { 'append_log' => 'append' },
1132             default => sub { Path::Tiny::path('log.txt') },
1133             );
1134            
1135             run {
1136             my ( $self, $file ) = ( shift, @_ );
1137             $self->append_log( "Starting work...\n" );
1138             ...;
1139             };
1140             };
1141             };
1142              
1143             This would be called as:
1144              
1145             ./myapp.pl add --log=log2.txt filename.txt
1146              
1147             The C<flag> keyword is a wrapper around the C<has> keyword, so supports all
1148             the options supported by C<has> such as C<predicate>, C<handles>, etc.
1149             It also supports all the options described for L</arg> such as C<env> and
1150             C<placeholder>. Additionally there is a C<short> option, allowing for short,
1151             single-letter flag aliases:
1152              
1153             flag 'logfile' => (
1154             init_arg => 'log',
1155             type => File,
1156             short => 'L',
1157             );
1158              
1159             Instead of being initialized using command-line arguments, flags can also be
1160             initialized in the application's config file. Flags given on the command line
1161             override flags in the config files; flags given in config files override those
1162             given by environment variables; environment variables override defaults.
1163              
1164             Like args, flags can be defined in a parent class or a role. It can be helpful
1165             to define common flags in a role.
1166              
1167             =head2 C<< run >>
1168              
1169             The C<run> keyword just defines a method called "execute". The following are
1170             equivalent:
1171              
1172             run { ... };
1173             method 'execute' => sub { ... };
1174              
1175             =head1 BUGS
1176              
1177             Please report any bugs to
1178             L<http://rt.cpan.org/Dist/Display.html?Queue=Zydeco-Lite-App>.
1179              
1180             =head1 SEE ALSO
1181              
1182             This module extends L<Zydeco::Lite> to add support for rapid development of
1183             command-line apps.
1184              
1185             L<Z::App> is a shortcut for importing this module plus a collection of others
1186             that might be useful to you, including type constraint libraries, L<strict>,
1187             L<warnings>, etc.
1188              
1189             L<Getopt::Kingpin> is used for processing command-line arguments.
1190              
1191             =head1 AUTHOR
1192              
1193             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
1194              
1195             =head1 COPYRIGHT AND LICENCE
1196              
1197             This software is copyright (c) 2020 by Toby Inkster.
1198              
1199             This is free software; you can redistribute it and/or modify it under
1200             the same terms as the Perl 5 programming language system itself.
1201              
1202             =head1 DISCLAIMER OF WARRANTIES
1203              
1204             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
1205             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
1206             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.