X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FShell.pm;h=a84d9a9f67aac4d9ae9f2b89af38eb2fd69c7a37;hb=0740f80f71de6af2dd0e3c3aecddec0fc42f34f0;hp=bb44b5398b5447d7af3d89835b04f3e19bdc6208;hpb=a5f75d667838e8e7bb037880391f5c44476d33b4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Shell.pm b/lib/Shell.pm
index bb44b53..a84d9a9 100644
--- 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, $raw, $VERSION, $AUTOLOAD);
+
+$VERSION = '0.6';
+
+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 {
+    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,49 @@ 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 = \@_;
+		unless( \$Shell::raw ){
+		  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 +108,14 @@ AUTOLOAD {
 		}
 	    }
 	}
-    };
+*END*
+
+    die "$@\n" if $@;
     goto &$AUTOLOAD;
 }
 
 1;
+
 __END__
 
 =head1 NAME
@@ -83,10 +124,82 @@ Shell - run shell commands transparently within perl
 
 =head1 SYNOPSIS
 
-See below.
+   use Shell qw(cat ps cp);
+   $passwd = cat('</etc/passwd');
+   @pslines = ps('-ww'),
+   cp("/etc/passwd", "/tmp/passwd");
+
+   # object oriented 
+   my $sh = Shell->new;
+   print $sh->ls('-l');
 
 =head1 DESCRIPTION
 
+=head2 Caveats
+
+This package is included as a show case, illustrating a few Perl features.
+It shouldn't be used for production programs. Although it does provide a 
+simple interface for obtaining the standard output of arbitrary commands,
+there may be better ways of achieving what you need.
+
+Running shell commands while obtaining standard output can be done with the
+C<qx/STRING/> operator, or by calling C<open> with a filename expression that
+ends with C<|>, giving you the option to process one line at a time.
+If you don't need to process standard output at all, you might use C<system>
+(in preference of doing a print with the collected standard output).
+
+Since Shell.pm and all of the aforementioned techniques use your system's
+shell to call some local command, none of them is portable across different 
+systems. Note, however, that there are several built in functions and 
+library packages providing portable implementations of functions operating
+on files, such as: C<glob>, C<link> and C<unlink>, C<mkdir> and C<rmdir>, 
+C<rename>, C<File::Compare>, C<File::Copy>, C<File::Find> etc.
+
+Using Shell.pm while importing C<foo> creates a subroutine C<foo> in the
+namespace of the importing package. Calling C<foo> with arguments C<arg1>,
+C<arg2>,... results in a shell command C<foo arg1 arg2...>, where the 
+function name and the arguments are joined with a blank. (See the subsection 
+on Escaping magic characters.) Since the result is essentially a command
+line to be passed to the shell, your notion of arguments to the Perl
+function is not necessarily identical to what the shell treats as a
+command line token, to be passed as an individual argument to the program.
+Furthermore, note that this implies that C<foo> is callable by file name
+only, which frequently depends on the setting of the program's environment.
+
+Creating a Shell object gives you the opportunity to call any command
+in the usual OO notation without requiring you to announce it in the
+C<use Shell> statement. Don't assume any additional semantics being
+associated with a Shell object: in no way is it similar to a shell
+process with its environment or current working directory or any
+other setting.
+
+=head2 Escaping Magic Characters
+
+It is, in general, impossible to take care of quoting the shell's
+magic characters. For some obscure reason, however, Shell.pm quotes
+apostrophes (C<'>) and backslashes (C<\>) on UNIX, and spaces and
+quotes (C<">) on Windows.
+
+=head2 Configuration
+
+If you set $Shell::capture_stderr to true, the module will attempt to
+capture the standard error output of the process as well. This is
+done by adding C<2E<gt>&1> to the command line, so don't try this on
+a system not supporting this redirection.
+
+If you set $Shell::raw to true no quoting whatsoever is done.
+
+=head1 BUGS
+
+Quoting should be off by default.
+
+It isn't possible to call shell built in commands, but it can be
+done by using a workaround, e.g. shell( '-c', 'set' ).
+
+Capturing standard error does not work on some systems (e.g. VMS).
+
+=head1 AUTHOR
+
   Date: Thu, 22 Sep 94 16:18:16 -0700
   Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
   To: perl5-porters@isu.edu
@@ -108,7 +221,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
@@ -116,11 +229,12 @@ usage should be
 
     use Shell qw(echo cat ps cp);
 
-Larry
+Larry Wall
 
+Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>.
 
-=head1 AUTHOR
+Changes for OO syntax and bug fixes by Casey West <casey@geeknest.com>.
 
-Larry Wall
+C<$Shell::raw> and pod rewrite by Wolfgang Laun.
 
 =cut