File Coverage

blib/lib/MooX/Ipc/Cmd.pm
Criterion Covered Total %
statement 103 109 94.5
branch 26 38 68.4
condition 2 5 40.0
subroutine 23 26 88.4
pod n/a
total 154 178 86.5


line stmt bran cond sub pod time code
1             #ABSTRACT: Moo role for issuing commands, with debug support, and signal handling
2              
3             #pod =head1 SYNOPSIS
4             #pod
5             #pod This role provides the ability to capture system calls, and to execute system calls.
6             #pod
7             #pod Features
8             #pod
9             #pod =for :list
10             #pod * Prints output in realtime, in debug mode
11             #pod * Handles signals, and kills via signal if configured too.
12             #pod * Uses Log::Any for logging. If in debug mode, will log output of commands, and execution line
13             #pod * Command line option
14             #pod
15             #pod package Moo_Package;
16             #pod use Moo;
17             #pod use MooX::Options; # required before with statement
18             #pod with qw(MooX::Ipc::Cmd);
19             #pod
20             #pod has '+_cmd_kill' => (default=>1); # override default
21             #pod sub run {
22             #pod my $self=shift
23             #pod $self->_system(['cmd']);
24             #pod my @result=$self->_capture(['results']);
25             #pod }
26             #pod 1;
27             #pod
28             #pod package main
29             #pod use Log::Any::Adapter('Stdout'); #setup Log::Any::Adapter;
30             #pod my $app=Moo_Package->new_with_options(_cmd_kill=>0); #command line processing
31             #pod my $app=Moo_Package->new(_cmd_kill=>0); #no command line processing
32             #pod 1;
33             #pod
34             #pod =cut
35              
36             package MooX::Ipc::Cmd;
37 5     5   5409 use Moo::Role;
  5         13715  
  5         38  
38 5     5   2190 use MooX::Options;
  5         24300  
  5         56  
39 5     5   45791 use Config qw();
  5         9  
  5         115  
40 5     5   3321 use Types::Standard qw(Optional Dict slurpy Object ArrayRef Str);
  5         373812  
  5         86  
41 5     5   9941 use Type::Params qw(compile);
  5         64043  
  5         74  
42              
43             # use List::Util qw(any);
44 5     5   4197 use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
  5         31107  
  5         30  
45             with('MooX::Log::Any');
46 5     5   5653 use feature qw(state);
  5         10  
  5         540  
47 5     5   3196 use IPC::Run3;
  5         103086  
  5         373  
48 5     5   2766 use MooX::Ipc::Cmd::Exception;
  5         16  
  5         249  
49 5     5   41 use List::Util 1.33;
  5         174  
  5         341  
50 5     5   24 use namespace::autoclean;
  5         10  
  5         36  
51              
52              
53              
54 5     5   866 use constant UNDEFINED_POSIX_RE => qr{not (?:defined|a valid) POSIX macro|not implemented on this architecture};
  5         20  
  5         7487  
