package Shell;
+use 5.005_64;
+use strict;
+use warnings;
+our($capture_stderr, $VERSION, $AUTOLOAD);
-use Config;
+$VERSION = '0.3';
+
+sub new { bless \$VERSION, shift } # Nothing better to bless
+sub DESTROY { }
sub import {
my $self = shift;
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/^.*:://;
- eval qq {
- *$AUTOLOAD = sub {
+ eval <<"*END*";
+ sub $AUTOLOAD {
if (\@_ < 1) {
- `$cmd`;
- }
- elsif (\$Config{'archname'} eq 'os2') {
+ \$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
+ } elsif ('$^O' eq 'os2') {
local(\*SAVEOUT, \*READ, \*WRITE);
open SAVEOUT, '>&STDOUT' or die;
open STDOUT, '>&WRITE' or die;
close WRITE;
- my \$pid = system(1, \$cmd, \@_);
- die "Can't execute $cmd: \$!\n" if \$pid < 0;
+ my \$pid = system(1, '$cmd', \@_);
+ die "Can't execute $cmd: \$!\\n" if \$pid < 0;
open STDOUT, '>&SAVEOUT' or die;
close SAVEOUT;
close READ;
waitpid \$pid, 0;
\@ret;
- }
- else {
+ } else {
local(\$/) = undef;
my \$ret = <READ>;
close READ;
waitpid \$pid, 0;
\$ret;
}
- }
- else {
- open(SUBPROC, "-|")
- or exec '$cmd', \@_
- or die "Can't exec $cmd: \$!\n";
+ } else {
+ my \$a;
+ my \@arr = \@_;
+ if ('$^O' eq 'MSWin32') {
+ # XXX this special-casing should not be needed
+ # if we do quoting right on Windows. :-(
+ #
+ # First, escape all quotes. Cover the case where we
+ # want to pass along a quote preceded by a backslash
+ # (i.e., C<"param \\""" end">).
+ # Ugly, yup? You know, windoze.
+ # Enclose in quotes only the parameters that need it:
+ # try this: c:\> dir "/w"
+ # and this: c:\> dir /w
+ for (\@arr) {
+ s/"/\\\\"/g;
+ s/\\\\\\\\"/\\\\\\\\"""/g;
+ \$_ = qq["\$_"] if /\\s/;
+ }
+ } else {
+ for (\@arr) {
+ s/(['\\\\])/\\\\\$1/g;
+ \$_ = \$_;
+ }
+ }
+ push \@arr, '2>&1' if \$Shell::capture_stderr;
+ open(SUBPROC, join(' ', '$cmd', \@arr, '|'))
+ or die "Can't exec $cmd: \$!\\n";
if (wantarray) {
my \@ret = <SUBPROC>;
close SUBPROC; # XXX Oughta use a destructor.
\@ret;
- }
- else {
+ } else {
local(\$/) = undef;
my \$ret = <SUBPROC>;
close SUBPROC;
}
}
}
- };
+*END*
+
+ die "$@\n" if $@;
goto &$AUTOLOAD;
}
1;
+
__END__
=head1 NAME
Larry
+If you set $Shell::capture_stderr to 1, the module will attempt to
+capture the STDERR of the process as well.
+
+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('</etc/passwd');
+ ls('*.pl');
+
+really turned into:
+
+ cat '</etc/passwd'
+ ls '*.pl'
+
+instead of:
+
+ cat </etc/passwd
+ ls *.pl
+
+and of course, this is wrong.
+
+I have fixed this bug, it was brought up by Wolfgang Laun [ID 20000326.008]
+
+Casey
+
+=head2 OBJECT ORIENTED SYNTAX
+
+Shell now has an OO interface. Good for namespace conservation
+and shell representation.
+
+ use Shell;
+ my $sh = Shell->new;
+ print $sh->ls;
+
+Casey
+
=head1 AUTHOR
Larry Wall
+Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
+
+Changes and bug fixes by Casey Tweten <crt@kiski.net>
+
=cut