home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / Shell.pm < prev    next >
Text File  |  1997-11-25  |  2KB  |  127 lines
  1. package Shell;
  2.  
  3. use Config;
  4.  
  5. sub import {
  6.     my $self = shift;
  7.     my ($callpack, $callfile, $callline) = caller;
  8.     my @EXPORT;
  9.     if (@_) {
  10.     @EXPORT = @_;
  11.     }
  12.     else {
  13.     @EXPORT = 'AUTOLOAD';
  14.     }
  15.     foreach $sym (@EXPORT) {
  16.         *{"${callpack}::$sym"} = \&{"Shell::$sym"};
  17.     }
  18. };
  19.  
  20. AUTOLOAD {
  21.     my $cmd = $AUTOLOAD;
  22.     $cmd =~ s/^.*:://;
  23.     eval qq {
  24.     *$AUTOLOAD = sub {
  25.         if (\@_ < 1) {
  26.         `$cmd`;
  27.         }
  28.         elsif (\$Config{'archname'} eq 'os2') {
  29.         local(\*SAVEOUT, \*READ, \*WRITE);
  30.  
  31.         open SAVEOUT, '>&STDOUT' or die;
  32.         pipe READ, WRITE or die;
  33.         open STDOUT, '>&WRITE' or die;
  34.         close WRITE;
  35.  
  36.         my \$pid = system(1, \$cmd, \@_);
  37.         die "Can't execute $cmd: \$!\n" if \$pid < 0;
  38.  
  39.         open STDOUT, '>&SAVEOUT' or die;
  40.         close SAVEOUT;
  41.  
  42.         if (wantarray) {
  43.             my \@ret = <READ>;
  44.             close READ;
  45.             waitpid \$pid, 0;
  46.             \@ret;
  47.         }
  48.         else {
  49.             local(\$/) = undef;
  50.             my \$ret = <READ>;
  51.             close READ;
  52.             waitpid \$pid, 0;
  53.             \$ret;
  54.         }
  55.         }
  56.         else {
  57.         open(SUBPROC, "-|")
  58.             or exec '$cmd', \@_
  59.             or die "Can't exec $cmd: \$!\n";
  60.         if (wantarray) {
  61.             my \@ret = <SUBPROC>;
  62.             close SUBPROC;    # XXX Oughta use a destructor.
  63.             \@ret;
  64.         }
  65.         else {
  66.             local(\$/) = undef;
  67.             my \$ret = <SUBPROC>;
  68.             close SUBPROC;
  69.             \$ret;
  70.         }
  71.         }
  72.     }
  73.     };
  74.     goto &$AUTOLOAD;
  75. }
  76.  
  77. 1;
  78. __END__
  79.  
  80. =head1 NAME
  81.  
  82. Shell - run shell commands transparently within perl
  83.  
  84. =head1 SYNOPSIS
  85.  
  86. See below.
  87.  
  88. =head1 DESCRIPTION
  89.  
  90.   Date: Thu, 22 Sep 94 16:18:16 -0700
  91.   Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
  92.   To: perl5-porters@isu.edu
  93.   From: Larry Wall <lwall@scalpel.netlabs.com>
  94.   Subject: a new module I just wrote
  95.  
  96. Here's one that'll whack your mind a little out.
  97.  
  98.     #!/usr/bin/perl
  99.  
  100.     use Shell;
  101.  
  102.     $foo = echo("howdy", "<funny>", "world");
  103.     print $foo;
  104.  
  105.     $passwd = cat("</etc/passwd");
  106.     print $passwd;
  107.  
  108.     sub ps;
  109.     print ps -ww;
  110.  
  111.     cp("/etc/passwd", "/tmp/passwd");
  112.  
  113. That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
  114. package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
  115. usage should be
  116.  
  117.     use Shell qw(echo cat ps cp);
  118.  
  119. Larry
  120.  
  121.  
  122. =head1 AUTHOR
  123.  
  124. Larry Wall
  125.  
  126. =cut
  127.