Sync with libnet 1.18

[perl5.git] / lib / Shell.pm

diff --git a/lib/Shell.pm b/lib/Shell.pm
index f4ef431..a89db69 100644 (file)
--- a/lib/Shell.pm
+++ b/lib/Shell.pm
@@ -1,6 +1,15 @@
 package Shell;
+use 5.006_001;
+use strict;
+use warnings;
+use File::Spec::Functions;
 
-use Config;
+our($capture_stderr, $VERSION, $AUTOLOAD);
+
+$VERSION = '0.5.2';
+
+sub new { bless \my $foo, shift }
+sub DESTROY { }
 
 sub import {
     my $self = shift;
@@ -8,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/^.*:://;
-    eval qq {
-       *$AUTOLOAD = sub {
+    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 ==  1 ? `$cmd 2>&1` : 
+               \$Shell::capture_stderr == -1 ? `$cmd 2>$null` : 
                `$cmd`;
-           }
-           elsif (\$Config{'archname'} eq 'os2') {
+           } elsif ('$^O' eq 'os2') {
                local(\*SAVEOUT, \*READ, \*WRITE);
 
                open SAVEOUT, '>&STDOUT' or die;
@@ -33,8 +47,8 @@ AUTOLOAD {
                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;
@@ -44,25 +58,47 @@ AUTOLOAD {
                    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 ==  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 = <SUBPROC>;
                    close SUBPROC;      # XXX Oughta use a destructor.
                    \@ret;
-               }
-               else {
+               } else {
                    local(\$/) = undef;
                    my \$ret = <SUBPROC>;
                    close SUBPROC;
@@ -70,11 +106,14 @@ AUTOLOAD {
                }
            }
        }
-    };
+*END*
+
+    die "$@\n" if $@;
     goto &$AUTOLOAD;
 }
 
 1;
+
 __END__
 
 =head1 NAME
@@ -108,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
@@ -119,8 +158,55 @@ usage should be
 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('</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 West <casey@geeknest.com>
+
 =cut