55              
56             has _cmd_signal_from_number => (
57             is => 'lazy',
58             default => sub {return [split(' ', $Config::Config{sig_name})]},
59             documentation => 'Posix signal number'
60             );
61              
62              
63             #pod =attribute _cmd_kill
64             #pod
65             #pod If set to 1 will send the propgate signal when cmd exits due to signal.
66             #pod
67             #pod Reader: _cmd_kill
68             #pod
69             #pod Default: 1
70             #pod
71             #pod =cut
72              
73             has _cmd_kill => (
74             is => 'ro',
75             default => 0,
76             documentation => 'If set to 1 will send the propogate signal when cmd exits due to signal.'
77             );
78              
79             #pod =attribute mock
80             #pod
81             #pod Mocks the cmd, does not run
82             #pod
83             #pod Reader: mock
84             #pod
85             #pod Default: 0
86             #pod
87             #pod Command line option, via MooX::Options
88             #pod
89             #pod =cut
90              
91             option mock => (
92             is => 'ro',
93             default => 0,
94             documentation => 'Mocks the cmd, does not run'
95             );
96              
97             #pod =method _system(\@cmd', /%opts);
98             #pod
99             #pod Runs a command like system call, with the output silently dropped, unless in log::any debug level
100             #pod
101             #pod =for :list
102             #pod = Params:
103             #pod $cmd : arrayref of the command to send to the shell
104             #pod %opts
105             #pod valid_exit => [0] - exits to not throw exception, defaults to 0
106             #pod = Returns:
107             #pod exit code
108             #pod = Exception
109             #pod Throws an error when case dies, will also log error using log::any category _cmd
110             #pod
111             #pod =cut
112              
113             sub _system
114             {
115 27     27   54451 state $check= compile(Object, ArrayRef [Str], slurpy Dict [valid_exit=>Optional[ArrayRef]]);
116 27         27088 my ($self, $cmd,$opt) = $check->(@_);
117              
118 27         1845 $self->logger('_cmd')->debug('Executing ' . join(' ', @$cmd));
119 27 50       10704 return 0 if ($self->mock);
120              
121 27         63 my $stderr=[];
122              
123 27 100       75 if (scalar @{$cmd} == 1)
  27         136  
124             {
125             run3($cmd->[0], \undef,
126 0     0   0 sub {$self->_cmd_stdout($_)},
127 1     1   4049 sub {$self->_cmd_stderr($stderr, undef, $_)},
128 13         171 {return_if_system_error => 1},
129             );
130             }
131             else
132             {
133             run3($cmd, \undef,
134 0     0   0 sub {$self->_cmd_stdout($_);},
135 2     2   6232 sub {$self->_cmd_stderr($stderr, undef, $_);},
136 14         145 {return_if_system_error => 1},
137             );
138             }
139              
140 27         300588 my $error = $?;
141 27         331 $self->_check_error($error, $cmd, $stderr,$opt);
142 2         23 return $error;
143             }
144              
145             #pod =method _capture(\@cmd',\%opts);
146             #pod
147             #pod Runs a command like qx call. Will display cmd executed
148             #pod
149             #pod =begin :list
150             #pod
151             #pod = Params:
152             #pod $cmd: arrayref of the command to send to the shell
153             #pod %opts:
154             #pod valid_exit => [0] - exits to not throw exception, defaults to 0
155             #pod
156             #pod = Returns:
157             #pod combined stderr stdout
158             #pod = Exception
159             #pod Throws an MooX::Ipc::Cmd::Exception error
160             #pod
161             #pod =end :list
162             #pod
163             #pod =cut
164              
165             sub _capture
166             {
167 9     9   35026 state $check= compile(Object, ArrayRef [Str],slurpy Dict [valid_exit=>Optional[ArrayRef]]);
168 9         21469 my ($self, $cmd,$opt) = $check->(@_);
169 9         726 $self->logger('_cmd')->debug('Executing ' . join(' ', @$cmd));
170              
171 9 50       8053 return 0 if ($self->mock);
172              
173 9         18 my $output = [];
174 9         19 my $stderr = [];
175 9 100       32 if (scalar @$cmd == 1)
176             {
177             run3($cmd->[0], \undef,
178 6     6   17652 sub {$self->_cmd_stdout($_, $output);},
179 0     0   0 sub {$self->_cmd_stderr($stderr, $output, $_);},
180 4         49 {return_if_system_error => 1});
181             }
182             else
183             {
184             run3($cmd, \undef,
185 19     19   35400 sub {$self->_cmd_stdout($_, $output);},
186 1     1   4168 sub {$self->_cmd_stderr($stderr, $output, $_);},
187 5         68 {return_if_system_error => 1},
188             );
189             }
190 9         3319 my $exit_status = $?;
191              
192             $self->_check_error($exit_status, $cmd, $stderr) unless
193 9 50 33     133 (defined $opt->{valid_exit} && $opt->{valid_exit}==1);
194 7 50       40 if (defined $output)
195             {
196 7 100       23 if (wantarray)
197             {
198 5         75 return @$output;
199             }
200             else
201             {
202 2         16 return $output;
203             }
204             }
205 0         0 else {return}
206             }
207              
208             sub _cmd_stdout
209             {
210 25     25   53 my $self = shift;
211 25         55 my ($line, $output) = @_;
212 25 50       122 if (defined $output)
213             {
214 25         73 push(@$output, $line);
215             }
216 25         57 chomp $line;
217 25         126 $self->logger('_cmd')->debug($line);
218             }
219              
220             #sub routine to push output to the stderr and global output variables
221             # ignores lfs batch system concurrent spew
222             sub _cmd_stderr
223             {
224 4     4   19 my $self = shift;
225 4         10 my $stderr = shift;
226 4         11 my $output = shift;
227 4         15 my $line = $_; # output from cmd
228              
229 4 50       35 return if ($line =~ / Batch system concurrent query limit exceeded/); # ignores lfs spew
230 4 100       34 push(@$output, $line) if (defined $output);
231 4         13 chomp $line;
232 4         16 push(@$stderr, $line);
233 4 50       36 if ($self->logger('_cmd')->is_debug)
234             {
235 0         0 $self->logger('_cmd')->debug($line);
236             }
237             }
238              
239             #most of _check_error stolen from IPC::Simple
240             sub _check_error
241             {
242 36     36   128 my $self = shift;
243 36         134 my ($child_error, $cmd, $stderr,$opt) = @_;
244 36 50       184 if (! exists $opt->{valid_exit})
245             {
246 36         271 $opt->{valid_exit}=[0];
247             }
248              
249 36 100       248 if ($child_error == -1)
250             {
251 3         46 my $opt = {
252             cmd => $cmd,
253             exit_status => $child_error,
254             stderr => [$!],
255             };
256 3 50       29 $opt->{stderr} = $stderr if (defined $stderr);
257 3         108 MooX::Ipc::Cmd::Exception->throw($opt);
258             }
259 33 100       483 if (WIFSIGNALED($child_error)) # check to see if child error
    100          
260             {
261 1         6 my $signal_no = WTERMSIG($child_error);
262              
263             #kill with signal if told to
264 1 50       20 if ($self->_cmd_kill)
265             {
266 0         0 kill $signal_no;
267             }
268              
269 1   50     38 my $signal_name = $self->_cmd_signal_from_number->[$signal_no] || "UNKNOWN";
270              
271 1         23 my $opt = {
272             cmd => $cmd,
273             exit_status => $child_error,
274             signal => $signal_name,
275             };
276 1 50       11 $opt->{stderr} = $stderr if (defined $stderr);
277 1         43 MooX::Ipc::Cmd::Exception->throw($opt);
278             }
279 32     32   308 elsif (!List::Util::any {$_ eq $child_error} @{$opt->{valid_exit}})
  32         290  
280             {
281 23         226 my $opt = {
282             cmd => $cmd,
283             exit_status => $child_error >> 8, # get the real exit status if no signal
284             };
285 23 50       130 $opt->{stderr} = $stderr if (defined $stderr);
286 23         564 MooX::Ipc::Cmd::Exception->throw($opt);
287             }
288             }
289             1;
290              
291             __END__