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.5';
   8
   9 sub new { bless \my $foo, shift }
  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             shift if ref \$_[0] && \$_[0]->isa( 'Shell' );
  34             if (\@_ < 1) {
  35                 \$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
  36             } elsif ('$^O' eq 'os2') {
  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
  44                 my \$pid = system(1, '$cmd', \@_);
  45                 die "Can't execute $cmd: \$!\\n" if \$pid < 0;
  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;
  55                 } else {
  56                     local(\$/) = undef;
  57                     my \$ret = <READ>;
  58                     close READ;
  59                     waitpid \$pid, 0;
  60                     \$ret;
  61                 }
  62             } else {
  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;
  79                         \$_ = qq["\$_"] if /\\s/;
  80                     }
  81                 } else {
  82                     for (\@arr) {
  83                         s/(['\\\\])/\\\\\$1/g;
  84                         \$_ = \$_;
  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";
  90                 if (wantarray) {
  91                     my \@ret = <SUBPROC>;
  92                     close SUBPROC;      # XXX Oughta use a destructor.
  93                     \@ret;
  94                 } else {
  95                     local(\$/) = undef;
  96                     my \$ret = <SUBPROC>;
  97                     close SUBPROC;
  98                     \$ret;
  99                 }
 100             }
 101         }
 102 *END*
 103
 104     die "$@\n" if $@;
 105     goto &$AUTOLOAD;
 106 }
 107
 108 1;
 109
 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
 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
 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
 194 =head1 AUTHOR
 195
 196 Larry Wall
 197
 198 Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
 199
 200 Changes and bug fixes by Casey West <casey@geeknest.com>
 201
 202 =cut