File Coverage

blib/lib/Capture/SystemIO.pm
Criterion Covered Total %
statement 43 53 81.1
branch 10 16 62.5
condition 2 3 66.6
subroutine 13 14 92.8
pod 1 3 33.3
total 69 89 77.5


line stmt bran cond sub pod time code
1             package Capture::SystemIO;
2              
3 1     1   20828 use 5.006000;
  1         4  
4 1     1   6 use strict;
  1         1  
  1         41  
5 1     1   4 use warnings;
  1         6  
  1         34  
6              
7 1     1   584 use POSIX qw(SIGQUIT SIGINT);
  1         6187  
  1         5  
8             #use IO::CaptureOutput qw(qxx);
9 1     1   1438 use Capture::Tiny qw(capture tee);
  1         21336  
  1         56  
10 1     1   6 use Exporter qw(import);
  1         1  
  1         40  
11              
12             use Exception::Class (
13 1         9 'Capture::SystemIO::Interrupt' => {
14             fields => [qw(signal signal_no command stderr stdout)],
15             },
16             'Capture::SystemIO::Signal' => {
17             fields => [qw(signal_no command stderr stdout)],
18             },
19             'Capture::SystemIO::Error' => {
20             fields => [qw(stderr stdout return_code command)],
21             },
22              
23 1     1   439 );
  1         6099  
