This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
f4ef431cc54edddbf4cf6695b8d607e52a9756ad
[perl5.git] / lib / Shell.pm
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