line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::CLI::Extension::Component::RunCommand; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
App::CLI::Extension::Component::RunCommand - for App::CLI::Command run_command override module |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 VERSION |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
1.421 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=cut |
14
|
|
|
|
|
|
|
|
15
|
18
|
|
|
18
|
|
101
|
use strict; |
|
18
|
|
|
|
|
33
|
|
|
18
|
|
|
|
|
578
|
|
16
|
18
|
|
|
18
|
|
15426
|
use MRO::Compat; |
|
18
|
|
|
|
|
33028
|
|
|
18
|
|
|
|
|
229
|
|
17
|
18
|
|
|
18
|
|
590
|
use Error qw(:try); |
|
18
|
|
|
|
|
39
|
|
|
18
|
|
|
|
|
152
|
|
18
|
18
|
|
|
18
|
|
3749
|
use base qw(Class::Accessor::Grouped); |
|
18
|
|
|
|
|
41
|
|
|
18
|
|
|
|
|
7240
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $FAIL_EXIT_VALUE = 255; |
21
|
|
|
|
|
|
|
our $VERSION = '1.421'; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors(inherited => "e", "exit_value", "finished"); |
24
|
|
|
|
|
|
|
__PACKAGE__->exit_value(0); |
25
|
|
|
|
|
|
|
__PACKAGE__->finished(0); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub run_command { |
29
|
|
|
|
|
|
|
|
30
|
16
|
|
|
16
|
0
|
53
|
my($self, @argv) = @_; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
try { |
33
|
16
|
|
|
16
|
|
1210
|
$self->setup(@argv); |
34
|
16
|
|
|
|
|
1372
|
$self->prerun(@argv); |
35
|
16
|
100
|
|
|
|
1036
|
if ($self->finished == 0) { |
36
|
15
|
|
|
|
|
1665
|
$self->run(@argv); |
37
|
10
|
|
|
|
|
738
|
$self->postrun(@argv); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
catch App::CLI::Extension::Exception with { |
41
|
|
|
|
|
|
|
# $self->e is App::CLI::Extension::Exception object. execute $self->throw($message) |
42
|
4
|
|
|
4
|
|
361
|
$self->e(shift); |
43
|
4
|
|
|
|
|
198
|
$self->exit_value($FAIL_EXIT_VALUE); |
44
|
4
|
|
|
|
|
65
|
$self->fail(@argv); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
otherwise { |
47
|
|
|
|
|
|
|
# $self->e is Error::Simple object |
48
|
1
|
|
|
1
|
|
208
|
$self->e(shift); |
49
|
1
|
|
|
|
|
46
|
$self->exit_value($FAIL_EXIT_VALUE); |
50
|
1
|
|
|
|
|
13
|
$self->fail(@argv); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
finally { |
53
|
16
|
|
|
16
|
|
929
|
$self->finish(@argv); |
54
|
16
|
|
|
|
|
401
|
}; |
55
|
|
|
|
|
|
|
|
56
|
16
|
100
|
|
|
|
477
|
if (exists $ENV{APPCLI_NON_EXIT}) { |
57
|
18
|
|
|
18
|
|
112
|
no strict "refs"; ## no critic |
|
18
|
|
|
|
|
42
|
|
|
18
|
|
|
|
|
5362
|
|
58
|
15
|
|
|
|
|
198
|
my $dispatch_pkg = $self->app; |
59
|
15
|
|
|
|
|
681
|
${"$dispatch_pkg\::EXIT_VALUE"} = $self->exit_value; |
|
15
|
|
|
|
|
1330
|
|
60
|
|
|
|
|
|
|
} else { |
61
|
1
|
|
|
|
|
25
|
exit $self->exit_value; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
####################################### |
66
|
|
|
|
|
|
|
# for run_command method |
67
|
|
|
|
|
|
|
####################################### |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub setup { |
70
|
|
|
|
|
|
|
|
71
|
16
|
|
|
16
|
0
|
379
|
my($self, @argv) = @_; |
72
|
|
|
|
|
|
|
# something to do |
73
|
16
|
|
|
|
|
247
|
$self->maybe::next::method(@argv); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub prerun { |
77
|
|
|
|
|
|
|
|
78
|
16
|
|
|
16
|
0
|
98
|
my($self, @argv) = @_; |
79
|
|
|
|
|
|
|
# something to do |
80
|
16
|
|
|
|
|
89
|
$self->maybe::next::method(@argv); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub finish { |
84
|
|
|
|
|
|
|
|
85
|
16
|
|
|
16
|
0
|
89
|
my($self, @argv) = @_; |
86
|
|
|
|
|
|
|
# something to do |
87
|
16
|
|
|
|
|
78
|
$self->maybe::next::method(@argv); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub postrun { |
91
|
|
|
|
|
|
|
|
92
|
10
|
|
|
10
|
0
|
93
|
my($self, @argv) = @_; |
93
|
|
|
|
|
|
|
# something to do |
94
|
10
|
|
|
|
|
74
|
$self->maybe::next::method(@argv); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub fail { |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
0
|
0
|
|
my($self, @argv) = @_; |
100
|
0
|
|
|
|
|
|
chomp(my $message = $self->e->stringify); |
101
|
0
|
|
|
|
|
|
warn sprintf("default fail method. error message:%s. override fail method!!\n", $message); |
102
|
0
|
|
|
|
|
|
$self->maybe::next::method(@argv); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
1; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
__END__ |