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