1*0Sstevel@tonic-gatepackage Shell; 2*0Sstevel@tonic-gateuse 5.006_001; 3*0Sstevel@tonic-gateuse strict; 4*0Sstevel@tonic-gateuse warnings; 5*0Sstevel@tonic-gateuse File::Spec::Functions; 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gateour($capture_stderr, $VERSION, $AUTOLOAD); 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate$VERSION = '0.5.2'; 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gatesub new { bless \my $foo, shift } 12*0Sstevel@tonic-gatesub DESTROY { } 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gatesub import { 15*0Sstevel@tonic-gate my $self = shift; 16*0Sstevel@tonic-gate my ($callpack, $callfile, $callline) = caller; 17*0Sstevel@tonic-gate my @EXPORT; 18*0Sstevel@tonic-gate if (@_) { 19*0Sstevel@tonic-gate @EXPORT = @_; 20*0Sstevel@tonic-gate } else { 21*0Sstevel@tonic-gate @EXPORT = 'AUTOLOAD'; 22*0Sstevel@tonic-gate } 23*0Sstevel@tonic-gate foreach my $sym (@EXPORT) { 24*0Sstevel@tonic-gate no strict 'refs'; 25*0Sstevel@tonic-gate *{"${callpack}::$sym"} = \&{"Shell::$sym"}; 26*0Sstevel@tonic-gate } 27*0Sstevel@tonic-gate} 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gatesub AUTOLOAD { 30*0Sstevel@tonic-gate shift if ref $_[0] && $_[0]->isa( 'Shell' ); 31*0Sstevel@tonic-gate my $cmd = $AUTOLOAD; 32*0Sstevel@tonic-gate $cmd =~ s/^.*:://; 33*0Sstevel@tonic-gate my $null = File::Spec::Functions::devnull(); 34*0Sstevel@tonic-gate $Shell::capture_stderr ||= 0; 35*0Sstevel@tonic-gate eval <<"*END*"; 36*0Sstevel@tonic-gate sub $AUTOLOAD { 37*0Sstevel@tonic-gate shift if ref \$_[0] && \$_[0]->isa( 'Shell' ); 38*0Sstevel@tonic-gate if (\@_ < 1) { 39*0Sstevel@tonic-gate \$Shell::capture_stderr == 1 ? `$cmd 2>&1` : 40*0Sstevel@tonic-gate \$Shell::capture_stderr == -1 ? `$cmd 2>$null` : 41*0Sstevel@tonic-gate `$cmd`; 42*0Sstevel@tonic-gate } elsif ('$^O' eq 'os2') { 43*0Sstevel@tonic-gate local(\*SAVEOUT, \*READ, \*WRITE); 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate open SAVEOUT, '>&STDOUT' or die; 46*0Sstevel@tonic-gate pipe READ, WRITE or die; 47*0Sstevel@tonic-gate open STDOUT, '>&WRITE' or die; 48*0Sstevel@tonic-gate close WRITE; 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate my \$pid = system(1, '$cmd', \@_); 51*0Sstevel@tonic-gate die "Can't execute $cmd: \$!\\n" if \$pid < 0; 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate open STDOUT, '>&SAVEOUT' or die; 54*0Sstevel@tonic-gate close SAVEOUT; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate if (wantarray) { 57*0Sstevel@tonic-gate my \@ret = <READ>; 58*0Sstevel@tonic-gate close READ; 59*0Sstevel@tonic-gate waitpid \$pid, 0; 60*0Sstevel@tonic-gate \@ret; 61*0Sstevel@tonic-gate } else { 62*0Sstevel@tonic-gate local(\$/) = undef; 63*0Sstevel@tonic-gate my \$ret = <READ>; 64*0Sstevel@tonic-gate close READ; 65*0Sstevel@tonic-gate waitpid \$pid, 0; 66*0Sstevel@tonic-gate \$ret; 67*0Sstevel@tonic-gate } 68*0Sstevel@tonic-gate } else { 69*0Sstevel@tonic-gate my \$a; 70*0Sstevel@tonic-gate my \@arr = \@_; 71*0Sstevel@tonic-gate if ('$^O' eq 'MSWin32') { 72*0Sstevel@tonic-gate # XXX this special-casing should not be needed 73*0Sstevel@tonic-gate # if we do quoting right on Windows. :-( 74*0Sstevel@tonic-gate # 75*0Sstevel@tonic-gate # First, escape all quotes. Cover the case where we 76*0Sstevel@tonic-gate # want to pass along a quote preceded by a backslash 77*0Sstevel@tonic-gate # (i.e., C<"param \\""" end">). 78*0Sstevel@tonic-gate # Ugly, yup? You know, windoze. 79*0Sstevel@tonic-gate # Enclose in quotes only the parameters that need it: 80*0Sstevel@tonic-gate # try this: c:\> dir "/w" 81*0Sstevel@tonic-gate # and this: c:\> dir /w 82*0Sstevel@tonic-gate for (\@arr) { 83*0Sstevel@tonic-gate s/"/\\\\"/g; 84*0Sstevel@tonic-gate s/\\\\\\\\"/\\\\\\\\"""/g; 85*0Sstevel@tonic-gate \$_ = qq["\$_"] if /\\s/; 86*0Sstevel@tonic-gate } 87*0Sstevel@tonic-gate } else { 88*0Sstevel@tonic-gate for (\@arr) { 89*0Sstevel@tonic-gate s/(['\\\\])/\\\\\$1/g; 90*0Sstevel@tonic-gate \$_ = \$_; 91*0Sstevel@tonic-gate } 92*0Sstevel@tonic-gate } 93*0Sstevel@tonic-gate push \@arr, '2>&1' if \$Shell::capture_stderr == 1; 94*0Sstevel@tonic-gate push \@arr, '2>$null' if \$Shell::capture_stderr == -1; 95*0Sstevel@tonic-gate open(SUBPROC, join(' ', '$cmd', \@arr, '|')) 96*0Sstevel@tonic-gate or die "Can't exec $cmd: \$!\\n"; 97*0Sstevel@tonic-gate if (wantarray) { 98*0Sstevel@tonic-gate my \@ret = <SUBPROC>; 99*0Sstevel@tonic-gate close SUBPROC; # XXX Oughta use a destructor. 100*0Sstevel@tonic-gate \@ret; 101*0Sstevel@tonic-gate } else { 102*0Sstevel@tonic-gate local(\$/) = undef; 103*0Sstevel@tonic-gate my \$ret = <SUBPROC>; 104*0Sstevel@tonic-gate close SUBPROC; 105*0Sstevel@tonic-gate \$ret; 106*0Sstevel@tonic-gate } 107*0Sstevel@tonic-gate } 108*0Sstevel@tonic-gate } 109*0Sstevel@tonic-gate*END* 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gate die "$@\n" if $@; 112*0Sstevel@tonic-gate goto &$AUTOLOAD; 113*0Sstevel@tonic-gate} 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gate1; 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gate__END__ 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate=head1 NAME 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gateShell - run shell commands transparently within perl 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate=head1 SYNOPSIS 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gateSee below. 126*0Sstevel@tonic-gate 127*0Sstevel@tonic-gate=head1 DESCRIPTION 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gate Date: Thu, 22 Sep 94 16:18:16 -0700 130*0Sstevel@tonic-gate Message-Id: <9409222318.AA17072@scalpel.netlabs.com> 131*0Sstevel@tonic-gate To: perl5-porters@isu.edu 132*0Sstevel@tonic-gate From: Larry Wall <lwall@scalpel.netlabs.com> 133*0Sstevel@tonic-gate Subject: a new module I just wrote 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gateHere's one that'll whack your mind a little out. 136*0Sstevel@tonic-gate 137*0Sstevel@tonic-gate #!/usr/bin/perl 138*0Sstevel@tonic-gate 139*0Sstevel@tonic-gate use Shell; 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gate $foo = echo("howdy", "<funny>", "world"); 142*0Sstevel@tonic-gate print $foo; 143*0Sstevel@tonic-gate 144*0Sstevel@tonic-gate $passwd = cat("</etc/passwd"); 145*0Sstevel@tonic-gate print $passwd; 146*0Sstevel@tonic-gate 147*0Sstevel@tonic-gate sub ps; 148*0Sstevel@tonic-gate print ps -ww; 149*0Sstevel@tonic-gate 150*0Sstevel@tonic-gate cp("/etc/passwd", "/etc/passwd.orig"); 151*0Sstevel@tonic-gate 152*0Sstevel@tonic-gateThat's maybe too gonzo. It actually exports an AUTOLOAD to the current 153*0Sstevel@tonic-gatepackage (and uncovered a bug in Beta 3, by the way). Maybe the usual 154*0Sstevel@tonic-gateusage should be 155*0Sstevel@tonic-gate 156*0Sstevel@tonic-gate use Shell qw(echo cat ps cp); 157*0Sstevel@tonic-gate 158*0Sstevel@tonic-gateLarry 159*0Sstevel@tonic-gate 160*0Sstevel@tonic-gate 161*0Sstevel@tonic-gateIf you set $Shell::capture_stderr to 1, the module will attempt to 162*0Sstevel@tonic-gatecapture the STDERR of the process as well. 163*0Sstevel@tonic-gate 164*0Sstevel@tonic-gateIf you set $Shell::capture_stderr to -1, the module will discard the 165*0Sstevel@tonic-gateSTDERR of the process. 166*0Sstevel@tonic-gate 167*0Sstevel@tonic-gateThe module now should work on Win32. 168*0Sstevel@tonic-gate 169*0Sstevel@tonic-gate Jenda 170*0Sstevel@tonic-gate 171*0Sstevel@tonic-gateThere seemed to be a problem where all arguments to a shell command were 172*0Sstevel@tonic-gatequoted before being executed. As in the following example: 173*0Sstevel@tonic-gate 174*0Sstevel@tonic-gate cat('</etc/passwd'); 175*0Sstevel@tonic-gate ls('*.pl'); 176*0Sstevel@tonic-gate 177*0Sstevel@tonic-gatereally turned into: 178*0Sstevel@tonic-gate 179*0Sstevel@tonic-gate cat '</etc/passwd' 180*0Sstevel@tonic-gate ls '*.pl' 181*0Sstevel@tonic-gate 182*0Sstevel@tonic-gateinstead of: 183*0Sstevel@tonic-gate 184*0Sstevel@tonic-gate cat </etc/passwd 185*0Sstevel@tonic-gate ls *.pl 186*0Sstevel@tonic-gate 187*0Sstevel@tonic-gateand of course, this is wrong. 188*0Sstevel@tonic-gate 189*0Sstevel@tonic-gateI have fixed this bug, it was brought up by Wolfgang Laun [ID 20000326.008] 190*0Sstevel@tonic-gate 191*0Sstevel@tonic-gateCasey 192*0Sstevel@tonic-gate 193*0Sstevel@tonic-gate=head2 OBJECT ORIENTED SYNTAX 194*0Sstevel@tonic-gate 195*0Sstevel@tonic-gateShell now has an OO interface. Good for namespace conservation 196*0Sstevel@tonic-gateand shell representation. 197*0Sstevel@tonic-gate 198*0Sstevel@tonic-gate use Shell; 199*0Sstevel@tonic-gate my $sh = Shell->new; 200*0Sstevel@tonic-gate print $sh->ls; 201*0Sstevel@tonic-gate 202*0Sstevel@tonic-gateCasey 203*0Sstevel@tonic-gate 204*0Sstevel@tonic-gate=head1 AUTHOR 205*0Sstevel@tonic-gate 206*0Sstevel@tonic-gateLarry Wall 207*0Sstevel@tonic-gate 208*0Sstevel@tonic-gateChanges by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz> 209*0Sstevel@tonic-gate 210*0Sstevel@tonic-gateChanges and bug fixes by Casey West <casey@geeknest.com> 211*0Sstevel@tonic-gate 212*0Sstevel@tonic-gate=cut 213