1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
package Shell;
use 5.005_64;
our($capture_stderr, $VERSION);
$VERSION = '0.2';
sub import {
my $self = shift;
my ($callpack, $callfile, $callline) = caller;
my @EXPORT;
if (@_) {
@EXPORT = @_;
}
else {
@EXPORT = 'AUTOLOAD';
}
foreach $sym (@EXPORT) {
*{"${callpack}::$sym"} = \&{"Shell::$sym"};
}
};
AUTOLOAD {
my $cmd = $AUTOLOAD;
$cmd =~ s/^.*:://;
eval <<"*END*";
sub $AUTOLOAD {
if (\@_ < 1) {
\$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
}
elsif ('$^O' eq 'os2') {
local(\*SAVEOUT, \*READ, \*WRITE);
open SAVEOUT, '>&STDOUT' or die;
pipe READ, WRITE or die;
open STDOUT, '>&WRITE' or die;
close WRITE;
my \$pid = system(1, '$cmd', \@_);
die "Can't execute $cmd: \$!\\n" if \$pid < 0;
open STDOUT, '>&SAVEOUT' or die;
close SAVEOUT;
if (wantarray) {
my \@ret = <READ>;
close READ;
waitpid \$pid, 0;
\@ret;
}
else {
local(\$/) = undef;
my \$ret = <READ>;
close READ;
waitpid \$pid, 0;
\$ret;
}
}
else {
my \$a;
my \@arr = \@_;
if ('$^O' eq 'MSWin32') {
# XXX this special-casing should not be needed
# if we do quoting right on Windows. :-(
#
# First, escape all quotes. Cover the case where we
# want to pass along a quote preceded by a backslash
# (i.e., C<"param \\""" end">).
# Ugly, yup? You know, windoze.
# Enclose in quotes only the parameters that need it:
# try this: c:\> dir "/w"
# and this: c:\> dir /w
for (\@arr) {
s/"/\\\\"/g;
s/\\\\\\\\"/\\\\\\\\"""/g;
\$_ = qq["\$_"] if /\\s/;
}
}
else {
for (\@arr) {
s/(['\\\\])/\\\\\$1/g;
\$_ = "'\$_'";
}
}
push \@arr, '2>&1' if \$Shell::capture_stderr;
open(SUBPROC, join(' ', '$cmd', \@arr, '|'))
or die "Can't exec $cmd: \$!\\n";
if (wantarray) {
my \@ret = <SUBPROC>;
close SUBPROC; # XXX Oughta use a destructor.
\@ret;
}
else {
local(\$/) = undef;
my \$ret = <SUBPROC>;
close SUBPROC;
\$ret;
}
}
}
*END*
die "$@\n" if $@;
goto &$AUTOLOAD;
}
1;
__END__
=head1 NAME
Shell - run shell commands transparently within perl
=head1 SYNOPSIS
See below.
=head1 DESCRIPTION
Date: Thu, 22 Sep 94 16:18:16 -0700
Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
To: perl5-porters@isu.edu
From: Larry Wall <lwall@scalpel.netlabs.com>
Subject: a new module I just wrote
Here's one that'll whack your mind a little out.
#!/usr/bin/perl
use Shell;
$foo = echo("howdy", "<funny>", "world");
print $foo;
$passwd = cat("</etc/passwd");
print $passwd;
sub ps;
print ps -ww;
cp("/etc/passwd", "/tmp/passwd");
That's maybe too gonzo. It actually exports an AUTOLOAD to the current
package (and uncovered a bug in Beta 3, by the way). Maybe the usual
usage should be
use Shell qw(echo cat ps cp);
Larry
If you set $Shell::capture_stderr to 1, the module will attempt to
capture the STDERR of the process as well.
The module now should work on Win32.
Jenda
=head1 AUTHOR
Larry Wall
Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
=cut
|
