X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FShell.pm;h=c2f522cae309363daeac532639022f40f59c10ad;hb=3baa4c62cda542368be1e7e1f7af8bd8257c2ff4;hp=8098bf2892c28da1b646bac295666c731d760358;hpb=a0d0e21ea6ea90a22318550944fe6cb09ae10cda;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Shell.pm b/lib/Shell.pm
index 8098bf2..c2f522c 100644
--- a/lib/Shell.pm
+++ b/lib/Shell.pm
@@ -1,4 +1,13 @@
 package Shell;
+use 5.005_64;
+use strict;
+use warnings;
+our($capture_stderr, $VERSION, $AUTOLOAD);
+
+$VERSION = '0.3';
+
+sub new { bless \$VERSION, shift } # Nothing better to bless
+sub DESTROY { }
 
 sub import {
     my $self = shift;
@@ -6,33 +15,82 @@ 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 {
+    eval <<"*END*";
 	sub $AUTOLOAD {
-	    if (\@_ < 2) {
-		`$cmd \@_`;
-	    }
-	    else {
-		open(SUBPROC, "-|")
-			or exec '$cmd', \@_
-			or die "Can't exec $cmd: \$!\n";
+	    if (\@_ < 1) {
+		\$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
+	    } elsif ('$^O' eq 'os2') {
+		local(\*SAVEOUT, \*READ, \*WRITE);
+
+		open SAVEOUT, '>&STDOUT' or die;
+		pipe READ, WRITE or die;
+		open STDOUT, '>&WRITE' or die;
+		close WRITE;
+
+		my \$pid = system(1, '$cmd', \@_);
+		die "Can't execute $cmd: \$!\\n" if \$pid < 0;
+
+		open STDOUT, '>&SAVEOUT' or die;
+		close SAVEOUT;
+
+		if (wantarray) {
+		    my \@ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \@ret;
+		} else {
+		    local(\$/) = undef;
+		    my \$ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \$ret;
+		}
+	    } 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;
@@ -40,8 +98,104 @@ AUTOLOAD {
 		}
 	    }
 	}
-    };
+*END*
+
+    die "$@\n" if $@;
     goto &$AUTOLOAD;
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+Shell - run shell commands transparently within perl
+
+=head1 SYNOPSIS
+
+See below.
+
+=head1 DESCRIPTION
+
+  Date: Thu, 22 Sep 94 16:18:16 -0700
+  Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
+  To: perl5-porters@isu.edu
+  From: Larry Wall <lwall@scalpel.netlabs.com>
+  Subject: a new module I just wrote
+
+Here's one that'll whack your mind a little out.
+
+    #!/usr/bin/perl
+
+    use Shell;
+
+    $foo = echo("howdy", "<funny>", "world");
+    print $foo;
+
+    $passwd = cat("</etc/passwd");
+    print $passwd;
+
+    sub ps;
+    print ps -ww;
+
+    cp("/etc/passwd", "/tmp/passwd");
+
+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
+usage should be
+
+    use Shell qw(echo cat ps cp);
+
+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