X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FShell.pm;h=a89db69288a682712caf831d7ed08d354aff7ef9;hb=8aa03e5d63b0323d10767d89d543f39f35238218;hp=0177479de51e9abe19fb1028b56d19e21f6cd57d;hpb=253924a21d6a80fbb4d98f38b1639af22bd286cd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Shell.pm b/lib/Shell.pm index 0177479..a89db69 100644 --- a/lib/Shell.pm +++ b/lib/Shell.pm @@ -1,7 +1,15 @@ package Shell; -use vars qw($capture_stderr $VERSION); +use 5.006_001; +use strict; +use warnings; +use File::Spec::Functions; -$VERSION = '0.2'; +our($capture_stderr, $VERSION, $AUTOLOAD); + +$VERSION = '0.5.2'; + +sub new { bless \my $foo, shift } +sub DESTROY { } sub import { my $self = shift; @@ -9,24 +17,29 @@ sub import { my @EXPORT; if (@_) { @EXPORT = @_; - } - else { + } else { @EXPORT = 'AUTOLOAD'; } - foreach $sym (@EXPORT) { + foreach my $sym (@EXPORT) { + no strict 'refs'; *{"${callpack}::$sym"} = \&{"Shell::$sym"}; } -}; +} -AUTOLOAD { +sub AUTOLOAD { + shift if ref $_[0] && $_[0]->isa( 'Shell' ); my $cmd = $AUTOLOAD; $cmd =~ s/^.*:://; + my $null = File::Spec::Functions::devnull(); + $Shell::capture_stderr ||= 0; eval <<"*END*"; sub $AUTOLOAD { + shift if ref \$_[0] && \$_[0]->isa( 'Shell' ); if (\@_ < 1) { - \$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`; - } - elsif ('$^O' eq 'os2') { + \$Shell::capture_stderr == 1 ? `$cmd 2>&1` : + \$Shell::capture_stderr == -1 ? `$cmd 2>$null` : + `$cmd`; + } elsif ('$^O' eq 'os2') { local(\*SAVEOUT, \*READ, \*WRITE); open SAVEOUT, '>&STDOUT' or die; @@ -45,16 +58,14 @@ AUTOLOAD { close READ; waitpid \$pid, 0; \@ret; - } - else { + } else { local(\$/) = undef; my \$ret = ; close READ; waitpid \$pid, 0; \$ret; } - } - else { + } else { my \$a; my \@arr = \@_; if ('$^O' eq 'MSWin32') { @@ -71,24 +82,23 @@ AUTOLOAD { for (\@arr) { s/"/\\\\"/g; s/\\\\\\\\"/\\\\\\\\"""/g; - \$_ = qq["\$_"] if /\s/; + \$_ = qq["\$_"] if /\\s/; } - } - else { + } else { for (\@arr) { s/(['\\\\])/\\\\\$1/g; - \$_ = "'\$_'"; + \$_ = \$_; } } - push \@arr, '2>&1' if \$Shell::capture_stderr; + push \@arr, '2>&1' if \$Shell::capture_stderr == 1; + push \@arr, '2>$null' if \$Shell::capture_stderr == -1; open(SUBPROC, join(' ', '$cmd', \@arr, '|')) or die "Can't exec $cmd: \$!\\n"; if (wantarray) { my \@ret = ; close SUBPROC; # XXX Oughta use a destructor. \@ret; - } - else { + } else { local(\$/) = undef; my \$ret = ; close SUBPROC; @@ -103,6 +113,7 @@ AUTOLOAD { } 1; + __END__ =head1 NAME @@ -136,7 +147,7 @@ Here's one that'll whack your mind a little out. sub ps; print ps -ww; - cp("/etc/passwd", "/tmp/passwd"); + cp("/etc/passwd", "/etc/passwd.orig"); That's maybe too gonzo. It actually exports an AUTOLOAD to the current package (and uncovered a bug in Beta 3, by the way). Maybe the usual @@ -150,14 +161,52 @@ Larry If you set $Shell::capture_stderr to 1, the module will attempt to capture the STDERR of the process as well. +If you set $Shell::capture_stderr to -1, the module will discard the +STDERR of the process. + The module now should work on Win32. Jenda +There seemed to be a problem where all arguments to a shell command were +quoted before being executed. As in the following example: + + cat('new; + print $sh->ls; + +Casey + =head1 AUTHOR Larry Wall Changes by Jenda@Krynicky.cz and Dave Cottle +Changes and bug fixes by Casey West + =cut