lib/Shell.pm

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