package Shell; use 5.006_001; use strict; use warnings; our($capture_stderr, $VERSION, $AUTOLOAD); $VERSION = '0.4'; sub new { bless \$VERSION, shift } # Nothing better to bless sub DESTROY { } sub import { my $self = shift; my ($callpack, $callfile, $callline) = caller; my @EXPORT; if (@_) { @EXPORT = @_; } else { @EXPORT = 'AUTOLOAD'; } foreach my $sym (@EXPORT) { no strict 'refs'; *{"${callpack}::$sym"} = \&{"Shell::$sym"}; } } sub AUTOLOAD { shift if ref $_[0] && $_[0]->isa( 'Shell' ); my $cmd = $AUTOLOAD; $cmd =~ s/^.*:://; eval <<"*END*"; sub $AUTOLOAD { shift if ref \$_[0] && \$_[0]->isa( 'Shell' ); 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 = ; close READ; waitpid \$pid, 0; \@ret; } else { local(\$/) = undef; my \$ret = ; 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 = ; close SUBPROC; # XXX Oughta use a destructor. \@ret; } else { local(\$/) = undef; my \$ret = ; close SUBPROC; \$ret; } } } *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 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", "", "world"); print $foo; $passwd = cat("new; print $sh->ls; Casey =head1 AUTHOR Larry Wall Changes by Jenda@Krynicky.cz and Dave Cottle Changes and bug fixes by Casey West =cut