File Coverage

blib/lib/MooX/Ipc/Cmd.pm
Criterion Covered Total %
statement 104 109 95.4
branch 26 38 68.4
condition 2 5 40.0
subroutine 24 26 92.3
pod n/a
total 156 178 87.6


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   6020 use Moo::Role;
  5         21397  
  5         39  
38 5     5   2645 use MooX::Options;
  5         37986  
  5         43  
39 5     5   60624 use Config qw();
  5         11  
  5         181  
40 5     5   3908 use Types::Standard qw(Optional Dict slurpy Object ArrayRef Str);
  5         433695  
  5         89  
41 5     5   12429 use Type::Params qw(compile);
  5         74895  
  5         59  
42              
43             # use List::Util qw(any);
44 5     5   5403 use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
  5         39157  
  5         81  
45             with('MooX::Log::Any');
46 5     5   9856 use feature qw(state);
  5         10  
  5         606  
47 5     5   4323 use IPC::Run3;
  5         127317  
  5         347  
48 5     5   2943 use MooX::Ipc::Cmd::Exception;
  5         21  
  5         249  
49 5     5   48 use List::Util 1.33;
  5         180  
  5         436  
50 5     5   3480 use namespace::autoclean;
  5         54067  
  5         26  
51              
52              
53              
54 5     5   706 use constant UNDEFINED_POSIX_RE => qr{not (?:defined|a valid) POSIX macro|not implemented on this architecture};
  5         12  
  5         7311  
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   72039 state $check= compile(Object, ArrayRef [Str], slurpy Dict [valid_exit=>Optional[ArrayRef]]);
116 27         20735 my ($self, $cmd,$opt) = $check->(@_);
117              
118 27         2603 $self->logger('_cmd')->debug('Executing ' . join(' ', @$cmd));
119 27 50       10125 return 0 if ($self->mock);
120              
121 27         79 my $stderr=[];
122              
123 27 100       46 if (scalar @{$cmd} == 1)
  27         108  
124             {
125             run3($cmd->[0], \undef,
126 0     0   0 sub {$self->_cmd_stdout($_)},
127 1     1   3577 sub {$self->_cmd_stderr($stderr, undef, $_)},
128 13         203 {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   9594 sub {$self->_cmd_stderr($stderr, undef, $_);},
136 14         185 {return_if_system_error => 1},
137             );
138             }
139              
140 27         333864 my $error = $?;
141 27         363 $self->_check_error($error, $cmd, $stderr,$opt);
142 2         15 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   44312 state $check= compile(Object, ArrayRef [Str],slurpy Dict [valid_exit=>Optional[ArrayRef]]);
168 9         34173 my ($self, $cmd,$opt) = $check->(@_);
169 9         721 $self->logger('_cmd')->debug('Executing ' . join(' ', @$cmd));
170              
171 9 50       8967 return 0 if ($self->mock);
172              
173 9         25 my $output = [];
174 9         17 my $stderr = [];
175 9 100       37 if (scalar @$cmd == 1)
176             {
177             run3($cmd->[0], \undef,
178 6     6   28473 sub {$self->_cmd_stdout($_, $output);},
179 1     1   4317 sub {$self->_cmd_stderr($stderr, $output, $_);},
180 4         75 {return_if_system_error => 1});
181             }
182             else
183             {
184             run3($cmd, \undef,
185 19     19   32792 sub {$self->_cmd_stdout($_, $output);},
186 1     1   3871 sub {$self->_cmd_stderr($stderr, $output, $_);},
187 5         88 {return_if_system_error => 1},
188             );
189             }
190 9         1421 my $exit_status = $?;
191              
192             $self->_check_error($exit_status, $cmd, $stderr) unless
193 9 50 33     120 (defined $opt->{valid_exit} && $opt->{valid_exit}==1);
194 7 50       47 if (defined $output)
195             {
196 7 100       28 if (wantarray)
197             {
198 5         73 return @$output;
199             }
200             else
201             {
202 2         26 return $output;
203             }
204             }
205 0         0 else {return}
206             }
207              
208             sub _cmd_stdout
209             {
210 25     25   60 my $self = shift;
211 25         64 my ($line, $output) = @_;
212 25 50       103 if (defined $output)
213             {
214 25         87 push(@$output, $line);
215             }
216 25         66 chomp $line;
217 25         129 $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 5     5   93 my $self = shift;
225 5         16 my $stderr = shift;
226 5         14 my $output = shift;
227 5         25 my $line = $_; # output from cmd
228              
229 5 50       168 return if ($line =~ / Batch system concurrent query limit exceeded/); # ignores lfs spew
230 5 100       33 push(@$output, $line) if (defined $output);
231 5         20 chomp $line;
232 5         26 push(@$stderr, $line);
233 5 50       54 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   120 my $self = shift;
243 36         139 my ($child_error, $cmd, $stderr,$opt) = @_;
244 36 50       193 if (! exists $opt->{valid_exit})
245             {
246 36         248 $opt->{valid_exit}=[0];
247             }
248              
249 36 100       238 if ($child_error == -1)
250             {
251 3         56 my $opt = {
252             cmd => $cmd,
253             exit_status => $child_error,
254             stderr => [$!],
255             };
256 3 50       25 $opt->{stderr} = $stderr if (defined $stderr);
257 3         107 MooX::Ipc::Cmd::Exception->throw($opt);
258             }
259 33 100       702 if (WIFSIGNALED($child_error)) # check to see if child error
    100          
260             {
261 1         5 my $signal_no = WTERMSIG($child_error);
262              
263             #kill with signal if told to
264 1 50       11 if ($self->_cmd_kill)
265             {
266 0         0 kill $signal_no;
267             }
268              
269 1   50     10 my $signal_name = $self->_cmd_signal_from_number->[$signal_no] || "UNKNOWN";
270              
271 1         13 my $opt = {
272             cmd => $cmd,
273             exit_status => $child_error,
274             signal => $signal_name,
275             };
276 1 50       6 $opt->{stderr} = $stderr if (defined $stderr);
277 1         27 MooX::Ipc::Cmd::Exception->throw($opt);
278             }
279 32     32   685 elsif (!List::Util::any {$_ eq $child_error} @{$opt->{valid_exit}})
  32         334  
280             {
281 23         238 my $opt = {
282             cmd => $cmd,
283             exit_status => $child_error >> 8, # get the real exit status if no signal
284             };
285 23 50       189 $opt->{stderr} = $stderr if (defined $stderr);
286 23         648 MooX::Ipc::Cmd::Exception->throw($opt);
287             }
288             }
289             1;
290              
291             __END__