Shell.pm revision 7c478bd95313f5f23a4c958a745db2134aa03244
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rosspackage Shell;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossuse 5.005_64;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossuse strict;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossuse warnings;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossour($capture_stderr, $VERSION, $AUTOLOAD);
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross$VERSION = '0.3';
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rosssub new { bless \$VERSION, shift } # Nothing better to bless
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rosssub DESTROY { }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rosssub import {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my $self = shift;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my ($callpack, $callfile, $callline) = caller;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my @EXPORT;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross if (@_) {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross @EXPORT = @_;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross } else {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross @EXPORT = 'AUTOLOAD';
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross foreach my $sym (@EXPORT) {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross no strict 'refs';
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross *{"${callpack}::$sym"} = \&{"Shell::$sym"};
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross}
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rosssub AUTOLOAD {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross shift if ref $_[0] && $_[0]->isa( 'Shell' );
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my $cmd = $AUTOLOAD;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross $cmd =~ s/^.*:://;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross eval <<"*END*";
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross sub $AUTOLOAD {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross if (\@_ < 1) {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross \$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross } elsif ('$^O' eq 'os2') {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross local(\*SAVEOUT, \*READ, \*WRITE);
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross open SAVEOUT, '>&STDOUT' or die;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross pipe READ, WRITE or die;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross open STDOUT, '>&WRITE' or die;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross close WRITE;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my \$pid = system(1, '$cmd', \@_);
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross die "Can't execute $cmd: \$!\\n" if \$pid < 0;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross open STDOUT, '>&SAVEOUT' or die;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross close SAVEOUT;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross if (wantarray) {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my \@ret = <READ>;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross close READ;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross waitpid \$pid, 0;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross \@ret;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross } else {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross local(\$/) = undef;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my \$ret = <READ>;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross close READ;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross waitpid \$pid, 0;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross \$ret;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross } else {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my \$a;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my \@arr = \@_;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross if ('$^O' eq 'MSWin32') {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # XXX this special-casing should not be needed
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # if we do quoting right on Windows. :-(
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross #
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # First, escape all quotes. Cover the case where we
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # want to pass along a quote preceded by a backslash
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # (i.e., C<"param \\""" end">).
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # Ugly, yup? You know, windoze.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # Enclose in quotes only the parameters that need it:
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # try this: c:\> dir "/w"
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross # and this: c:\> dir /w
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross for (\@arr) {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross s/"/\\\\"/g;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross s/\\\\\\\\"/\\\\\\\\"""/g;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross \$_ = qq["\$_"] if /\\s/;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross } else {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross for (\@arr) {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross s/(['\\\\])/\\\\\$1/g;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross \$_ = \$_;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross push \@arr, '2>&1' if \$Shell::capture_stderr;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross open(SUBPROC, join(' ', '$cmd', \@arr, '|'))
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross or die "Can't exec $cmd: \$!\\n";
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross if (wantarray) {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my \@ret = <SUBPROC>;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross close SUBPROC; # XXX Oughta use a destructor.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross \@ret;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross } else {
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross local(\$/) = undef;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my \$ret = <SUBPROC>;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross close SUBPROC;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross \$ret;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross }
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross*END*
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross die "$@\n" if $@;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross goto &$AUTOLOAD;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross}
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross1;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross__END__
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross=head1 NAME
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossShell - run shell commands transparently within perl
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross=head1 SYNOPSIS
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossSee below.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross=head1 DESCRIPTION
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross Date: Thu, 22 Sep 94 16:18:16 -0700
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross To: perl5-porters@isu.edu
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross From: Larry Wall <lwall@scalpel.netlabs.com>
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross Subject: a new module I just wrote
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossHere's one that'll whack your mind a little out.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross #!/usr/bin/perl
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross use Shell;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross $foo = echo("howdy", "<funny>", "world");
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross print $foo;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross $passwd = cat("</etc/passwd");
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross print $passwd;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross sub ps;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross print ps -ww;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross cp("/etc/passwd", "/tmp/passwd");
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossThat's maybe too gonzo. It actually exports an AUTOLOAD to the current
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rosspackage (and uncovered a bug in Beta 3, by the way). Maybe the usual
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossusage should be
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross use Shell qw(echo cat ps cp);
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossLarry
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossIf you set $Shell::capture_stderr to 1, the module will attempt to
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rosscapture the STDERR of the process as well.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossThe module now should work on Win32.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross Jenda
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossThere seemed to be a problem where all arguments to a shell command were
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossquoted before being executed. As in the following example:
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross cat('</etc/passwd');
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross ls('*.pl');
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossreally turned into:
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross cat '</etc/passwd'
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross ls '*.pl'
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossinstead of:
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross cat </etc/passwd
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross ls *.pl
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossand of course, this is wrong.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossI have fixed this bug, it was brought up by Wolfgang Laun [ID 20000326.008]
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossCasey
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross=head2 OBJECT ORIENTED SYNTAX
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossShell now has an OO interface. Good for namespace conservation
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Rossand shell representation.
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross use Shell;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross my $sh = Shell->new;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross print $sh->ls;
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossCasey
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross=head1 AUTHOR
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossLarry Wall
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossChanges by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon RossChanges and bug fixes by Casey Tweten <crt@kiski.net>
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross=cut
b819cea2f73f98c5662230cc9affc8cc84f77fcfGordon Ross