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