home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / lib / Shell.pm < prev    next >
Text File  |  1995-05-22  |  2KB  |  86 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.     if ($Config{'archname'} eq 'os2') {
  24.       eval qq {
  25.     sub $AUTOLOAD {
  26.       if (\@_ < 1) {
  27.         `$cmd`;
  28.       } else {
  29.         local(\*SAVEOUT, \*READ, \*WRITE);
  30.  
  31.         open SAVEOUT, '>&STDOUT' or die;
  32.         pipe READ, WRITE or die;
  33.         close STDOUT;
  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.         close STDOUT;
  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.         } else {
  50.           local(\$/) = undef;
  51.           my \$ret = <READ>;
  52.           close READ;
  53.           waitpid \$pid, 0;
  54.           \$ret;
  55.         }
  56.       }
  57.     }
  58.       }
  59.     } else {
  60.       eval qq {
  61.     sub $AUTOLOAD {
  62.       if (\@_ < 1) {
  63.         `$cmd`;
  64.       } else {
  65.         open(SUBPROC, "-|")
  66.           or exec '$cmd', \@_
  67.           or die "Can't exec $cmd: \$!\n";
  68.         if (wantarray) {
  69.           my \@ret = <SUBPROC>;
  70.           close SUBPROC;    # XXX Oughta use a destructor.
  71.         \@ret;
  72.         } else {
  73.           local(\$/) = undef;
  74.           my \$ret = <SUBPROC>;
  75.           close SUBPROC;
  76.           \$ret;
  77.         }
  78.       }
  79.     }
  80.       }
  81.     };
  82.     goto &$AUTOLOAD;
  83. }
  84.  
  85. 1;
  86.