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