Merge branch 'master' of http://repo.or.cz/r/msysgit into devel
[msysgit/historical-msysgit.git] / lib / perl5 / 5.6.1 / Shell.pm
blobc2f522cae309363daeac532639022f40f59c10ad
1 package Shell;
2 use 5.005_64;
3 use strict;
4 use warnings;
5 our($capture_stderr, $VERSION, $AUTOLOAD);
7 $VERSION = '0.3';
9 sub new { bless \$VERSION, shift } # Nothing better to bless
10 sub DESTROY { }
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';
21 foreach my $sym (@EXPORT) {
22 no strict 'refs';
23 *{"${callpack}::$sym"} = \&{"Shell::$sym"};
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);
38 open SAVEOUT, '>&STDOUT' or die;
39 pipe READ, WRITE or die;
40 open STDOUT, '>&WRITE' or die;
41 close WRITE;
43 my \$pid = system(1, '$cmd', \@_);
44 die "Can't execute $cmd: \$!\\n" if \$pid < 0;
46 open STDOUT, '>&SAVEOUT' or die;
47 close SAVEOUT;
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;
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. :-(
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/;
80 } else {
81 for (\@arr) {
82 s/(['\\\\])/\\\\\$1/g;
83 \$_ = \$_;
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;
101 *END*
103 die "$@\n" if $@;
104 goto &$AUTOLOAD;
109 __END__
111 =head1 NAME
113 Shell - run shell commands transparently within perl
115 =head1 SYNOPSIS
117 See below.
119 =head1 DESCRIPTION
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
127 Here's one that'll whack your mind a little out.
129 #!/usr/bin/perl
131 use Shell;
133 $foo = echo("howdy", "<funny>", "world");
134 print $foo;
136 $passwd = cat("</etc/passwd");
137 print $passwd;
139 sub ps;
140 print ps -ww;
142 cp("/etc/passwd", "/tmp/passwd");
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
148 use Shell qw(echo cat ps cp);
150 Larry
153 If you set $Shell::capture_stderr to 1, the module will attempt to
154 capture the STDERR of the process as well.
156 The module now should work on Win32.
158 Jenda
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:
163 cat('</etc/passwd');
164 ls('*.pl');
166 really turned into:
168 cat '</etc/passwd'
169 ls '*.pl'
171 instead of:
173 cat </etc/passwd
174 ls *.pl
176 and of course, this is wrong.
178 I have fixed this bug, it was brought up by Wolfgang Laun [ID 20000326.008]
180 Casey
182 =head2 OBJECT ORIENTED SYNTAX
184 Shell now has an OO interface. Good for namespace conservation
185 and shell representation.
187 use Shell;
188 my $sh = Shell->new;
189 print $sh->ls;
191 Casey
193 =head1 AUTHOR
195 Larry Wall
197 Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
199 Changes and bug fixes by Casey Tweten <crt@kiski.net>
201 =cut