Commit | Line | Data |
a0d0e21e |
1 | package Shell; |
2 | |
4633a7c4 |
3 | use Config; |
4 | |
a0d0e21e |
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 { |
2b2e613f |
24 | *$AUTOLOAD = sub { |
4633a7c4 |
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 | } |
a0d0e21e |
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; |
a5f75d66 |
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 |