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