[Summary view] [Print] [Text view]

   1  package Shell;
   2  use 5.006_001;
   3  use strict;
   4  use warnings;
   5  use File::Spec::Functions;
   6  
   7  our($capture_stderr, $raw, $VERSION, $AUTOLOAD);
   8  
   9  $VERSION = '0.72_01';
  10  $VERSION = eval $VERSION;
  11  
  12  sub new { bless \my $foo, shift }
  13  sub DESTROY { }
  14  
  15  sub import {
  16      my $self = shift;
  17      my ($callpack, $callfile, $callline) = caller;
  18      my @EXPORT;
  19      if (@_) {
  20          @EXPORT = @_;
  21      } else {
  22          @EXPORT = 'AUTOLOAD';
  23      }
  24      foreach my $sym (@EXPORT) {
  25          no strict 'refs';
  26          *{"$callpack}::$sym"} = \&{"Shell::$sym"};
  27      }
  28  }
  29  
  30  # NOTE: this is used to enable constant folding in 
  31  # expressions like (OS eq 'MSWin32') and 
  32  # (OS eq 'os2') just like it happened in  0.6  version 
  33  # which used eval "string" to install subs on the fly.
  34  use constant OS => $^O;
  35  
  36  =begin private
  37  
  38  =item B<_make_cmd>
  39  
  40    $sub = _make_cmd($cmd);
  41    $sub = $shell->_make_cmd($cmd);
  42  
  43  Creates a closure which invokes the system command C<$cmd>.
  44  
  45  =end private
  46  
  47  =cut
  48  
  49  sub _make_cmd {
  50      shift if ref $_[0] && $_[0]->isa( 'Shell' );
  51      my $cmd = shift;
  52      my $null = File::Spec::Functions::devnull();
  53      $Shell::capture_stderr ||= 0;
  54      # closing over $^O, $cmd, and $null
  55      return sub {
  56              shift if ref $_[0] && $_[0]->isa( 'Shell' );
  57              if (@_ < 1) {
  58                  $Shell::capture_stderr ==  1 ? `$cmd 2>&1` : 
  59                  $Shell::capture_stderr == -1 ? `$cmd 2>$null` : 
  60                  `$cmd`;
  61              } elsif (OS eq 'os2') {
  62                  local(*SAVEOUT, *READ, *WRITE);
  63  
  64                  open SAVEOUT, '>&STDOUT' or die;
  65                  pipe READ, WRITE or die;
  66                  open STDOUT, '>&WRITE' or die;
  67                  close WRITE;
  68  
  69                  my $pid = system(1, $cmd, @_);
  70                  die "Can't execute $cmd: $!\n" if $pid < 0;
  71  
  72                  open STDOUT, '>&SAVEOUT' or die;
  73                  close SAVEOUT;
  74  
  75                  if (wantarray) {
  76                      my @ret = <READ>;
  77                      close READ;
  78                      waitpid $pid, 0;
  79                      @ret;
  80                  } else {
  81                      local($/) = undef;
  82                      my $ret = <READ>;
  83                      close READ;
  84                      waitpid $pid, 0;
  85                      $ret;
  86                  }
  87              } else {
  88                  my $a;
  89                  my @arr = @_;
  90                  unless( $Shell::raw ){
  91                    if (OS eq 'MSWin32') {
  92                      # XXX this special-casing should not be needed
  93                      # if we do quoting right on Windows. :-(
  94                      #
  95                      # First, escape all quotes.  Cover the case where we
  96                      # want to pass along a quote preceded by a backslash
  97                      # (i.e., C<"param \""" end">).
  98                      # Ugly, yup?  You know, windoze.
  99                      # Enclose in quotes only the parameters that need it:
 100                      #   try this: c:> dir "/w"
 101                      #   and this: c:> dir /w
 102                      for (@arr) {
 103                          s/"/\\"/g;
 104                          s/\\\\"/\\\\"""/g;
 105                          $_ = qq["$_"] if /\s/;
 106                      }
 107                    } else {
 108                      for (@arr) {
 109                          s/(['\\])/\\$1/g;
 110                          $_ = $_;
 111                       }
 112                    }
 113                  }
 114                  push @arr, '2>&1'        if $Shell::capture_stderr ==  1;
 115                  push @arr, '2>$null' if $Shell::capture_stderr == -1;
 116                  open(SUBPROC, join(' ', $cmd, @arr, '|'))
 117                      or die "Can't exec $cmd: $!\n";
 118                  if (wantarray) {
 119                      my @ret = <SUBPROC>;
 120                      close SUBPROC;        # XXX Oughta use a destructor.
 121                      @ret;
 122                  } else {
 123                      local($/) = undef;
 124                      my $ret = <SUBPROC>;
 125                      close SUBPROC;
 126                      $ret;
 127                  }
 128              }
 129          };
 130          }
 131  
 132  sub AUTOLOAD {
 133      shift if ref $_[0] && $_[0]->isa( 'Shell' );
 134      my $cmd = $AUTOLOAD;
 135      $cmd =~ s/^.*:://;
 136      no strict 'refs';
 137      *$AUTOLOAD = _make_cmd($cmd);
 138      goto &$AUTOLOAD;
 139  }
 140  
 141  1;
 142  
 143  __END__
 144  
 145  =head1 NAME
 146  
 147  Shell - run shell commands transparently within perl
 148  
 149  =head1 SYNOPSIS
 150  
 151     use Shell qw(cat ps cp);
 152     $passwd = cat('</etc/passwd');
 153     @pslines = ps('-ww'),
 154     cp("/etc/passwd", "/tmp/passwd");
 155  
 156     # object oriented 
 157     my $sh = Shell->new;
 158     print $sh->ls('-l');
 159  
 160  =head1 DESCRIPTION
 161  
 162  =head2 Caveats
 163  
 164  This package is included as a show case, illustrating a few Perl features.
 165  It shouldn't be used for production programs. Although it does provide a 
 166  simple interface for obtaining the standard output of arbitrary commands,
 167  there may be better ways of achieving what you need.
 168  
 169  Running shell commands while obtaining standard output can be done with the
 170  C<qx/STRING/> operator, or by calling C<open> with a filename expression that
 171  ends with C<|>, giving you the option to process one line at a time.
 172  If you don't need to process standard output at all, you might use C<system>
 173  (in preference of doing a print with the collected standard output).
 174  
 175  Since Shell.pm and all of the aforementioned techniques use your system's
 176  shell to call some local command, none of them is portable across different 
 177  systems. Note, however, that there are several built in functions and 
 178  library packages providing portable implementations of functions operating
 179  on files, such as: C<glob>, C<link> and C<unlink>, C<mkdir> and C<rmdir>, 
 180  C<rename>, C<File::Compare>, C<File::Copy>, C<File::Find> etc.
 181  
 182  Using Shell.pm while importing C<foo> creates a subroutine C<foo> in the
 183  namespace of the importing package. Calling C<foo> with arguments C<arg1>,
 184  C<arg2>,... results in a shell command C<foo arg1 arg2...>, where the 
 185  function name and the arguments are joined with a blank. (See the subsection 
 186  on Escaping magic characters.) Since the result is essentially a command
 187  line to be passed to the shell, your notion of arguments to the Perl
 188  function is not necessarily identical to what the shell treats as a
 189  command line token, to be passed as an individual argument to the program.
 190  Furthermore, note that this implies that C<foo> is callable by file name
 191  only, which frequently depends on the setting of the program's environment.
 192  
 193  Creating a Shell object gives you the opportunity to call any command
 194  in the usual OO notation without requiring you to announce it in the
 195  C<use Shell> statement. Don't assume any additional semantics being
 196  associated with a Shell object: in no way is it similar to a shell
 197  process with its environment or current working directory or any
 198  other setting.
 199  
 200  =head2 Escaping Magic Characters
 201  
 202  It is, in general, impossible to take care of quoting the shell's
 203  magic characters. For some obscure reason, however, Shell.pm quotes
 204  apostrophes (C<'>) and backslashes (C<\>) on UNIX, and spaces and
 205  quotes (C<">) on Windows.
 206  
 207  =head2 Configuration
 208  
 209  If you set $Shell::capture_stderr to 1, the module will attempt to
 210  capture the standard error output of the process as well. This is
 211  done by adding C<2E<gt>&1> to the command line, so don't try this on
 212  a system not supporting this redirection.
 213  
 214  Setting $Shell::capture_stderr to -1 will send standard error to the
 215  bit bucket (i.e., the equivalent of adding C<2E<gt>/dev/null> to the
 216  command line).  The same caveat regarding redirection applies.
 217  
 218  If you set $Shell::raw to true no quoting whatsoever is done.
 219  
 220  =head1 BUGS
 221  
 222  Quoting should be off by default.
 223  
 224  It isn't possible to call shell built in commands, but it can be
 225  done by using a workaround, e.g. shell( '-c', 'set' ).
 226  
 227  Capturing standard error does not work on some systems (e.g. VMS).
 228  
 229  =head1 AUTHOR
 230  
 231    Date: Thu, 22 Sep 94 16:18:16 -0700
 232    Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
 233    To: perl5-porters@isu.edu
 234    From: Larry Wall <lwall@scalpel.netlabs.com>
 235    Subject: a new module I just wrote
 236  
 237  Here's one that'll whack your mind a little out.
 238  
 239      #!/usr/bin/perl
 240  
 241      use Shell;
 242  
 243      $foo = echo("howdy", "<funny>", "world");
 244      print $foo;
 245  
 246      $passwd = cat("</etc/passwd");
 247      print $passwd;
 248  
 249      sub ps;
 250      print ps -ww;
 251  
 252      cp("/etc/passwd", "/etc/passwd.orig");
 253  
 254  That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
 255  package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
 256  usage should be
 257  
 258      use Shell qw(echo cat ps cp);
 259  
 260  Larry Wall
 261  
 262  Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>.
 263  
 264  Changes for OO syntax and bug fixes by Casey West <casey@geeknest.com>.
 265  
 266  C<$Shell::raw> and pod rewrite by Wolfgang Laun.
 267  
 268  Rewritten to use closures rather than C<eval "string"> by Adriano Ferreira.
 269  
 270  =cut