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