24             our ($VERSION) = "0.01_4";
25             our @EXPORT_OK = qw(cs_system);
26              
27              
28              
29              
30             #
31             # Swiped from IO::CaptureOutput for easy migration to Capture::Tiny
32             # Please see IO::CaptureOutput for more information.
33             #
34             sub capture_exec {
35 6     6 0 9 my @args = @_;
36 6     6   138 my ($output, $error) = capture sub { system _shell_quote(@args) };
  6         4963  
37 6 50       3459 return wantarray ? ($output, $error) : $output;
38             }
39             #rl cut and pasted from above and swapped out capture for tee.
40             *qxxt = \&capture_exec_t;
41             sub capture_exec_t {
42 1     1 0 5 my @args = @_;
43 1     1   26 my ($output, $error) = tee sub { system _shell_quote(@args) };
  1         10750  
44 1 50       1268 return wantarray ? ($output, $error) : $output;
45             }
46              
47             *qxx = \&capture_exec;
48              
49             # extra quoting required on Win32 systems
50 7     7   11580 *_shell_quote = ($^O =~ /MSWin32/) ? \&_shell_quote_win32 : sub {@_};
51             sub _shell_quote_win32 {
52 0     0   0 my @args;
53 0         0 for (@_) {
54 0 0       0 if (/[ \"]/) { # TODO: check if ^ requires escaping
55 0         0 (my $escaped = $_) =~ s/([\"])/\\$1/g;
56 0         0 push @args, '"' . $escaped . '"';
57 0         0 next;
58             }
59 0         0 push @args, $_
60             }
61 0         0 return @args;
62             }
63              
64             #
65             # End of Swiped Code.
66             #
67              
68              
69              
70              
71              
72              
73             =head1 NAME
74              
75             Capture::SystemIO - system() capture stderr, stdout, and signals.
76              
77              
78             =head1 SYNOPSIS
79              
80             use strict;
81             use warnings;
82             use Capture::SystemIO qw(cs_system);
83              
84             # Run a command; chuck the output.
85             cs_system("dd if=/dev/zero of=/dev/sda");
86              
87              
88             # Run a command and capture STDIN and STDOUT; do something with it.
89             my ($stdin, $stdout) = cs_system("ls -l /bin");
90              
91             print "ls said: $$stdout \n\n ls also mentioned: $$stderr";
92              
93              
94             # Run a command and check for errors.
95             eval {
96             cs_system("sudo rm -rf /");
97             };
98             if (my $e = Exception::Class->Caught("Capture::SystemIO::Interrupt")) {
99             print "Keyboard interrupt. Signal: " $e->signal();
100             exit();
101             } elsif (my $e = Exception::Class->Caught("Capture::SystemIO::Error")) {
102             print "Stderr: ". $e->stderr()
103             ."Stdout: ". $e->stdout()
104             ."Return code: ". $return_code
105             ."Command: ". $command
106             } elsif (my $e = Exception::Class->Caught()) {
107             print "Some other error". $e->stderr();
108             $e->rethrow();
109             }
110              
111              
112              
113              
114             =head1 DESCRIPTION
115              
116              
117             Runs a system command from within Perl and captures both STDOUT
118             and STDERR;
119            
120             provides exception based interface to SIGINT and SIGQUIT;
121              
122             provides exceptions for non-zero return values.
123              
124             =cut
125              
126              
127              
128              
129             =head1 EXPORTS
130              
131             =head2 Default
132              
133             none
134              
135             =head2 Optional
136              
137             cs_system
138              
139             =cut
140              
141              
142              
143              
144             =head1 CLASS METHODS
145              
146              
147              
148             =head2 Capture::SystemIO::cs_system()
149              
150             This is a wrapper for L that uses
151             L along with bits and pieces of L,
152             to capture both STDOUT and STDERR. It also checks the return value of system()
153             and throws an exception if the command terminated unexpectedly because of a
154             signal or the command exited with a non-zero result to indicate failure. In
155             which case, the captured STDOUT and STDERR are contained within the exception
156             object.
157              
158             When used in list context, references to the captured STDOUT and STDERR are
159             returned. In scalar context, however, only numeric exit code for the command is
160             returned.
161              
162             =head3 Example
163              
164             my ($$stdout,$stderr) = cs_system("true");
165             my ($return) = cs_system("true");
166              
167             =head3 Arguments
168              
169             See perfunc system for details
170              
171             =head3 Return
172              
173             The return value depends on the context in which cs_system was called
174              
175             =over
176              
177             =item Scalar
178              
179             The return code from the call to system
180              
181             =item List
182              
183             References to the captured stderr and stdout
184              
185             =back
186              
187              
188             =head3 Exceptions
189              
190             =over
191              
192             =item Capture::SystemIO::Interrupt
193              
194             Thrown if the subprocess terminated as a result of either SIGINT or SIGQUIT
195              
196             =item Capture::SystemIO::Signal
197              
198             Thrown if the subprocess terminated as a result of another signal
199              
200             =item Capture::SystemIO::Error
201              
202             Thrown if the return value of the subprocess is non-zero
203              
204             =back
205              
206             =cut
207              
208             sub cs_system {
209 7     7 1 4505 my @command = @_;
210 7         16 my $command_str = join " ", @command;
211 7         7 my ($stdout, $stderr, $success, $exit_code);
212              
213 7 100 66     32 if ($Capture::SystemIO::T || $ENV{CAPTURE_SYSTEM_T}) {
214 1         6 ($stdout, $stderr, $success, $exit_code) = qxxt(@command);
215             } else {
216 6         13 ($stdout, $stderr, $success, $exit_code) = qxx(@command);
217             }
218 7 100       24 if (my $code = $?) {
219 3         6 my $sig_desc;
220 3 100       10 if (my $signal = ($code & 127)) {
221             $sig_desc = {
222             SIGINT() => "Interrupt",
223             SIGQUIT() => "Quit",
224 2         15 }->{$signal};
225 2 50       7 if ($sig_desc) {
226 2         46 Capture::SystemIO::Interrupt->throw(
227             command => $command_str,
228             stdout => $stdout,
229             stderr => $stderr,
230             signal => $sig_desc
231             );
232             } else {
233 0         0 Capture::SystemIO::Signal->throw(
234             command => $command_str,
235             stdout => $stdout,
236             stderr => $stderr,
237             signal_no => $signal,
238             );
239 0         0 warn "HERE";
240             }
241             }
242             'Capture::SystemIO::Error'->throw(
243 1         26 error => "Command: '$command_str'\n Stderr:\n $stderr",
244             stdout=>$stdout, stderr=>$stderr, return_code => $code,
245             command => $command_str
246             );
247             }
248 4 50       32 wantarray ? \($stdout, $stderr) : $exit_code;
249             }
250              
251              
252              
253              
254             =head1 EXCEPTIONS
255              
256              
257             =head2 Capture::SystemIO::Error
258              
259             =over
260              
261             =item $e->stderr()
262              
263             my $stderr = $e->stderr();
264              
265             =item $e->stdout()
266              
267             my $stdout = $e->stdout();
268              
269             =item $e->return_code()
270              
271             my $return_code = $e->return_code();
272              
273             =item $e->command()
274              
275             my $command = $e->command();
276              
277             =back
278              
279             =head2 Capture::SystemIO::Interrupt
280              
281             =over
282              
283             =item $e->signal()
284              
285             my $signal = $e->signal();
286              
287             The name signal that caused the subprocess to terminate
288              
289             =item $e->signal_no()
290              
291             my $signal_number = $e->signal_no();
292              
293             The numerical signal that caused the subprocess to terminate
294              
295             =item $e->stdout()
296              
297             Standard output captured before termination
298              
299             =item $e->stdoerr()
300              
301             Returns the Standard error output captured before termination of the subprocess
302              
303              
304             =back
305              
306             =head2 Capture::SystemIO::Signal
307              
308             =over
309              
310             =item $e->signal()
311              
312             The name of the signal that caused the subprocess to terminate, if known.
313              
314             =item $e->signal_no()
315              
316             my $signal_number = $e->signal_no();
317              
318             The numerical signal that caused the subprocess to terminate
319              
320              
321             =item $e->stdout()
322              
323             Standard output captured before termination
324              
325             =item $e->stdoerr()
326              
327             Returns the Standard error output captured before termination of the subprocess
328              
329              
330             =back
331              
332              
333              
334              
335              
336              
337             =head1 TODO
338              
339             =head2 planned
340              
341             =over
342              
343             =item * move pre-condition checks from test suite to Makefile.PL
344              
345             =item * write more tests
346              
347             =item * test on more systems/platforms
348              
349             =back
350              
351             =head2 possible
352              
353             =over
354              
355             =item Add OO interface for returned output and setting options.
356              
357             =back
358              
359              
360              
361              
362             =head1 SEE ALSO
363              
364             L,
365             L,
366             L,
367             L,
368             L,
369             L
370              
371              
372              
373             =head1 AUTHOR
374              
375             Rudolf Lippan
376              
377              
378              
379              
380             =head1 LICENSE
381              
382             You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file.
383              
384              
385              
386             =head1 COPYRIGHT
387              
388             Copyright (c) 2008 - 2010, Remote Linux, Inc. All rights reserved.
389              
390             Portions Copyright (c) 2009-2010, Public Karma, Inc.
391              
392             Portions lifted from IO::CaptureOutput; copyright belongs to the respective authors.
393              
394             =cut
395              
396              
397              
398              
399             return q{
400             Minnie and Winnie
401             Slept in a shell.
402             Sleep, little ladies!
403             And they slept well.
404              
405             Pink was the shell within,
406             Silver without;
407             Sounds of the great sea
408             Wander'd about.
409              
410             Sleep, little ladies!
411             Wake not soon!
412             Echo on echo
413             Dies to the moon.
414              
415             Two bright stars
416             Peep'd into the shell.
417             "What are you dreaming of?
418             Who can tell?"
419              
420             Started a green linnet
421             Out of the croft;
422             Wake, little ladies,
423             The sun is aloft!
424             };
425              
426