I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / Shell.pm
1 package Shell;
2 use 5.006_001;
3 use strict;
4 use warnings;
5 our($capture_stderr, $VERSION, $AUTOLOAD);
6
7 $VERSION = '0.4';
8
9 sub new { bless \$VERSION, shift } # Nothing better to bless
10 sub DESTROY { }
11
12 sub import {
13     my $self = shift;
14     my ($callpack, $callfile, $callline) = caller;
15     my @EXPORT;
16     if (@_) {
17         @EXPORT = @_;
18     } else {
19         @EXPORT = 'AUTOLOAD';
20     }
21     foreach my $sym (@EXPORT) {
22         no strict 'refs';
23         *{"${callpack}::$sym"} = \&{"Shell::$sym"};
24     }
25 }
26
27 sub AUTOLOAD {
28     shift if ref $_[0] && $_[0]->isa( 'Shell' );
29     my $cmd = $AUTOLOAD;
30     $cmd =~ s/^.*:://;
31     eval <<"*END*";
32         sub $AUTOLOAD {
33             if (\@_ < 1) {
34                 \$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
35             } elsif ('$^O' eq 'os2') {
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
43                 my \$pid = system(1, '$cmd', \@_);
44                 die "Can't execute $cmd: \$!\\n" if \$pid < 0;
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;
54                 } else {
55                     local(\$/) = undef;
56                     my \$ret = <READ>;
57                     close READ;
58                     waitpid \$pid, 0;
59                     \$ret;
60                 }
61             } else {
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;
78                         \$_ = qq["\$_"] if /\\s/;
79                     }
80                 } else {
81                     for (\@arr) {
82                         s/(['\\\\])/\\\\\$1/g;
83                         \$_ = \$_;
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";
89                 if (wantarray) {
90                     my \@ret = <SUBPROC>;
91                     close SUBPROC;      # XXX Oughta use a destructor.
92                     \@ret;
93                 } else {
94                     local(\$/) = undef;
95                     my \$ret = <SUBPROC>;
96                     close SUBPROC;
97                     \$ret;
98                 }
99             }
100         }
101 *END*
102
103     die "$@\n" if $@;
104     goto &$AUTOLOAD;
105 }
106
107 1;
108
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
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
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
193 =head1 AUTHOR
194
195 Larry Wall
196
197 Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
198
199 Changes and bug fixes by Casey West <casey@geeknest.com>
200
201 =cut