1This is Perl module App-CLI-Extension.
2
3INSTALLATION
4
5App-CLI-Extension installation is straightforward. If your CPAN shell is set up,
6you should just be able to do
7
8 % cpan App-CLI-Extension
9
10Download it, unpack it, then build it as per the usual:
11
12 % perl Makefile.PL
13 % make && make test
14
15Then install it:
16
17 % make install
18
19DOCUMENTATION
20
21App-CLI-Extension documentation is available as in POD. So you can do:
22
23 % perldoc App-CLI-Extension
24
25to read the documentation online with your favorite pager.
26
27Akira Horimoto
28
1package App::CLI::Extension;
2
3=pod
4
5=head1 NAME
6
7App::CLI::Extension - for App::CLI extension module
8
9=head1 VERSION
10
111.421
12
13=head1 SYNOPSIS
14
15 # MyApp.pm
16 package MyApp;
17
18 use strict;
19 use base qw(App::CLI::Extension);
20
21 # extension method
22 # load App::CLI::Plugin::Foo, MyApp::Plugin::Bar
23 __PACKAGE__->load_plugins(qw(Foo +MyApp::Plugin::Bar));
24
25 # extension method
26 __PACKAGE__->config( name => "kurt" );
27
28 1;
29
30 # MyApp/Hello.pm
31 package MyApp::Hello;
32
33 use strict;
34 use base qw(App::CLI::Command);
35 use constant options => ("age=i" => "age");
36
37 sub run {
38
39 my($self, @args) = @_;
40 # config - App::CLI::Extension extension method(App::CLI::Extension::Component::Config)
41 print "Hello! my name is " . $self->config->{name} . "\n";
42 print "age is " . "$self->{age}\n";
43 }
44
45 # myapp
46 #!/usr/bin/perl
47
48 use strict;
49 use MyApp;
50
51 MyApp->dispatch;
52
53 # execute
54 [kurt@localhost ~] myapp hello --age=27
55 Hello! my name is kurt
56 age is 27
57
58=head1 DESCRIPTION
59
60The expansion module which added plug in, initial setting mechanism to App::CLI
61
62App::CLI::Extension::Component::* modules is automatic, and it is done require
63
64(It is now Config and Stash is automatic, and it is done require)
65
66=head2 RUN PHASE
67
68 +----------------------+
69 | ** run_method ** |
70 | +----------------+ |
71 | | setup phase | |
72 | +----------------+ |
73 | || |
74 | +----------------+ |
75 | | prerun phase | |
76 | +----------------+ |
77 | || |
78 | +----------------+ | if anything error... +----------------+
79 | | run phase | | ======================> | fail phase |
80 | +----------------+ | +----------------+
81 | || | set exit_value(default: 255)
82 | +----------------+ | |
83 | | postrun phase | | |
84 | +----------------+ | |
85 +----------------------+ |
86 | |
87 | |
88 +----------------+ |
89 | finish phase | <================================== +
90 +----------------+
91 |
92 exit
93
94=head2 SETUP
95
96If you define initialization and initialization of each plug-in
97
98=head2 PRERUN
99
100If you want the process to run before you run something in the main processing
101
102=head2 RUN
103
104Process to define the main(require). however, $self->finished non-zero if not executed
105
106=head2 POSTRUN
107
108After the run method to execute. however, $self->finished non-zero if not executed
109
110=head2 FINISH
111
112At the end of all processing
113
114=head2 FAIL
115
116setup/prerun/run/postrun/finish processing to be executed if an exception occurs somewhere in the phase error
117
118$self->e is the App::CLI::Extension::Exception or Error::Simple instance is set
119
120=cut
121
122use strict;
123use warnings;
124use base qw(App::CLI Class::Accessor::Grouped);
125use 5.008000;
126use UNIVERSAL::require;
127
128our $VERSION = '1.421';
129our @COMPONENTS = qw(
130 Config
131 ErrorHandler
132 InstallCallback
133 OriginalArgv
134 Stash
135 RunCommand
136 );
137
138__PACKAGE__->mk_group_accessors(inherited => "_config", "_components", "_orig_argv", "_plugins");
139__PACKAGE__->_config({});
140__PACKAGE__->_plugins([]);
141
142=pod
143
144=head1 METHOD
145
146=cut
147
148sub import {
149
150 my $class = shift;
151 my @loaded_components;
152 foreach my $component (@COMPONENTS) {
153 $component = sprintf "%s::Component::%s", __PACKAGE__, $component;
154 $component->require or die "load component error: $UNIVERSAL::require::ERROR";
155 $component->import;
156 push @loaded_components, $component;
157 }
158 $class->_components(\@loaded_components);
159}
160
161sub dispatch {
162
163 my $class = shift;
164 # save original argv
165 my @argv = @ARGV;
166 $class->_orig_argv(\@argv);
167 my $cmd = $class->prepare(@_);
168 $cmd->subcommand;
169 {
170 no strict "refs"; ## no critic
171 no warnings "uninitialized"; ## adhoc
172 my $pkg = ref($cmd);
173 # component and plugin set value
174 unshift @{"$pkg\::ISA"}, @{$class->_components};
175 if (scalar(@{$class->_plugins}) != 0) {
176 unshift @{"$pkg\::ISA"}, @{$class->_plugins};
177 }
178 $cmd->config($class->_config);
179 $cmd->orig_argv($class->_orig_argv);
180 }
181 $cmd->run_command(@ARGV);
182}
183
184
185=pod
186
187=head2 load_plugins
188
189auto load and require plugin modules
190
191Example
192
193 # MyApp.pm
194 # MyApp::Plugin::GoodMorning and App::CLI::Plugin::Config::YAML::Syck require
195 __PACKAGE__->load_plugins(qw(+MyApp::Plugin::GoodMorning Config::YAML::Syck));
196
197 # MyApp/Plugin/GoodMorning.pm
198 package MyApp::Plugin::GoodMorning;
199
200 use strict;
201
202 sub good_morning {
203
204 my $self = shift;
205 print "Good monring!\n";
206 }
207
208 # MyApp/Hello.pm
209 package MyApp::Hello;
210
211 use strict;
212 use base qw(App::CLI::Command);
213
214 sub run {
215
216 my($self, @args) = @_;
217 $self->good_morning;
218 }
219
220 # myapp
221 #!/usr/bin/perl
222
223 use strict;
224 use MyApp;
225
226 MyApp->dispatch;
227
228 # execute
229 [kurt@localhost ~] myapp hello
230 Good morning!
231
232=cut
233
234sub load_plugins {
235
236 my($class, @load_plugins) = @_;
237
238 my @loaded_plugins = @{$class->_plugins};
239 foreach my $plugin(@load_plugins){
240
241 if ($plugin =~ /^\+/) {
242 $plugin =~ s/^\+//;
243 } else {
244 $plugin = "App::CLI::Plugin::$plugin";
245 }
246 $plugin->require or die "plugin load error: $UNIVERSAL::require::ERROR";
247 $plugin->import;
248 push @loaded_plugins, $plugin;
249 }
250
251 $class->_plugins(\@loaded_plugins);
252}
253
254=pod
255
256=head2 config
257
258configuration method
259
260Example
261
262 # MyApp.pm
263 __PACKAGE__->config(
264 name => "kurt",
265 favorite_group => "nirvana",
266 favorite_song => ["Lounge Act", "Negative Creep", "Radio Friendly Unit Shifter", "You Know You're Right"]
267 );
268
269 # MyApp/Hello.pm
270 package MyApp::Hello;
271
272 use strict;
273 use base qw(App::CLI::Command);
274
275 sub run {
276
277 my($self, @args) = @_;
278 print "My name is " . $self->config->{name} . "\n";
279 print "My favorite group is " . $self->config->{favorite_group} . "\n";
280 print "My favorite song is " . join(",", @{$self->config->{favorite_song}});
281 print " and Smells Like Teen Spirit\n"
282 }
283
284 # myapp
285 #!/usr/bin/perl
286
287 use strict;
288 use MyApp;
289
290 MyApp->dispatch;
291
292 # execute
293 [kurt@localhost ~] myapp hello
294 My name is kurt
295 My favorite group is nirvana
296 My favorite song is Lounge Act,Negative Creep,Radio Friendly Unit Shifter,You Know You're Right and Smells Like Teen Spirit
297
298=cut
299
300sub config {
301
302 my($class, %config) = @_;
303 $class->_config(\%config);
304 return $class->_config;
305}
306
307=head1 COMPONENT METHOD
308
309=head2 argv0
310
311my script name
312
313Example:
314
315 # MyApp/Hello.pm
316 package MyApp::Hello;
317 use strict;
318 use feature ":5.10.0";
319 use base qw(App::CLI::Command);
320
321 sub run {
322
323 my($self, @args) = @_;
324 say "my script name is " . $self->argv0;
325 }
326
327 1;
328
329 # execute
330 [kurt@localhost ~] myapp hello
331 my script name is myapp
332
333=head2 full_argv0
334
335my script fullname
336
337Example:
338
339 # MyApp/Hello.pm
340 package MyApp::Hello;
341 use strict;
342 use feature ":5.10.0";
343 use base qw(App::CLI::Command);
344
345 sub run {
346
347 my($self, @args) = @_;
348 say "my script full name is " . $self->full_argv0;
349 }
350
351 1;
352
353 # execute
354 [kurt@localhost ~] myapp hello
355 my script name is /home/kurt/myapp
356
357=head2 cmdline
358
359my execute cmdline string
360
361Example:
362
363 # MyApp/Hello.pm
364 package MyApp::Hello;
365 use strict;
366 use feature ":5.10.0";
367 use base qw(App::CLI::Command);
368
369 sub run {
370
371 my($self, @args) = @_;
372 say "my script cmdline is [" . $self->cmdline . "]";
373 }
374
375 1;
376
377 # execute
378 [kurt@localhost ~] myapp hello --verbose --num=10
379 my script cmdline is [/home/kurt/myapp hello --verbose --num=10]
380
381=head2 orig_argv
382
383my execute script original argv
384
385Example:
386
387 # MyApp/Hello.pm
388 package MyApp::Hello;
389 use strict;
390 use feature ":5.10.0";
391 use base qw(App::CLI::Command);
392
393 sub run {
394
395 my($self, @args) = @_;
396 say "my script original argv is [" join(", ", @{$self->orig_argv}) . "]";
397 }
398
399 1;
400
401 # execute
402 [kurt@localhost ~] myapp hello --verbose --num=10
403 my script original argv is [hello,--verbose, --num=10]
404
405=head2 stash
406
407like global variable in Command package
408
409Example:
410
411 # MyApp/Hello.pm
412 package MyApp::Hello;
413 use strict;
414 use feature ":5.10.0";
415 use base qw(App::CLI::Command);
416
417 sub run {
418
419 my($self, @args) = @_;
420 $self->stash->{name} = "kurt";
421 say "stash value: " . $self->stash->{name};
422 }
423
424 1;
425
426=head2 new_callback
427
428install new callback phase
429
430Example:
431
432 $self->new_callback("some_phase");
433 # registered callback argument pattern
434 $self->new_callback("some_phase", sub { $self = shift; "anything to do..." });
435
436=head2 add_callback
437
438install callback
439
440Example:
441
442 $self->add_callback("some_phase", sub { my $self = shift; say "some_phase method No.1" });
443 $self->add_callback("some_phase", sub { my $self = shift; say "some_phase method No.1" });
444 $self->add_callback("any_phase", sub {
445 my($self, @args) = @_;
446 say "any_phase args: @args";
447 });
448
449=cut
450
451=head2 exec_callback
452
453execute callback
454
455Example:
456
457 $self->execute_callback("some_phase");
458 # some_phase method method No.1
459 # some_phase method method No.2
460
461 $self->execute_callback("any_phase", qw(one two three));
462 # any_phase args: one two three
463
464=head2 exists_callback
465
466exists callback check
467
468Example:
469
470 if ($self->exists_callback("some_phase")) {
471 $self->exec_callback("some_phase");
472 } else {
473 die "some_phase is not exists callback phase";
474 }
475
476=head2 exit_value
477
478set exit value
479
480Example:
481
482 # program exit value is 1(ex. echo $?)
483 $self->exit_value(1);
484
485=head2 finished
486
487setup or prepare phase and 1 set, run and postrun phase will not run. default 0
488
489Example:
490
491 # MyApp/Hello.pm
492 package MyApp::Hello;
493
494 use strict;
495 use base qw(App::CLI::Command);
496
497 sub prerun {
498
499 my($self, @args) = @_;
500 $self->finished(1);
501 }
502
503 # non execute
504 sub run {
505
506 my($self, @args) = @_;
507 print "hello\n";
508 }
509
510=head2 throw
511
512raises an exception, fail phase transitions
513
514Example:
515
516 # MyApp/Hello.pm
517 package MyApp::Hello;
518
519 use strict;
520 use base qw(App::CLI::Command);
521
522 sub run {
523
524 my($self, @args) = @_;
525 my $file = "/path/to/file";
526 open my $fh, "< $file" or $self->throw("can not open file:$file");
527 while ( my $line = <$fh> ) {
528 chomp $line;
529 print "$line\n";
530 }
531 close $fh;
532 }
533
534 # transitions fail phase method
535 sub fail {
536
537 my($self, @args) = @_;
538 # e is App:CLI::Extension::Exception instance
539 printf "ERROR: %s", $self->e;
540 printf "STACKTRACE: %s", $self->e->stacktrace;
541 }
542
543 # myapp
544 #!/usr/bin/perl
545
546 use strict;
547 use MyApp;
548
549 MyApp->dispatch;
550
551 # execute
552 [kurt@localhost ~] myapp hello
553 ERROR: can not open file:/path/to/file at lib/MyApp/Throw.pm line 10.
554 STACKTRACE: can not open file:/path/to/file at lib/MyApp/Throw.pm line 10
555 MyApp::Throw::run('MyApp::Throw=HASH(0x81bd6b4)') called at /usr/lib/perl5/site_perl/5.8.8/App/CLI/Extension/Component/RunCommand.pm line 36
556 App::CLI::Extension::Component::RunCommand::run_command('MyApp::Throw=HASH(0x81bd6b4)') called at /usr/lib/perl5/site_perl/5.8.8/App/CLI/Extension.pm line 177
557 App::CLI::Extension::dispatch('MyApp') called at ./myapp line 7
558
559when you run throw method, App::CLI::Extension::Exception instance that $self->e is set to.
560
561App::CLI::Extension::Exception is the Error::Simple is inherited. refer to the to documentation of C<Error>
562
563throw method without running CORE::die if you run the $self->e is the Error::Simple instance will be set
564
565=head2 e
566
567App::CLI::Extension::Exception or Error::Simple instance. There is a ready to use, fail phase only
568
569=head1 RUN PHASE METHOD
570
571=head2 setup
572
573=head2 prerun
574
575=head2 postrun
576
577=head2 finish
578
579program last phase. By default, the exit will be executed automatically, exit if you do not want the APPCLI_NON_EXIT environ valiable how do I set the (value is whatever)
580
581=head2 fail
582
583error phase. default exit value is 255. if you want to change exit_value, see exit_value manual
584
585=cut
586
5871;
588
589__END__
590
591=head1 SEE ALSO
592
593L<App::CLI> L<Class::Accessor::Grouped> L<UNIVERSAL::require>
594
595=head1 AUTHOR
596
597Akira Horimoto
598
599=head1 COPYRIGHT AND LICENSE
600
601This library is free software; you can redistribute it and/or modify
602it under the same terms as Perl itself.
603
604Copyright (C) 2009 Akira Horimoto
605
606=cut
607
608