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. |