Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

126 lines
2.1 KiB

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