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