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