| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package IPC::Capture; | 
| 2 | 1 |  |  | 1 |  | 1155 | use base qw( Class::Base ); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 1034 |  | 
| 3 |  |  |  |  |  |  |  | 
| 4 |  |  |  |  |  |  | =head1 NAME | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | IPC::Capture - portably run external apps and capture the output | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | use IPC::Capture; | 
| 11 |  |  |  |  |  |  | my $ich = IPC::Capture->new(); | 
| 12 |  |  |  |  |  |  | $ich->set_filter('stdout_only'); | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | my $output = $ich->run( $this_cmd ); | 
| 15 |  |  |  |  |  |  | if ( $output ) ) { | 
| 16 |  |  |  |  |  |  | # work with $output... | 
| 17 |  |  |  |  |  |  | } | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | unless( $ich->can_run( $another_cmd ) { | 
| 20 |  |  |  |  |  |  | die "Will not be able to run the external command: $another_cmd\n"; | 
| 21 |  |  |  |  |  |  | } | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | $ich->set_filter('stderr_only'); | 
| 24 |  |  |  |  |  |  | my $errors = $ich->run( $another_cmd ); | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | # stdout and stderr together: | 
| 27 |  |  |  |  |  |  | $ich->set_filter('all_output'); | 
| 28 |  |  |  |  |  |  | my $all = $ich->run( $another_cmd ); | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | IPC::Capture is a module for running external applications | 
| 35 |  |  |  |  |  |  | in a portable fashion when you're primarily interested in capturing | 
| 36 |  |  |  |  |  |  | the returned output. | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | Essentially this is an attempt at creating a portable way of doing | 
| 39 |  |  |  |  |  |  | "backticks" with io-redirection.  In fact, if it looks like it will work, | 
| 40 |  |  |  |  |  |  | this module will internally just try to run the command via a sub-shell | 
| 41 |  |  |  |  |  |  | invoked by qx; otherwise, it will try some other approaches which may work | 
| 42 |  |  |  |  |  |  | (going through other modules such as L, L, and/or | 
| 43 |  |  |  |  |  |  | L). | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | The different ways of running external commands are called "ways" here | 
| 46 |  |  |  |  |  |  | (because words like "methods" already have too many other associations). | 
| 47 |  |  |  |  |  |  | At present, there are only two "ways" defined in this module: "qx" and | 
| 48 |  |  |  |  |  |  | "ipc_cmd".  We probe the system trying each of the known ways (in the | 
| 49 |  |  |  |  |  |  | order defined in the "ways" attribute), and use the first one that looks | 
| 50 |  |  |  |  |  |  | like it will work. | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | =head2 METHODS | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | =over | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | =cut | 
| 57 |  |  |  |  |  |  |  | 
| 58 | 1 |  |  | 1 |  | 1485 | use 5.008; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 39 |  | 
| 59 | 1 |  |  | 1 |  | 16 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 30 |  | 
| 60 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 39 |  | 
| 61 | 1 |  |  | 1 |  | 6 | use Carp; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 79 |  | 
| 62 | 1 |  |  | 1 |  | 7 | use Data::Dumper; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 60 |  | 
| 63 | 1 |  |  | 1 |  | 963 | use Hash::Util qw( lock_keys unlock_keys ); | 
|  | 1 |  |  |  |  | 5202 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 64 | 1 |  |  | 1 |  | 161 | use File::Spec qw( devnull ); | 
|  | 1 |  |  |  |  | 5 |  | 
|  | 1 |  |  |  |  | 32 |  | 
| 65 | 1 |  |  | 1 |  | 1399 | use File::Temp qw( tempfile tempdir ); | 
|  | 1 |  |  |  |  | 27838 |  | 
|  | 1 |  |  |  |  | 86 |  | 
| 66 |  |  |  |  |  |  | # Note: IPC::Cmd is used below dynamically (if qx fails) | 
| 67 | 1 |  |  | 1 |  | 1225 | use List::MoreUtils qw( zip ); | 
|  | 1 |  |  |  |  | 2479 |  | 
|  | 1 |  |  |  |  | 1699 |  | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | our $VERSION = '0.06'; | 
| 70 |  |  |  |  |  |  | my $DEBUG = 0;  # TODO change to 0 before shipping | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | # needed for accessor generation | 
| 73 |  |  |  |  |  |  | our $AUTOLOAD; | 
| 74 |  |  |  |  |  |  | my %ATTRIBUTES = (); | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | =item new | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | Creates a new IPC::Capture object. | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | Takes a hashref as an argument, with named fields identical | 
| 81 |  |  |  |  |  |  | to the names of the object attributes (which also may be set | 
| 82 |  |  |  |  |  |  | later via the accessor methods). These attributes are: | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | =over | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | =item filter | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | The "filter" is a code that specifies what command output | 
| 89 |  |  |  |  |  |  | streams we're interested in capturing.  Allowed values: | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | =over | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | =item stdout_only | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | Discards stderr and returns only stdout.  Like the Bourne shell | 
| 96 |  |  |  |  |  |  | redirect: '2>/dev/null' | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | =item stderr_only | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | Discards stdout and returns only stderr. Like the Bourne shell | 
| 101 |  |  |  |  |  |  | redirect: '2>&1 1>/dev/null' | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | =item all_output | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | Intermixes lines of stdout and stderr in chronological order. | 
| 106 |  |  |  |  |  |  | Like the Bourne shell redirect: '2>&1' | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | =item all_separated | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | The return will be an array reference with two elements: stdout and stderr. | 
| 111 |  |  |  |  |  |  | (But under some circumstances, it may not be possible to seperate | 
| 112 |  |  |  |  |  |  | the two, and all output will be returned intermixed, as the first | 
| 113 |  |  |  |  |  |  | item, and the second will be undef.) | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | =back | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | =item autochomp | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | Set to a true value, causes all returned values to be | 
| 120 |  |  |  |  |  |  | automatically chomped.  Defaults to false. | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | =item known_ways | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | List of known ways of invoking external commands, in the default | 
| 125 |  |  |  |  |  |  | order in which they'll be tried (as of this writing: ['ex', 'ipc_cmd']. | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | =item ways | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | List of ways of invoking external commands, in the order the user | 
| 130 |  |  |  |  |  |  | would like to try them.  Defaults to L. | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | =item way | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | The chosen "way" that will be used for invoking external commands. | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | =item stdout_probe_messages | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | List of messages which are sent to STDOUT by the probe sub-script. | 
| 139 |  |  |  |  |  |  | An array reference. | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | =item stderr_probe_messages | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | List of messages which are sent to STDERR by the probe sub-script. | 
| 144 |  |  |  |  |  |  | An array reference. | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | =back | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | Takes an optional hashref as an argument, with named fields | 
| 149 |  |  |  |  |  |  | identical to the names of the object attributes. | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | =cut | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | # Note: "new" is inherited from Class::Base and | 
| 154 |  |  |  |  |  |  | # calls the following "init" routine automatically. | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | =item init | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | Method that initializes object attributes and then locks them | 
| 159 |  |  |  |  |  |  | down to prevent accidental creation of new ones. | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | Any class that inherits from this one should have an B of | 
| 162 |  |  |  |  |  |  | it's own that calls this B.  Otherwise, it's an internally | 
| 163 |  |  |  |  |  |  | used routine that is not of much interest to client coders. | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | =cut | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | sub init { | 
| 168 | 3 |  |  | 3 | 1 | 5889 | my $self = shift; | 
| 169 | 3 |  |  |  |  | 8 | my $args = shift; | 
| 170 | 3 |  |  |  |  | 12 | unlock_keys( %{ $self } ); | 
|  | 3 |  |  |  |  | 32 |  | 
| 171 |  |  |  |  |  |  |  | 
| 172 | 3 |  |  |  |  | 68 | my @attributes = qw( | 
| 173 |  |  |  |  |  |  | filter | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | autochomp | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | known_ways | 
| 178 |  |  |  |  |  |  | ways | 
| 179 |  |  |  |  |  |  | way | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | known_filters | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | stdout_probe_messages | 
| 184 |  |  |  |  |  |  | stderr_probe_messages | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | success | 
| 187 |  |  |  |  |  |  | ); | 
| 188 |  |  |  |  |  |  |  | 
| 189 | 3 |  |  |  |  | 9 | foreach my $field (@attributes) { | 
| 190 | 27 |  |  |  |  | 56 | $ATTRIBUTES{ $field } = 1; | 
| 191 | 27 |  |  |  |  | 61 | $self->{ $field } = $args->{ $field }; | 
| 192 |  |  |  |  |  |  | } | 
| 193 |  |  |  |  |  |  |  | 
| 194 | 3 |  |  |  |  | 8 | $self->{ success } = 1; ### TODO stub. | 
| 195 |  |  |  |  |  |  |  | 
| 196 | 3 |  |  |  |  | 12 | $self->{ known_ways } = ['qx', 'ipc_cmd']; | 
| 197 | 3 |  | 33 |  |  | 27 | $self->{ ways } ||= $self->{ known_ways }; | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | $self->{ known_filters } = | 
| 200 |  |  |  |  |  |  | [ | 
| 201 | 3 |  |  |  |  | 12 | 'stdout_only', | 
| 202 |  |  |  |  |  |  | 'stderr_only', | 
| 203 |  |  |  |  |  |  | 'all_output', | 
| 204 |  |  |  |  |  |  | 'all_separated', | 
| 205 |  |  |  |  |  |  | ]; | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | $self->{ stdout_probe_messages } ||= | 
| 208 | 3 |  | 50 |  |  | 31 | [ 'abc', 'ijk', 'xyz' ]; | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | $self->{ stderr_probe_messages } ||= | 
| 211 | 3 |  | 50 |  |  | 26 | [ '123', '567', '890' ]; | 
| 212 |  |  |  |  |  |  |  | 
| 213 | 3 |  |  |  |  | 11 | my $way = $self->probe_system; | 
| 214 | 3 | 50 |  |  |  | 10 | unless( $way ) { | 
| 215 | 0 |  |  |  |  | 0 | $self->debug("IPC::Capture probe_system method has not found a way."); | 
| 216 |  |  |  |  |  |  | } | 
| 217 | 3 |  | 50 |  |  | 23 | $self->{ way } = $way || 'qx';  # TODO should there be a fallback default here? | 
| 218 |  |  |  |  |  |  |  | 
| 219 | 3 | 50 |  |  |  | 12 | $self->debugging( 1 ) if $DEBUG; | 
| 220 | 3 | 50 |  |  |  | 105 | $DEBUG = 1 if $self->debugging(); | 
| 221 |  |  |  |  |  |  |  | 
| 222 | 3 |  |  |  |  | 56 | lock_keys( %{ $self } ); | 
|  | 3 |  |  |  |  | 41 |  | 
| 223 | 3 |  |  |  |  | 142 | return $self; | 
| 224 |  |  |  |  |  |  | } | 
| 225 |  |  |  |  |  |  | # Note: logically, known_ways and known_filters | 
| 226 |  |  |  |  |  |  | # could be class data: but I don't think I care. | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | =item probe_system | 
| 229 |  |  |  |  |  |  |  | 
| 230 |  |  |  |  |  |  | Internally used during the init phase of object creation. | 
| 231 |  |  |  |  |  |  | Chooses a good "way" of running commands external to perl. | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | =cut | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | sub probe_system { | 
| 236 | 3 |  |  | 3 | 1 | 6 | my $self = shift; | 
| 237 | 3 |  |  |  |  | 17 | my $ways = $self->ways; | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | ## Here we use File::Temp to write out a small perl script that sends | 
| 240 |  |  |  |  |  |  | ## some known output to stdout and (optionally) to stderr | 
| 241 | 3 |  |  |  |  | 237 | my $code = $self->define_yammer_script(); | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | # creating a temporary perl script file | 
| 244 |  |  |  |  |  |  | # Note: we explicitly use tmpdir, or else it uses curdir which may not be writable(!) | 
| 245 | 3 |  |  |  |  | 201 | my $tmpdir = File::Spec->tmpdir(); | 
| 246 | 3 | 50 |  |  |  | 15 | $File::Temp::KEEP_ALL = 1 if $DEBUG;  # overrides "UNLINK" & leaves tempfile | 
| 247 | 3 |  |  |  |  | 37 | my ($fh1, $scriptname) = tempfile('yap_XXXX', | 
| 248 |  |  |  |  |  |  | SUFFIX => '.pl', | 
| 249 |  |  |  |  |  |  | DIR    => $tmpdir, | 
| 250 |  |  |  |  |  |  | UNLINK => 1     ); | 
| 251 |  |  |  |  |  |  |  | 
| 252 | 3 |  |  |  |  | 2161 | $self->debug( "scriptname: $scriptname\n" ); | 
| 253 | 3 |  |  |  |  | 29 | print {$fh1} $code; | 
|  | 3 |  |  |  |  | 50 |  | 
| 254 | 3 |  |  |  |  | 231 | close( $fh1 ); | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | # trying running the script a few different ways | 
| 257 | 3 |  |  |  |  | 17 | my $chosen_way; | 
| 258 | 3 |  |  |  |  | 4 | foreach my $way (@{ $ways } ) { | 
|  | 3 |  |  |  |  | 12 |  | 
| 259 | 3 |  |  |  |  | 9 | my $method = "probe_system_$way"; | 
| 260 | 3 |  |  |  |  | 15 | my $retval = $self->$method( $scriptname ); | 
| 261 | 3 | 50 |  |  |  | 14 | if ( defined( $retval ) ) { | 
| 262 | 3 |  |  |  |  | 19 | $chosen_way = $way; | 
| 263 | 3 |  |  |  |  | 21 | last; | 
| 264 |  |  |  |  |  |  | } | 
| 265 |  |  |  |  |  |  | } | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | # cleanup | 
| 268 | 3 |  |  |  |  | 477 | unlink( $scriptname ); | 
| 269 |  |  |  |  |  |  |  | 
| 270 | 3 |  |  |  |  | 32 | return $chosen_way; | 
| 271 |  |  |  |  |  |  | } | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | =item define_yammer_script | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | This is an internally used routine, broken out as a method for | 
| 277 |  |  |  |  |  |  | ease of testing. | 
| 278 |  |  |  |  |  |  |  | 
| 279 |  |  |  |  |  |  | This generates some code for the 'yammer_script' which is used | 
| 280 |  |  |  |  |  |  | used by L to check which ways work for running | 
| 281 |  |  |  |  |  |  | external commands.  The 'yammer_script' sends three lines of | 
| 282 |  |  |  |  |  |  | output to stdout, and if provided with command-line arguments, it | 
| 283 |  |  |  |  |  |  | will echo up to three of them to stderr.  The stderr output is | 
| 284 |  |  |  |  |  |  | interleaved with the output sent to stdout, starting with stdout | 
| 285 |  |  |  |  |  |  | (so the pattern is: OeOeOe). | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | This method uses the object data L to get | 
| 288 |  |  |  |  |  |  | an aref of messages to send to stdout; but this can be overridden | 
| 289 |  |  |  |  |  |  | by passing it an aref of alternate messages. | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  | So, just to make it clear: the STDOUT strings are defined when | 
| 292 |  |  |  |  |  |  | this method is called, but the STDERR strings are defined only | 
| 293 |  |  |  |  |  |  | when the yammer script it generates is run. | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | =cut | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  | sub define_yammer_script { | 
| 298 | 3 |  |  | 3 | 1 | 7 | my $self = shift; | 
| 299 | 3 |  | 33 |  |  | 51 | my $messages = shift || $self->stdout_probe_messages; | 
| 300 | 3 |  |  |  |  | 4 | my ($x, $y, $z) = @{ $messages }; | 
|  | 3 |  |  |  |  | 9 |  | 
| 301 | 3 |  |  |  |  | 20 | my $code = | 
| 302 |  |  |  |  |  |  | '$|=1;' . "\n" . | 
| 303 |  |  |  |  |  |  | 'print "' . $x . '\n"; ' . "\n" . | 
| 304 |  |  |  |  |  |  | 'print STDERR "$ARGV[0]\n" if defined($ARGV[0]); ' . "\n" . | 
| 305 |  |  |  |  |  |  | 'print "' . $y .  '\n"; ' . "\n" . | 
| 306 |  |  |  |  |  |  | 'print STDERR  "$ARGV[1]\n" if defined($ARGV[1]); ' . "\n" . | 
| 307 |  |  |  |  |  |  | 'print "' . $z . '\n"; ' . "\n" . | 
| 308 |  |  |  |  |  |  | 'print STDERR  "$ARGV[2]\n" if defined($ARGV[2]); ' . "\n" ; | 
| 309 | 3 |  |  |  |  | 8 | return $code; | 
| 310 |  |  |  |  |  |  | } | 
| 311 |  |  |  |  |  |  |  | 
| 312 |  |  |  |  |  |  |  | 
| 313 |  |  |  |  |  |  | =item probe_system_qx | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  | Method used internally by the internal method "probe_system". | 
| 316 |  |  |  |  |  |  | Takes one argument: the script name, which it will try to run | 
| 317 |  |  |  |  |  |  | via qx. | 
| 318 |  |  |  |  |  |  |  | 
| 319 |  |  |  |  |  |  | =cut | 
| 320 |  |  |  |  |  |  |  | 
| 321 |  |  |  |  |  |  | sub probe_system_qx { | 
| 322 | 3 |  |  | 3 | 1 | 5 | my $self       = shift; | 
| 323 | 3 |  |  |  |  | 6 | my $scriptname = shift; | 
| 324 | 3 |  | 33 |  |  | 29 | my $stderr_probe_messages = shift || $self->stderr_probe_messages; | 
| 325 |  |  |  |  |  |  |  | 
| 326 | 3 |  |  |  |  | 6 | my $perl = $^X; # have perl tell us where it is (might not be in path) | 
| 327 | 3 |  |  |  |  | 5 | my $stderr_args = join ' ', @{ $stderr_probe_messages }; | 
|  | 3 |  |  |  |  | 10 |  | 
| 328 | 3 |  |  |  |  | 8 | my $cmd = "$perl $scriptname $stderr_args"; | 
| 329 |  |  |  |  |  |  |  | 
| 330 | 3 |  |  |  |  | 9 | my $stdout_probe_messages = $self->stdout_probe_messages; | 
| 331 |  |  |  |  |  |  |  | 
| 332 | 3 |  |  |  |  | 3 | my ($capture_stdout, $capture_stderr, $capture_all); | 
| 333 | 3 |  |  |  |  | 11 | $capture_stdout = $self->run_qx_stdout_only( $cmd ); | 
| 334 | 3 |  |  |  |  | 208 | chomp($capture_stdout); | 
| 335 | 3 |  |  |  |  | 37 | $capture_stderr = $self->run_qx_stderr_only( $cmd ); | 
| 336 | 3 |  |  |  |  | 17 | chomp($capture_stderr); | 
| 337 | 3 |  |  |  |  | 20 | $capture_all    = $self->run_qx_all_output(  $cmd ); | 
| 338 | 3 |  |  |  |  | 13 | chomp($capture_all); | 
| 339 |  |  |  |  |  |  |  | 
| 340 | 3 |  |  |  |  | 8 | my $expected_stdout = join "\n", @{ $stdout_probe_messages }; | 
|  | 3 |  |  |  |  | 26 |  | 
| 341 | 3 |  |  |  |  | 12 | my $expected_stderr = join "\n", @{ $stderr_probe_messages }; | 
|  | 3 |  |  |  |  | 15 |  | 
| 342 | 3 |  |  |  |  | 10 | my $expected_all =    join "\n", zip @{ $stdout_probe_messages }, @{ $stderr_probe_messages }; | 
|  | 3 |  |  |  |  | 8 |  | 
|  | 3 |  |  |  |  | 61 |  | 
| 343 |  |  |  |  |  |  |  | 
| 344 | 3 | 50 | 33 |  |  | 124 | if ( ( $capture_stdout eq $expected_stdout ) && | 
|  |  |  | 33 |  |  |  |  | 
| 345 |  |  |  |  |  |  | ( $capture_stderr eq $expected_stderr ) && | 
| 346 |  |  |  |  |  |  | ( $capture_all    eq $expected_all ) ) { | 
| 347 | 3 |  |  |  |  | 41 | return 1; | 
| 348 |  |  |  |  |  |  | } else { | 
| 349 | 0 |  |  |  |  | 0 | return; | 
| 350 |  |  |  |  |  |  | } | 
| 351 |  |  |  |  |  |  | } | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  |  | 
| 354 |  |  |  |  |  |  | =item probe_system_ipc_cmd | 
| 355 |  |  |  |  |  |  |  | 
| 356 |  |  |  |  |  |  | Method used internally by the internal method "probe_system". | 
| 357 |  |  |  |  |  |  | Takes one argument: the script name, which it will try to run | 
| 358 |  |  |  |  |  |  | via IPC::Cmd. | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | =cut | 
| 361 |  |  |  |  |  |  |  | 
| 362 |  |  |  |  |  |  | sub probe_system_ipc_cmd { | 
| 363 | 0 |  |  | 0 | 1 | 0 | my $self       = shift; | 
| 364 | 0 |  |  |  |  | 0 | my $scriptname = shift; | 
| 365 | 0 |  | 0 |  |  | 0 | my $stderr_probe_messages = shift || [ '123', '567', '890' ]; | 
| 366 |  |  |  |  |  |  |  | 
| 367 | 0 |  |  |  |  | 0 | my $perl = $^X; # have perl tell us where it is (might not be in path) | 
| 368 | 0 |  |  |  |  | 0 | my $stderr_args = join ' ', @{ $stderr_probe_messages }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 369 | 0 |  |  |  |  | 0 | my $cmd = "$perl $scriptname $stderr_args"; | 
| 370 |  |  |  |  |  |  |  | 
| 371 | 0 |  |  |  |  | 0 | my $stdout_probe_messages = $self->stdout_probe_messages; | 
| 372 |  |  |  |  |  |  |  | 
| 373 | 0 |  |  |  |  | 0 | my ($capture_stdout, $capture_stderr, $capture_all); | 
| 374 | 0 |  |  |  |  | 0 | $capture_stdout = $self->run_ipc_cmd_stdout_only( $cmd ); | 
| 375 | 0 |  |  |  |  | 0 | chomp($capture_stdout); | 
| 376 | 0 |  |  |  |  | 0 | $capture_stderr = $self->run_ipc_cmd_stderr_only( $cmd ); | 
| 377 | 0 |  |  |  |  | 0 | chomp($capture_stderr); | 
| 378 | 0 |  |  |  |  | 0 | $capture_all    = $self->run_ipc_cmd_all_output(  $cmd ); | 
| 379 | 0 |  |  |  |  | 0 | chomp($capture_all); | 
| 380 |  |  |  |  |  |  |  | 
| 381 | 0 |  |  |  |  | 0 | my $expected_stdout = join "\n", @{ $stdout_probe_messages }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 382 | 0 |  |  |  |  | 0 | my $expected_stderr = join "\n", @{ $stderr_probe_messages }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 383 | 0 |  |  |  |  | 0 | my $expected_all =    join "\n", zip @{ $stdout_probe_messages }, @{ $stderr_probe_messages }; | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 384 |  |  |  |  |  |  |  | 
| 385 | 0 | 0 | 0 |  |  | 0 | if ( ( $capture_stdout eq $expected_stdout ) && | 
|  |  |  | 0 |  |  |  |  | 
| 386 |  |  |  |  |  |  | ( $capture_stderr eq $expected_stderr ) && | 
| 387 |  |  |  |  |  |  | ( $capture_all    eq $expected_all ) ) { | 
| 388 | 0 |  |  |  |  | 0 | return 1; | 
| 389 |  |  |  |  |  |  | } else { | 
| 390 | 0 |  |  |  |  | 0 | return; | 
| 391 |  |  |  |  |  |  | } | 
| 392 |  |  |  |  |  |  | } | 
| 393 |  |  |  |  |  |  |  | 
| 394 |  |  |  |  |  |  | =item can_run | 
| 395 |  |  |  |  |  |  |  | 
| 396 |  |  |  |  |  |  | Given the name of an external command, will check to see if we | 
| 397 |  |  |  |  |  |  | can run it. | 
| 398 |  |  |  |  |  |  |  | 
| 399 |  |  |  |  |  |  | Note: just because the program has the name you're looking for, | 
| 400 |  |  |  |  |  |  | there's no guarantee that it's the right program. | 
| 401 |  |  |  |  |  |  |  | 
| 402 |  |  |  |  |  |  | =cut | 
| 403 |  |  |  |  |  |  |  | 
| 404 |  |  |  |  |  |  | sub can_run { | 
| 405 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 406 | 0 |  |  |  |  | 0 | my $cmd  = shift; | 
| 407 | 0 |  |  |  |  | 0 | my $way  = $self->way; | 
| 408 | 0 |  |  |  |  | 0 | my $method = "can_run_$way"; | 
| 409 | 0 |  |  |  |  | 0 | my $status = $self->$method( $cmd ); | 
| 410 | 0 |  |  |  |  | 0 | return $status; | 
| 411 |  |  |  |  |  |  | } | 
| 412 |  |  |  |  |  |  |  | 
| 413 |  |  |  |  |  |  | =item can_run_qx | 
| 414 |  |  |  |  |  |  |  | 
| 415 |  |  |  |  |  |  | This is a method used internally by L, it tries to | 
| 416 |  |  |  |  |  |  | determine if the given program can be run via the shell | 
| 417 |  |  |  |  |  |  | (i.e. the "qx" way), and returns the full path to the program | 
| 418 |  |  |  |  |  |  | if it's found, otherwise, undef. | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | =cut | 
| 421 |  |  |  |  |  |  |  | 
| 422 |  |  |  |  |  |  | # Trying a few different ways, only one of which need work... | 
| 423 |  |  |  |  |  |  | sub can_run_qx { | 
| 424 | 0 |  |  | 0 | 1 | 0 | my $self     = shift; | 
| 425 | 0 |  |  |  |  | 0 | my $program  = shift; | 
| 426 | 0 |  |  |  |  | 0 | my $found; | 
| 427 |  |  |  |  |  |  |  | 
| 428 | 0 | 0 |  |  |  | 0 | if( $found = $self->can_run_qx_which( $program ) ) { | 
|  |  | 0 |  |  |  |  |  | 
| 429 | 0 |  |  |  |  | 0 | return $found; | 
| 430 |  |  |  |  |  |  | } elsif( $found = $self->can_run_qx_path_glob( $program ) ) { | 
| 431 | 0 |  |  |  |  | 0 | return $found; | 
| 432 |  |  |  |  |  |  | } | 
| 433 |  |  |  |  |  |  |  | 
| 434 | 0 |  |  |  |  | 0 | return; # undef, nothing found | 
| 435 |  |  |  |  |  |  | } | 
| 436 |  |  |  |  |  |  |  | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | =item can_run_qx_which | 
| 439 |  |  |  |  |  |  |  | 
| 440 |  |  |  |  |  |  | This is a method used internally by L. | 
| 441 |  |  |  |  |  |  | It uses the old old unix utility "which" to look for | 
| 442 |  |  |  |  |  |  | the given program. | 
| 443 |  |  |  |  |  |  |  | 
| 444 |  |  |  |  |  |  | =cut | 
| 445 |  |  |  |  |  |  |  | 
| 446 |  |  |  |  |  |  | sub can_run_qx_which { | 
| 447 | 0 |  |  | 0 | 1 | 0 | my $self    = shift; | 
| 448 | 0 |  |  |  |  | 0 | my $program = shift; | 
| 449 | 0 |  |  |  |  | 0 | my $subname = ( caller(0) )[3]; | 
| 450 |  |  |  |  |  |  |  | 
| 451 | 0 |  |  |  |  | 0 | my $which = 'which'; | 
| 452 | 0 |  |  |  |  | 0 | my $found; | 
| 453 | 0 |  |  |  |  | 0 | eval { | 
| 454 | 1 |  |  | 1 |  | 8 | no warnings; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 2454 |  | 
| 455 | 0 |  |  |  |  | 0 | $found = qx{ $which $program }; | 
| 456 | 0 |  |  |  |  | 0 | chomp( $found ); | 
| 457 |  |  |  |  |  |  | }; | 
| 458 | 0 | 0 | 0 |  |  | 0 | if ($@) { | 
|  |  | 0 |  |  |  |  |  | 
| 459 | 0 |  |  |  |  | 0 | $self->debug("$subname: Running '$which' errored out: $@\n"); | 
| 460 | 0 |  |  |  |  | 0 | return; | 
| 461 |  |  |  |  |  |  | } elsif ( defined( $found ) && ($found =~ m{ \b $program $ }xms) ) { | 
| 462 | 0 |  |  |  |  | 0 | return $found; | 
| 463 |  |  |  |  |  |  | } else { | 
| 464 | 0 |  |  |  |  | 0 | return; | 
| 465 |  |  |  |  |  |  | } | 
| 466 |  |  |  |  |  |  | } | 
| 467 |  |  |  |  |  |  |  | 
| 468 |  |  |  |  |  |  |  | 
| 469 |  |  |  |  |  |  | =item can_run_qx_path_glob | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | This is a method used internally by L. | 
| 472 |  |  |  |  |  |  | It looks for the given program by checking looking for | 
| 473 |  |  |  |  |  |  | an executible file of that name somewhere in the path. | 
| 474 |  |  |  |  |  |  |  | 
| 475 |  |  |  |  |  |  | =cut | 
| 476 |  |  |  |  |  |  |  | 
| 477 |  |  |  |  |  |  | sub can_run_qx_path_glob { | 
| 478 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 479 | 0 |  |  |  |  | 0 | my $program = shift; | 
| 480 | 0 |  |  |  |  | 0 | my $found; | 
| 481 |  |  |  |  |  |  | # Just look in each directory in the PATH for an | 
| 482 |  |  |  |  |  |  | # executable file with the right name, | 
| 483 | 0 |  |  |  |  | 0 | my @PATH = File::Spec->path(); | 
| 484 | 0 |  |  |  |  | 0 | foreach my $loc (@PATH) { | 
| 485 | 0 |  |  |  |  | 0 | chdir( $loc ); | 
| 486 |  |  |  |  |  |  | # This is better for debugging (for obscure reasons): | 
| 487 |  |  |  |  |  |  | #    my @names = glob '*'; | 
| 488 |  |  |  |  |  |  | #    foreach my $name (@names) { | 
| 489 |  |  |  |  |  |  | # But this is more memory efficient... | 
| 490 | 0 |  |  |  |  | 0 | while ( my $name = glob '*' ) { | 
| 491 | 0 | 0 | 0 |  |  | 0 | if (( $name eq $program ) && ( -f "$loc/$name" ) && ( -x "$loc/$name" )) { | 
|  |  |  | 0 |  |  |  |  | 
| 492 | 0 |  |  |  |  | 0 | $found = File::Spec->catfile($loc, $name); | 
| 493 | 0 |  |  |  |  | 0 | return $found; | 
| 494 |  |  |  |  |  |  | } | 
| 495 |  |  |  |  |  |  | } | 
| 496 |  |  |  |  |  |  | } | 
| 497 | 0 |  |  |  |  | 0 | return; | 
| 498 |  |  |  |  |  |  | } | 
| 499 |  |  |  |  |  |  |  | 
| 500 |  |  |  |  |  |  | =item can_run_ipc_cmd | 
| 501 |  |  |  |  |  |  |  | 
| 502 |  |  |  |  |  |  | Given the name of a program, checks to see if it can run it. | 
| 503 |  |  |  |  |  |  | Returns the full path to the binary if it is found. | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | Note: this is a simple wrapper around IPC::Cmd::can_run. | 
| 506 |  |  |  |  |  |  |  | 
| 507 |  |  |  |  |  |  | =cut | 
| 508 |  |  |  |  |  |  |  | 
| 509 |  |  |  |  |  |  | sub can_run_ipc_cmd { | 
| 510 | 0 |  |  | 0 | 1 | 0 | my $self    = shift; | 
| 511 | 0 |  |  |  |  | 0 | my $program = shift; | 
| 512 | 0 |  |  |  |  | 0 | require IPC::Cmd; | 
| 513 | 0 |  |  |  |  | 0 | my $path = IPC::Cmd::can_run( $program ); | 
| 514 | 0 |  |  |  |  | 0 | return $path; | 
| 515 |  |  |  |  |  |  | } | 
| 516 |  |  |  |  |  |  |  | 
| 517 |  |  |  |  |  |  | =item run | 
| 518 |  |  |  |  |  |  |  | 
| 519 |  |  |  |  |  |  | Takes one argument: an external command string. | 
| 520 |  |  |  |  |  |  |  | 
| 521 |  |  |  |  |  |  | Returns the output from the external command (as controlled by | 
| 522 |  |  |  |  |  |  | the L setting in the object).  The output | 
| 523 |  |  |  |  |  |  | will almost always be in the form of a multi-line string, | 
| 524 |  |  |  |  |  |  | except in one case: | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | If filter is set to "all_separated", then this will return a | 
| 527 |  |  |  |  |  |  | reference to an array of two elements, the first containing | 
| 528 |  |  |  |  |  |  | stdout, the second stderr. | 
| 529 |  |  |  |  |  |  |  | 
| 530 |  |  |  |  |  |  | =cut | 
| 531 |  |  |  |  |  |  |  | 
| 532 |  |  |  |  |  |  | sub run { | 
| 533 | 8 |  |  | 8 | 1 | 70 | my $self = shift; | 
| 534 | 8 |  |  |  |  | 21 | my $cmd  = shift; | 
| 535 | 8 |  |  |  |  | 21 | my $output; | 
| 536 | 8 |  |  |  |  | 58 | my $way = $self->way; | 
| 537 | 8 |  |  |  |  | 37 | my $od  = $self->filter; | 
| 538 | 8 |  |  |  |  | 30 | my $method = 'run_' . $way. '_' . $od ;  # run__ | 
| 539 | 8 |  |  |  |  | 58 | $output = $self->$method( $cmd ); | 
| 540 | 8 |  |  |  |  | 386 | return $output; | 
| 541 |  |  |  |  |  |  | } | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | =back | 
| 544 |  |  |  |  |  |  |  | 
| 545 |  |  |  |  |  |  | =head2 "run__" | 
| 546 |  |  |  |  |  |  |  | 
| 547 |  |  |  |  |  |  | These methods are for internal use by the "run" method. | 
| 548 |  |  |  |  |  |  |  | 
| 549 |  |  |  |  |  |  | =head2 "run_qx_*" methods | 
| 550 |  |  |  |  |  |  |  | 
| 551 |  |  |  |  |  |  | These are methods that take the given command and simply try to | 
| 552 |  |  |  |  |  |  | run them via whatever shell is available to the qx{} operator. | 
| 553 |  |  |  |  |  |  |  | 
| 554 |  |  |  |  |  |  | The L setting is converted to equivalent | 
| 555 |  |  |  |  |  |  | Bourne shell redirect. | 
| 556 |  |  |  |  |  |  |  | 
| 557 |  |  |  |  |  |  | =over | 
| 558 |  |  |  |  |  |  |  | 
| 559 |  |  |  |  |  |  | =item run_qx_all_output | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | =cut | 
| 562 |  |  |  |  |  |  |  | 
| 563 |  |  |  |  |  |  | sub run_qx_all_output { | 
| 564 | 5 |  |  | 5 | 1 | 9 | my $self = shift; | 
| 565 | 5 |  |  |  |  | 16 | my $cmd  = shift; | 
| 566 | 5 |  |  |  |  | 16 | my $output; | 
| 567 | 5 |  |  |  |  | 30 | my $sod = '2>&1'; | 
| 568 | 5 |  |  |  |  | 158836 | $output = qx{$cmd $sod}; | 
| 569 | 5 | 50 |  |  |  | 239 | chomp( $output ) if $self->autochomp; | 
| 570 | 5 |  |  |  |  | 80 | return $output; | 
| 571 |  |  |  |  |  |  | } | 
| 572 |  |  |  |  |  |  |  | 
| 573 |  |  |  |  |  |  | =item run_qx_stdout_only | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | =cut | 
| 576 |  |  |  |  |  |  |  | 
| 577 |  |  |  |  |  |  | sub run_qx_stdout_only { | 
| 578 | 5 |  |  | 5 | 1 | 9 | my $self = shift; | 
| 579 | 5 |  |  |  |  | 7 | my $cmd  = shift; | 
| 580 | 5 |  |  |  |  | 5 | my $output; | 
| 581 | 5 |  |  |  |  | 72 | my $devnull = File::Spec->devnull; | 
| 582 | 5 |  |  |  |  | 13 | my $sod = "2>$devnull"; | 
| 583 | 5 |  |  |  |  | 184674 | $output = qx{$cmd $sod}; | 
| 584 | 5 | 50 |  |  |  | 282 | chomp( $output ) if $self->autochomp; | 
| 585 | 5 |  |  |  |  | 214 | return $output; | 
| 586 |  |  |  |  |  |  | } | 
| 587 |  |  |  |  |  |  |  | 
| 588 |  |  |  |  |  |  | =item run_qx_stderr_only | 
| 589 |  |  |  |  |  |  |  | 
| 590 |  |  |  |  |  |  | =cut | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | sub run_qx_stderr_only { | 
| 593 | 5 |  |  | 5 | 1 | 209 | my $self = shift; | 
| 594 | 5 |  |  |  |  | 14 | my $cmd  = shift; | 
| 595 | 5 |  |  |  |  | 9 | my $output; | 
| 596 | 5 |  |  |  |  | 97 | my $devnull = File::Spec->devnull; | 
| 597 | 5 |  |  |  |  | 23 | my $sod = "2>&1 1>$devnull"; | 
| 598 | 5 |  |  |  |  | 185716 | $output = qx{$cmd $sod}; | 
| 599 | 5 | 50 |  |  |  | 206 | chomp( $output ) if $self->autochomp; | 
| 600 | 5 |  |  |  |  | 78 | return $output; | 
| 601 |  |  |  |  |  |  | } | 
| 602 |  |  |  |  |  |  |  | 
| 603 |  |  |  |  |  |  | =item run_qx_all_separated_old | 
| 604 |  |  |  |  |  |  |  | 
| 605 |  |  |  |  |  |  | (An earlier attempt that seemed "more correct" | 
| 606 |  |  |  |  |  |  | to me, but doesn't work on MSwin32.) | 
| 607 |  |  |  |  |  |  |  | 
| 608 |  |  |  |  |  |  | =cut | 
| 609 |  |  |  |  |  |  |  | 
| 610 |  |  |  |  |  |  | # uses redirection to a temp file to get stderr isolated from stdout | 
| 611 |  |  |  |  |  |  | sub run_qx_all_separated_old { | 
| 612 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 613 | 0 |  |  |  |  | 0 | my $cmd  = shift; | 
| 614 | 0 |  |  |  |  | 0 | my ($output, $stdout, $stderr); | 
| 615 | 0 |  |  |  |  | 0 | my $tmpdir = File::Spec->tmpdir(); | 
| 616 |  |  |  |  |  |  |  | 
| 617 | 0 | 0 |  |  |  | 0 | $File::Temp::KEEP_ALL = 1 if $DEBUG; | 
| 618 |  |  |  |  |  |  |  | 
| 619 | 0 |  |  |  |  | 0 | my ($fh, $filename) = tempfile('buf_XXXX', | 
| 620 |  |  |  |  |  |  | SUFFIX => '.dat', | 
| 621 |  |  |  |  |  |  | DIR => $tmpdir, | 
| 622 |  |  |  |  |  |  | UNLINK => 1); | 
| 623 |  |  |  |  |  |  |  | 
| 624 |  |  |  |  |  |  |  | 
| 625 | 0 |  |  |  |  | 0 | my $sod = "2>$filename"; | 
| 626 | 0 |  |  |  |  | 0 | $stdout = qx{$cmd $sod}; | 
| 627 |  |  |  |  |  |  |  | 
| 628 | 0 |  |  |  |  | 0 | while( my $line = <$fh> ) { | 
| 629 | 0 |  |  |  |  | 0 | $stderr .= $line; | 
| 630 |  |  |  |  |  |  | } | 
| 631 |  |  |  |  |  |  |  | 
| 632 | 0 |  |  |  |  | 0 | $output = [ $stdout, $stderr ]; | 
| 633 | 0 | 0 |  |  |  | 0 | $self->chomp_aref( $output ) if $self->autochomp; | 
| 634 | 0 |  |  |  |  | 0 | return $output; | 
| 635 |  |  |  |  |  |  | } | 
| 636 |  |  |  |  |  |  |  | 
| 637 |  |  |  |  |  |  |  | 
| 638 |  |  |  |  |  |  | =item run_qx_all_separated | 
| 639 |  |  |  |  |  |  |  | 
| 640 |  |  |  |  |  |  |  | 
| 641 |  |  |  |  |  |  | =cut | 
| 642 |  |  |  |  |  |  |  | 
| 643 |  |  |  |  |  |  | # And alternate form of L to work | 
| 644 |  |  |  |  |  |  | # around an mswin32 issue. | 
| 645 |  |  |  |  |  |  |  | 
| 646 |  |  |  |  |  |  | sub run_qx_all_separated { | 
| 647 | 2 |  |  | 2 | 1 | 14 | my $self = shift; | 
| 648 | 2 |  |  |  |  | 10 | my $cmd  = shift; | 
| 649 | 2 |  |  |  |  | 8 | my ($output, $stdout, $stderr); | 
| 650 | 2 |  |  |  |  | 87 | my $tmpdir = File::Spec->tmpdir(); | 
| 651 |  |  |  |  |  |  |  | 
| 652 |  |  |  |  |  |  | # $File::Temp::KEEP_ALL = 1 if $DEBUG; | 
| 653 |  |  |  |  |  |  |  | 
| 654 | 2 |  |  |  |  | 41 | my ($fh, $filename) = tempfile('buf_XXXX', | 
| 655 |  |  |  |  |  |  | SUFFIX => '.dat', | 
| 656 |  |  |  |  |  |  | DIR => $tmpdir, | 
| 657 |  |  |  |  |  |  | UNLINK => 0); | 
| 658 |  |  |  |  |  |  |  | 
| 659 | 2 |  |  |  |  | 1351 | close($fh); | 
| 660 |  |  |  |  |  |  |  | 
| 661 | 2 |  |  |  |  | 9 | my $sod = "2>$filename"; | 
| 662 | 2 |  |  |  |  | 174651 | $stdout = qx{$cmd $sod}; | 
| 663 |  |  |  |  |  |  |  | 
| 664 | 2 | 50 |  |  |  | 180 | open $fh, '<', $filename or croak "Could not re-open $filename for read: $!"; | 
| 665 |  |  |  |  |  |  |  | 
| 666 | 2 |  |  |  |  | 62 | while( my $line = <$fh> ) { | 
| 667 | 12 |  |  |  |  | 47 | $stderr .= $line; | 
| 668 |  |  |  |  |  |  | } | 
| 669 | 2 |  |  |  |  | 23 | close($fh); | 
| 670 |  |  |  |  |  |  |  | 
| 671 | 2 | 50 |  |  |  | 293 | unlink( $filename ) unless $DEBUG; | 
| 672 |  |  |  |  |  |  |  | 
| 673 | 2 |  |  |  |  | 21 | $output = [ $stdout, $stderr ]; | 
| 674 | 2 | 50 |  |  |  | 37 | $self->chomp_aref( $output ) if $self->autochomp; | 
| 675 | 2 |  |  |  |  | 51 | return $output; | 
| 676 |  |  |  |  |  |  | } | 
| 677 |  |  |  |  |  |  |  | 
| 678 |  |  |  |  |  |  |  | 
| 679 |  |  |  |  |  |  |  | 
| 680 |  |  |  |  |  |  | =back | 
| 681 |  |  |  |  |  |  |  | 
| 682 |  |  |  |  |  |  | =head2 "run_ipc_cmd_*" methods | 
| 683 |  |  |  |  |  |  |  | 
| 684 |  |  |  |  |  |  | These are methods that take the given command and try to | 
| 685 |  |  |  |  |  |  | run them via the L module, (which in turn will try | 
| 686 |  |  |  |  |  |  | to use L or L). | 
| 687 |  |  |  |  |  |  |  | 
| 688 |  |  |  |  |  |  | The L setting determines what kind of | 
| 689 |  |  |  |  |  |  | IPC::Cmd call to use, and which of it's output channels will | 
| 690 |  |  |  |  |  |  | be returned. | 
| 691 |  |  |  |  |  |  |  | 
| 692 |  |  |  |  |  |  | =over | 
| 693 |  |  |  |  |  |  |  | 
| 694 |  |  |  |  |  |  | =item run_ipc_cmd_stdout_only | 
| 695 |  |  |  |  |  |  |  | 
| 696 |  |  |  |  |  |  | Used internally by L when the L is set | 
| 697 |  |  |  |  |  |  | to 'stdout_only' (and the L is 'ipc_cmd'). | 
| 698 |  |  |  |  |  |  |  | 
| 699 |  |  |  |  |  |  | =cut | 
| 700 |  |  |  |  |  |  |  | 
| 701 |  |  |  |  |  |  | sub run_ipc_cmd_stdout_only { | 
| 702 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 703 | 0 |  |  |  |  | 0 | my $cmd  = shift; | 
| 704 | 0 |  |  |  |  | 0 | my $output; | 
| 705 |  |  |  |  |  |  | my $all_buf; | 
| 706 | 0 |  |  |  |  | 0 | require IPC::Cmd; | 
| 707 | 0 |  |  |  |  | 0 | my( $success, $error_code, $all_sep_buf, $stdout_buf, $stderr_buf ) = | 
| 708 |  |  |  |  |  |  | IPC::Cmd::run( command => $cmd, verbose => 0, buffer=> \$all_buf ); | 
| 709 | 0 |  |  |  |  | 0 | $output = $stdout_buf->[0]; | 
| 710 |  |  |  |  |  |  |  | 
| 711 | 0 | 0 |  |  |  | 0 | if( not( $success ) ) { | 
| 712 | 0 |  |  |  |  | 0 | warn "IPC::Cmd run of $cmd failed."; | 
| 713 |  |  |  |  |  |  | } | 
| 714 | 0 | 0 |  |  |  | 0 | chomp( $output ) if $self->autochomp; | 
| 715 | 0 |  |  |  |  | 0 | return $output; | 
| 716 |  |  |  |  |  |  | } | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  |  | 
| 719 |  |  |  |  |  |  | =item run_ipc_cmd_stderr_only | 
| 720 |  |  |  |  |  |  |  | 
| 721 |  |  |  |  |  |  | Used internally by L when the L is set | 
| 722 |  |  |  |  |  |  | to 'stderr_only' (and the L is 'ipc_cmd'): | 
| 723 |  |  |  |  |  |  |  | 
| 724 |  |  |  |  |  |  | =cut | 
| 725 |  |  |  |  |  |  |  | 
| 726 |  |  |  |  |  |  | sub run_ipc_cmd_stderr_only { | 
| 727 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 728 | 0 |  |  |  |  | 0 | my $cmd  = shift; | 
| 729 | 0 |  |  |  |  | 0 | my $output; | 
| 730 |  |  |  |  |  |  | my $all_buf; | 
| 731 | 0 |  |  |  |  | 0 | require IPC::Cmd; | 
| 732 | 0 |  |  |  |  | 0 | my( $success, $error_code, $all_sep_buf, $stdout_buf, $stderr_buf ) = | 
| 733 |  |  |  |  |  |  | IPC::Cmd::run( command => $cmd, verbose => 0, buffer=> \$all_buf ); | 
| 734 | 0 |  |  |  |  | 0 | $output = $stderr_buf->[0]; | 
| 735 |  |  |  |  |  |  |  | 
| 736 | 0 | 0 |  |  |  | 0 | if( not( $success ) ) { | 
| 737 | 0 |  |  |  |  | 0 | warn "IPC::Cmd run of $cmd has failed"; | 
| 738 |  |  |  |  |  |  | } | 
| 739 | 0 | 0 |  |  |  | 0 | chomp( $output ) if $self->autochomp; | 
| 740 | 0 |  |  |  |  | 0 | return $output; | 
| 741 |  |  |  |  |  |  | } | 
| 742 |  |  |  |  |  |  |  | 
| 743 |  |  |  |  |  |  |  | 
| 744 |  |  |  |  |  |  | =item run_ipc_cmd_all_output | 
| 745 |  |  |  |  |  |  |  | 
| 746 |  |  |  |  |  |  | Used internally by L when the L is set | 
| 747 |  |  |  |  |  |  | to 'all_output' (and the L is 'ipc_cmd'): | 
| 748 |  |  |  |  |  |  |  | 
| 749 |  |  |  |  |  |  | =cut | 
| 750 |  |  |  |  |  |  |  | 
| 751 |  |  |  |  |  |  | sub run_ipc_cmd_all_output { | 
| 752 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 753 | 0 |  |  |  |  | 0 | my $cmd  = shift; | 
| 754 | 0 |  |  |  |  | 0 | my $output; | 
| 755 |  |  |  |  |  |  | my $all_buf; | 
| 756 | 0 |  |  |  |  | 0 | require IPC::Cmd; | 
| 757 | 0 | 0 |  |  |  | 0 | if(  IPC::Cmd::run( command => $cmd, verbose => 0, buffer=> \$all_buf )  ) { | 
| 758 | 0 |  |  |  |  | 0 | $output = $all_buf; | 
| 759 |  |  |  |  |  |  | } else { | 
| 760 | 0 |  |  |  |  | 0 | warn "IPC::Cmd run of $cmd failed."; | 
| 761 |  |  |  |  |  |  | } | 
| 762 | 0 | 0 |  |  |  | 0 | chomp( $output ) if $self->autochomp; | 
| 763 | 0 |  |  |  |  | 0 | return $output; | 
| 764 |  |  |  |  |  |  | } | 
| 765 |  |  |  |  |  |  |  | 
| 766 |  |  |  |  |  |  | =item run_ipc_cmd_all_separated | 
| 767 |  |  |  |  |  |  |  | 
| 768 |  |  |  |  |  |  | Used internally by L when the L is set | 
| 769 |  |  |  |  |  |  | to 'all_separated' (and the L is 'ipc_cmd'): | 
| 770 |  |  |  |  |  |  |  | 
| 771 |  |  |  |  |  |  | =cut | 
| 772 |  |  |  |  |  |  |  | 
| 773 |  |  |  |  |  |  | sub run_ipc_cmd_all_separated { | 
| 774 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 775 | 0 |  |  |  |  | 0 | my $cmd  = shift; | 
| 776 | 0 |  |  |  |  | 0 | my ($output, $stdout, $stderr); | 
| 777 | 0 |  |  |  |  | 0 | my $all_buf; | 
| 778 | 0 |  |  |  |  | 0 | require IPC::Cmd; | 
| 779 | 0 |  |  |  |  | 0 | my( $success, $error_code, $all_sep_buf, $stdout_buf, $stderr_buf ) = | 
| 780 |  |  |  |  |  |  | IPC::Cmd::run( command => $cmd, verbose => 0, buffer=> \$all_buf ); | 
| 781 | 0 |  |  |  |  | 0 | $output = $all_sep_buf; | 
| 782 |  |  |  |  |  |  |  | 
| 783 | 0 | 0 |  |  |  | 0 | if( not( $success ) ) { | 
| 784 | 0 |  |  |  |  | 0 | warn "IPC::Cmd run of $cmd failed."; | 
| 785 |  |  |  |  |  |  | } | 
| 786 |  |  |  |  |  |  |  | 
| 787 | 0 | 0 |  |  |  | 0 | $self->chomp_aref( $output ) if $self->autochomp; | 
| 788 | 0 |  |  |  |  | 0 | return $output; | 
| 789 |  |  |  |  |  |  | } | 
| 790 |  |  |  |  |  |  |  | 
| 791 |  |  |  |  |  |  | =back | 
| 792 |  |  |  |  |  |  |  | 
| 793 |  |  |  |  |  |  | =head1 utility methods | 
| 794 |  |  |  |  |  |  |  | 
| 795 |  |  |  |  |  |  | =over | 
| 796 |  |  |  |  |  |  |  | 
| 797 |  |  |  |  |  |  | =item chomp_aref | 
| 798 |  |  |  |  |  |  |  | 
| 799 |  |  |  |  |  |  | Like "chomp", but presumes it's been given an array reference | 
| 800 |  |  |  |  |  |  | of strings to work on. | 
| 801 |  |  |  |  |  |  |  | 
| 802 |  |  |  |  |  |  | =cut | 
| 803 |  |  |  |  |  |  |  | 
| 804 |  |  |  |  |  |  | sub chomp_aref { | 
| 805 | 0 |  |  | 0 | 1 | 0 | my $self  = shift; | 
| 806 | 0 |  |  |  |  | 0 | my $aref  = shift; | 
| 807 |  |  |  |  |  |  |  | 
| 808 | 0 | 0 |  |  |  | 0 | unless ( ref( $aref ) eq 'ARRAY' ) { | 
| 809 | 0 |  |  |  |  | 0 | croak "chomp_aref only works on an array reference"; | 
| 810 |  |  |  |  |  |  | } | 
| 811 | 0 |  |  |  |  | 0 | foreach ( @{ $aref } ){ | 
|  | 0 |  |  |  |  | 0 |  | 
| 812 | 0 |  |  |  |  | 0 | chomp( $_ ); | 
| 813 |  |  |  |  |  |  | } | 
| 814 | 0 |  |  |  |  | 0 | return $aref; | 
| 815 |  |  |  |  |  |  | } | 
| 816 |  |  |  |  |  |  |  | 
| 817 |  |  |  |  |  |  |  | 
| 818 |  |  |  |  |  |  |  | 
| 819 |  |  |  |  |  |  |  | 
| 820 |  |  |  |  |  |  | =back | 
| 821 |  |  |  |  |  |  |  | 
| 822 |  |  |  |  |  |  | =head2 basic setters and getters | 
| 823 |  |  |  |  |  |  |  | 
| 824 |  |  |  |  |  |  | The naming convention in use here is that setters begin with | 
| 825 |  |  |  |  |  |  | "set_", but getters have *no* prefix: the most commonly used case | 
| 826 |  |  |  |  |  |  | deserves the simplest syntax (and mutators are deprecated). | 
| 827 |  |  |  |  |  |  |  | 
| 828 |  |  |  |  |  |  | These accessors exist for all of the object attributes (documented | 
| 829 |  |  |  |  |  |  | above) irrespective of whether they're expected to be externally useful. | 
| 830 |  |  |  |  |  |  |  | 
| 831 |  |  |  |  |  |  | =head2  automatic generation of accessors | 
| 832 |  |  |  |  |  |  |  | 
| 833 |  |  |  |  |  |  | =over | 
| 834 |  |  |  |  |  |  |  | 
| 835 |  |  |  |  |  |  | =item AUTOLOAD | 
| 836 |  |  |  |  |  |  |  | 
| 837 |  |  |  |  |  |  | =cut | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | sub AUTOLOAD { | 
| 840 | 7 | 50 |  | 7 |  | 227 | return if $AUTOLOAD =~ /DESTROY$/;  # skip calls to DESTROY () | 
| 841 |  |  |  |  |  |  |  | 
| 842 | 7 |  |  |  |  | 195 | my ($name) = $AUTOLOAD =~ /([^:]+)$/; # extract method name | 
| 843 | 7 |  |  |  |  | 26 | (my $field = $name) =~ s/^set_//; | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | # check that this is a valid accessor call | 
| 846 | 7 | 50 |  |  |  | 25 | croak("Unknown method '$AUTOLOAD' called") | 
| 847 |  |  |  |  |  |  | unless defined( $ATTRIBUTES{ $field } ); | 
| 848 |  |  |  |  |  |  |  | 
| 849 | 1 |  |  | 1 |  | 9 | { no strict 'refs'; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 256 |  | 
|  | 7 |  |  |  |  | 12 |  | 
| 850 |  |  |  |  |  |  |  | 
| 851 |  |  |  |  |  |  | # create the setter and getter and install them in the symbol table | 
| 852 |  |  |  |  |  |  |  | 
| 853 | 7 | 100 |  |  |  | 34 | if ( $name =~ /^set_/ ) { | 
|  |  | 50 |  |  |  |  |  | 
| 854 |  |  |  |  |  |  |  | 
| 855 |  |  |  |  |  |  | *$name = sub { | 
| 856 | 8 |  |  | 8 |  | 9779 | my $self = shift; | 
| 857 | 8 |  |  |  |  | 42 | $self->{ $field } = shift; | 
| 858 | 8 |  |  |  |  | 29 | return $self->{ $field }; | 
| 859 | 1 |  |  |  |  | 24 | }; | 
| 860 |  |  |  |  |  |  |  | 
| 861 | 1 |  |  |  |  | 9 | goto &$name;              # jump to the new method. | 
| 862 |  |  |  |  |  |  | } elsif ( $name =~ /^get_/ ) { | 
| 863 | 0 |  |  |  |  | 0 | carp("Apparent attempt at using a getter with unneeded 'get_' prefix."); | 
| 864 |  |  |  |  |  |  | } | 
| 865 |  |  |  |  |  |  |  | 
| 866 |  |  |  |  |  |  | *$name = sub { | 
| 867 | 45 |  |  | 45 |  | 162 | my $self = shift; | 
| 868 | 45 |  |  |  |  | 307 | return $self->{ $field }; | 
| 869 | 6 |  |  |  |  | 51 | }; | 
| 870 |  |  |  |  |  |  |  | 
| 871 | 6 |  |  |  |  | 25 | goto &$name;                # jump to the new method. | 
| 872 |  |  |  |  |  |  | } | 
| 873 |  |  |  |  |  |  | } | 
| 874 |  |  |  |  |  |  |  | 
| 875 |  |  |  |  |  |  |  | 
| 876 |  |  |  |  |  |  | 1; | 
| 877 |  |  |  |  |  |  |  | 
| 878 |  |  |  |  |  |  | =back | 
| 879 |  |  |  |  |  |  |  | 
| 880 |  |  |  |  |  |  | =head1 How It Works | 
| 881 |  |  |  |  |  |  |  | 
| 882 |  |  |  |  |  |  | Where possible, IPC::Capture will simply work by running the | 
| 883 |  |  |  |  |  |  | given command in a sub-shell, invoked with a qx. | 
| 884 |  |  |  |  |  |  |  | 
| 885 |  |  |  |  |  |  | During the init phase, it tries to determine if a qx works as | 
| 886 |  |  |  |  |  |  | expected (using Bourne-shell style redirects) by the expedient of | 
| 887 |  |  |  |  |  |  | writing a temporary perl script that generates a known output, | 
| 888 |  |  |  |  |  |  | and then just trying to run the script. (This step will be | 
| 889 |  |  |  |  |  |  | skipped if the object is told which style of i/o it should use | 
| 890 |  |  |  |  |  |  | when instantiated.) | 
| 891 |  |  |  |  |  |  |  | 
| 892 |  |  |  |  |  |  | It appears that qx with i/o re-direction is a relatively portable | 
| 893 |  |  |  |  |  |  | idiom these days: it's supported by most forms of perl on | 
| 894 |  |  |  |  |  |  | Windows, and I would be surprised if OSX does not support it | 
| 895 |  |  |  |  |  |  | also. | 
| 896 |  |  |  |  |  |  |  | 
| 897 |  |  |  |  |  |  | If a qx fails, then this system will try another way of doing | 
| 898 |  |  |  |  |  |  | the job using the L module. | 
| 899 |  |  |  |  |  |  |  | 
| 900 |  |  |  |  |  |  | If no way of running a simple command and capturing it's output | 
| 901 |  |  |  |  |  |  | can be found, an error will be signalled during instantiation. | 
| 902 |  |  |  |  |  |  |  | 
| 903 |  |  |  |  |  |  | L in turn uses L or L (depending | 
| 904 |  |  |  |  |  |  | on which is installed), which means that this module should have | 
| 905 |  |  |  |  |  |  | a fair degree of cross-platform portability. | 
| 906 |  |  |  |  |  |  |  | 
| 907 |  |  |  |  |  |  | =head2 further notes | 
| 908 |  |  |  |  |  |  |  | 
| 909 |  |  |  |  |  |  | Depending on the type of output requested with the "filter", | 
| 910 |  |  |  |  |  |  | this module will choose to do either a scalar or an array context call | 
| 911 |  |  |  |  |  |  | to IPC::Cmd::run (insulating the user from one of IPC::Cmd's | 
| 912 |  |  |  |  |  |  | oddities). | 
| 913 |  |  |  |  |  |  |  | 
| 914 |  |  |  |  |  |  | =head1 MOTIVATION | 
| 915 |  |  |  |  |  |  |  | 
| 916 |  |  |  |  |  |  | The original goal was to find something more portable than | 
| 917 |  |  |  |  |  |  | shelling out via qx with Bourne shell redirection. | 
| 918 |  |  |  |  |  |  |  | 
| 919 |  |  |  |  |  |  | I'd just written the L module that shells out to | 
| 920 |  |  |  |  |  |  | emacs, and I was looking for improvements.  (Note: emacs is | 
| 921 |  |  |  |  |  |  | a widely available program, with portability roughly on the | 
| 922 |  |  |  |  |  |  | same scale as perl.) | 
| 923 |  |  |  |  |  |  |  | 
| 924 |  |  |  |  |  |  | The L module looked like a promising simplification | 
| 925 |  |  |  |  |  |  | over directly using L or L, but it's | 
| 926 |  |  |  |  |  |  | output capture features seemed clumsy. | 
| 927 |  |  |  |  |  |  |  | 
| 928 |  |  |  |  |  |  | So: my first thought was to write a wrapper around the wrapper, | 
| 929 |  |  |  |  |  |  | and as an added bonus, it would fall back on doing a simple qx | 
| 930 |  |  |  |  |  |  | if L wasn't going to work. | 
| 931 |  |  |  |  |  |  |  | 
| 932 |  |  |  |  |  |  | My initial tests of that code immediately revealed a problem | 
| 933 |  |  |  |  |  |  | with L: it usually worked as expected, but sometimes | 
| 934 |  |  |  |  |  |  | would behave strangely (e.g. returning only one line of output | 
| 935 |  |  |  |  |  |  | instead of the expected six; or instead of interleaving stderr | 
| 936 |  |  |  |  |  |  | with stdout, it might return all stderr lines first). | 
| 937 |  |  |  |  |  |  | My suspicion was that this was due to running on a perl with | 
| 938 |  |  |  |  |  |  | threads enabled, but in any case, it didn't inspire confidence | 
| 939 |  |  |  |  |  |  | with the idea that L was going to be more reliable than qx. | 
| 940 |  |  |  |  |  |  |  | 
| 941 |  |  |  |  |  |  | At which point, it occured to me that I could rewrite the | 
| 942 |  |  |  |  |  |  | module to work the other way around: just use qx, but fall | 
| 943 |  |  |  |  |  |  | back on L.  And indeed, it wasn't that difficult to | 
| 944 |  |  |  |  |  |  | write probe routines to find out if qx works reliably. | 
| 945 |  |  |  |  |  |  |  | 
| 946 |  |  |  |  |  |  | All of this work seemed a little besides the point when I realized | 
| 947 |  |  |  |  |  |  | that nearly every Windows installation of perl can deal with Bourne | 
| 948 |  |  |  |  |  |  | shell redirects -- but still this module may very well improve | 
| 949 |  |  |  |  |  |  | portability to some of the more unusual platforms such as VMS or | 
| 950 |  |  |  |  |  |  | the older Macs. | 
| 951 |  |  |  |  |  |  |  | 
| 952 |  |  |  |  |  |  | And at the very least, if I use this module religiously, I can | 
| 953 |  |  |  |  |  |  | stop worrying about mistyping '2>&1'. | 
| 954 |  |  |  |  |  |  |  | 
| 955 |  |  |  |  |  |  |  | 
| 956 |  |  |  |  |  |  | =head1 TODO | 
| 957 |  |  |  |  |  |  |  | 
| 958 |  |  |  |  |  |  | o  More filters -- "output_to_file", etc. | 
| 959 |  |  |  |  |  |  | Add a general purpose, user-defineable one? | 
| 960 |  |  |  |  |  |  |  | 
| 961 |  |  |  |  |  |  | o  IPC::Cmd seems to have reliability problems (possibly, with | 
| 962 |  |  |  |  |  |  | multi-threaded perls?), the precise output it returns can vary | 
| 963 |  |  |  |  |  |  | from run to run.  Possibly: implement a voting algorithm, return | 
| 964 |  |  |  |  |  |  | the output most commonly recieved. | 
| 965 |  |  |  |  |  |  |  | 
| 966 |  |  |  |  |  |  | o  Better test coverage:  autochomp;  probe_system*; | 
| 967 |  |  |  |  |  |  |  | 
| 968 |  |  |  |  |  |  | o  02-can_run.t tests multiple internal routines, only one flavor of | 
| 969 |  |  |  |  |  |  | which need work for the overall behavior to work.  Possibly should | 
| 970 |  |  |  |  |  |  | ship only with tests that verify the interface methods... | 
| 971 |  |  |  |  |  |  |  | 
| 972 |  |  |  |  |  |  | o  IPC::Capture lacks "success", as of 0.05.  This means the SYNOPSIS | 
| 973 |  |  |  |  |  |  | is complete nonsense for versions 0.04 and earlier. For now, | 
| 974 |  |  |  |  |  |  | not mentioning "success", but think about implementing it. | 
| 975 |  |  |  |  |  |  |  | 
| 976 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 977 |  |  |  |  |  |  |  | 
| 978 |  |  |  |  |  |  | L | 
| 979 |  |  |  |  |  |  | L | 
| 980 |  |  |  |  |  |  | L | 
| 981 |  |  |  |  |  |  |  | 
| 982 |  |  |  |  |  |  | Shell redirection apparently works on Windows: | 
| 983 |  |  |  |  |  |  | http://www.perlmonks.org/?node_id=679842 | 
| 984 |  |  |  |  |  |  |  | 
| 985 |  |  |  |  |  |  |  | 
| 986 |  |  |  |  |  |  | =head1 AUTHOR | 
| 987 |  |  |  |  |  |  |  | 
| 988 |  |  |  |  |  |  | Joseph Brenner, Edoom@kzsu.stanford.eduE, | 
| 989 |  |  |  |  |  |  | 07 Apr 2008 | 
| 990 |  |  |  |  |  |  |  | 
| 991 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 992 |  |  |  |  |  |  |  | 
| 993 |  |  |  |  |  |  | Copyright (C) 2008 by Joseph Brenner | 
| 994 |  |  |  |  |  |  |  | 
| 995 |  |  |  |  |  |  | This library is free software; you can redistribute it and/or modify | 
| 996 |  |  |  |  |  |  | it under the same terms as Perl itself, either Perl version 5.8.2 or, | 
| 997 |  |  |  |  |  |  | at your option, any later version of Perl 5 you may have available. | 
| 998 |  |  |  |  |  |  |  | 
| 999 |  |  |  |  |  |  | =head1 BUGS AND LIMITATIONS | 
| 1000 |  |  |  |  |  |  |  | 
| 1001 |  |  |  |  |  |  | There are possible security gotchas with using this module, | 
| 1002 |  |  |  |  |  |  | because it hands strings off to the shell to execute.  Any | 
| 1003 |  |  |  |  |  |  | commands built-up from user input should be scrubbed carefully | 
| 1004 |  |  |  |  |  |  | before being run with this module.  Using taint is strongly | 
| 1005 |  |  |  |  |  |  | recommended: see L. | 
| 1006 |  |  |  |  |  |  |  | 
| 1007 |  |  |  |  |  |  | =cut |