[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package Shell; 2 use 5.006_001; 3 use strict; 4 use warnings; 5 use File::Spec::Functions; 6 7 our($capture_stderr, $raw, $VERSION, $AUTOLOAD); 8 9 $VERSION = '0.72_01'; 10 $VERSION = eval $VERSION; 11 12 sub new { bless \my $foo, shift } 13 sub DESTROY { } 14 15 sub import { 16 my $self = shift; 17 my ($callpack, $callfile, $callline) = caller; 18 my @EXPORT; 19 if (@_) { 20 @EXPORT = @_; 21 } else { 22 @EXPORT = 'AUTOLOAD'; 23 } 24 foreach my $sym (@EXPORT) { 25 no strict 'refs'; 26 *{"$callpack}::$sym"} = \&{"Shell::$sym"}; 27 } 28 } 29 30 # NOTE: this is used to enable constant folding in 31 # expressions like (OS eq 'MSWin32') and 32 # (OS eq 'os2') just like it happened in 0.6 version 33 # which used eval "string" to install subs on the fly. 34 use constant OS => $^O; 35 36 =begin private 37 38 =item B<_make_cmd> 39 40 $sub = _make_cmd($cmd); 41 $sub = $shell->_make_cmd($cmd); 42 43 Creates a closure which invokes the system command C<$cmd>. 44 45 =end private 46 47 =cut 48 49 sub _make_cmd { 50 shift if ref $_[0] && $_[0]->isa( 'Shell' ); 51 my $cmd = shift; 52 my $null = File::Spec::Functions::devnull(); 53 $Shell::capture_stderr ||= 0; 54 # closing over $^O, $cmd, and $null 55 return sub { 56 shift if ref $_[0] && $_[0]->isa( 'Shell' ); 57 if (@_ < 1) { 58 $Shell::capture_stderr == 1 ? `$cmd 2>&1` : 59 $Shell::capture_stderr == -1 ? `$cmd 2>$null` : 60 `$cmd`; 61 } elsif (OS eq 'os2') { 62 local(*SAVEOUT, *READ, *WRITE); 63 64 open SAVEOUT, '>&STDOUT' or die; 65 pipe READ, WRITE or die; 66 open STDOUT, '>&WRITE' or die; 67 close WRITE; 68 69 my $pid = system(1, $cmd, @_); 70 die "Can't execute $cmd: $!\n" if $pid < 0; 71 72 open STDOUT, '>&SAVEOUT' or die; 73 close SAVEOUT; 74 75 if (wantarray) { 76 my @ret = <READ>; 77 close READ; 78 waitpid $pid, 0; 79 @ret; 80 } else { 81 local($/) = undef; 82 my $ret = <READ>; 83 close READ; 84 waitpid $pid, 0; 85 $ret; 86 } 87 } else { 88 my $a; 89 my @arr = @_; 90 unless( $Shell::raw ){ 91 if (OS eq 'MSWin32') { 92 # XXX this special-casing should not be needed 93 # if we do quoting right on Windows. :-( 94 # 95 # First, escape all quotes. Cover the case where we 96 # want to pass along a quote preceded by a backslash 97 # (i.e., C<"param \""" end">). 98 # Ugly, yup? You know, windoze. 99 # Enclose in quotes only the parameters that need it: 100 # try this: c:> dir "/w" 101 # and this: c:> dir /w 102 for (@arr) { 103 s/"/\\"/g; 104 s/\\\\"/\\\\"""/g; 105 $_ = qq["$_"] if /\s/; 106 } 107 } else { 108 for (@arr) { 109 s/(['\\])/\\$1/g; 110 $_ = $_; 111 } 112 } 113 } 114 push @arr, '2>&1' if $Shell::capture_stderr == 1; 115 push @arr, '2>$null' if $Shell::capture_stderr == -1; 116 open(SUBPROC, join(' ', $cmd, @arr, '|')) 117 or die "Can't exec $cmd: $!\n"; 118 if (wantarray) { 119 my @ret = <SUBPROC>; 120 close SUBPROC; # XXX Oughta use a destructor. 121 @ret; 122 } else { 123 local($/) = undef; 124 my $ret = <SUBPROC>; 125 close SUBPROC; 126 $ret; 127 } 128 } 129 }; 130 } 131 132 sub AUTOLOAD { 133 shift if ref $_[0] && $_[0]->isa( 'Shell' ); 134 my $cmd = $AUTOLOAD; 135 $cmd =~ s/^.*:://; 136 no strict 'refs'; 137 *$AUTOLOAD = _make_cmd($cmd); 138 goto &$AUTOLOAD; 139 } 140 141 1; 142 143 __END__ 144 145 =head1 NAME 146 147 Shell - run shell commands transparently within perl 148 149 =head1 SYNOPSIS 150 151 use Shell qw(cat ps cp); 152 $passwd = cat('</etc/passwd'); 153 @pslines = ps('-ww'), 154 cp("/etc/passwd", "/tmp/passwd"); 155 156 # object oriented 157 my $sh = Shell->new; 158 print $sh->ls('-l'); 159 160 =head1 DESCRIPTION 161 162 =head2 Caveats 163 164 This package is included as a show case, illustrating a few Perl features. 165 It shouldn't be used for production programs. Although it does provide a 166 simple interface for obtaining the standard output of arbitrary commands, 167 there may be better ways of achieving what you need. 168 169 Running shell commands while obtaining standard output can be done with the 170 C<qx/STRING/> operator, or by calling C<open> with a filename expression that 171 ends with C<|>, giving you the option to process one line at a time. 172 If you don't need to process standard output at all, you might use C<system> 173 (in preference of doing a print with the collected standard output). 174 175 Since Shell.pm and all of the aforementioned techniques use your system's 176 shell to call some local command, none of them is portable across different 177 systems. Note, however, that there are several built in functions and 178 library packages providing portable implementations of functions operating 179 on files, such as: C<glob>, C<link> and C<unlink>, C<mkdir> and C<rmdir>, 180 C<rename>, C<File::Compare>, C<File::Copy>, C<File::Find> etc. 181 182 Using Shell.pm while importing C<foo> creates a subroutine C<foo> in the 183 namespace of the importing package. Calling C<foo> with arguments C<arg1>, 184 C<arg2>,... results in a shell command C<foo arg1 arg2...>, where the 185 function name and the arguments are joined with a blank. (See the subsection 186 on Escaping magic characters.) Since the result is essentially a command 187 line to be passed to the shell, your notion of arguments to the Perl 188 function is not necessarily identical to what the shell treats as a 189 command line token, to be passed as an individual argument to the program. 190 Furthermore, note that this implies that C<foo> is callable by file name 191 only, which frequently depends on the setting of the program's environment. 192 193 Creating a Shell object gives you the opportunity to call any command 194 in the usual OO notation without requiring you to announce it in the 195 C<use Shell> statement. Don't assume any additional semantics being 196 associated with a Shell object: in no way is it similar to a shell 197 process with its environment or current working directory or any 198 other setting. 199 200 =head2 Escaping Magic Characters 201 202 It is, in general, impossible to take care of quoting the shell's 203 magic characters. For some obscure reason, however, Shell.pm quotes 204 apostrophes (C<'>) and backslashes (C<\>) on UNIX, and spaces and 205 quotes (C<">) on Windows. 206 207 =head2 Configuration 208 209 If you set $Shell::capture_stderr to 1, the module will attempt to 210 capture the standard error output of the process as well. This is 211 done by adding C<2E<gt>&1> to the command line, so don't try this on 212 a system not supporting this redirection. 213 214 Setting $Shell::capture_stderr to -1 will send standard error to the 215 bit bucket (i.e., the equivalent of adding C<2E<gt>/dev/null> to the 216 command line). The same caveat regarding redirection applies. 217 218 If you set $Shell::raw to true no quoting whatsoever is done. 219 220 =head1 BUGS 221 222 Quoting should be off by default. 223 224 It isn't possible to call shell built in commands, but it can be 225 done by using a workaround, e.g. shell( '-c', 'set' ). 226 227 Capturing standard error does not work on some systems (e.g. VMS). 228 229 =head1 AUTHOR 230 231 Date: Thu, 22 Sep 94 16:18:16 -0700 232 Message-Id: <9409222318.AA17072@scalpel.netlabs.com> 233 To: perl5-porters@isu.edu 234 From: Larry Wall <lwall@scalpel.netlabs.com> 235 Subject: a new module I just wrote 236 237 Here's one that'll whack your mind a little out. 238 239 #!/usr/bin/perl 240 241 use Shell; 242 243 $foo = echo("howdy", "<funny>", "world"); 244 print $foo; 245 246 $passwd = cat("</etc/passwd"); 247 print $passwd; 248 249 sub ps; 250 print ps -ww; 251 252 cp("/etc/passwd", "/etc/passwd.orig"); 253 254 That's maybe too gonzo. It actually exports an AUTOLOAD to the current 255 package (and uncovered a bug in Beta 3, by the way). Maybe the usual 256 usage should be 257 258 use Shell qw(echo cat ps cp); 259 260 Larry Wall 261 262 Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>. 263 264 Changes for OO syntax and bug fixes by Casey West <casey@geeknest.com>. 265 266 C<$Shell::raw> and pod rewrite by Wolfgang Laun. 267 268 Rewritten to use closures rather than C<eval "string"> by Adriano Ferreira. 269 270 =cut
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |