[p5sagit/p5-mst-13.2.git] / lib / Shell.pm

package Shell;
use vars qw($capture_stderr $VERSION);

$VERSION = '0.2';

sub import {
    my $self = shift;
    my ($callpack, $callfile, $callline) = caller;
    my @EXPORT;
    if (@_) {
	@EXPORT = @_;
    }
    else {
	@EXPORT = 'AUTOLOAD';
    }
    foreach $sym (@EXPORT) {
        *{"${callpack}::$sym"} = \&{"Shell::$sym"};
    }
};

AUTOLOAD {
    my $cmd = $AUTOLOAD;
    $cmd =~ s/^.*:://;
    eval <<"*END*";
	sub $AUTOLOAD {
	    if (\@_ < 1) {
		\$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
	    }
	    elsif ('$^O' eq 'os2') {
		local(\*SAVEOUT, \*READ, \*WRITE);

		open SAVEOUT, '>&STDOUT' or die;
		pipe READ, WRITE or die;
		open STDOUT, '>&WRITE' or die;
		close WRITE;

		my \$pid = system(1, '$cmd', \@_);
		die "Can't execute $cmd: \$!\\n" if \$pid < 0;

		open STDOUT, '>&SAVEOUT' or die;
		close SAVEOUT;

		if (wantarray) {
		    my \@ret = <READ>;
		    close READ;
		    waitpid \$pid, 0;
		    \@ret;
		}
		else {
		    local(\$/) = undef;
		    my \$ret = <READ>;
		    close READ;
		    waitpid \$pid, 0;
		    \$ret;
		}
	    }
	    else {
		my \$a;
		my \@arr = \@_;
		if ('$^O' eq 'MSWin32') {
		    # XXX this special-casing should not be needed
		    # if we do quoting right on Windows. :-(
		    #
		    # First, escape all quotes.  Cover the case where we
		    # want to pass along a quote preceded by a backslash
		    # (i.e., C<"param \\""" end">).
		    # Ugly, yup?  You know, windoze.
		    # Enclose in quotes only the parameters that need it:
		    #   try this: c:\> dir "/w"
		    #   and this: c:\> dir /w
		    for (\@arr) {
			s/"/\\\\"/g;
			s/\\\\\\\\"/\\\\\\\\"""/g;
			\$_ = qq["\$_"] if /\s/;
		    }
		}
		else {
		    for (\@arr) {
			s/(['\\\\])/\\\\\$1/g;
			\$_ = "'\$_'";
		    }
		}
		push \@arr, '2>&1' if \$Shell::capture_stderr;
		open(SUBPROC, join(' ', '$cmd', \@arr, '|'))
		    or die "Can't exec $cmd: \$!\\n";
		if (wantarray) {
		    my \@ret = <SUBPROC>;
		    close SUBPROC;	# XXX Oughta use a destructor.
		    \@ret;
		}
		else {
		    local(\$/) = undef;
		    my \$ret = <SUBPROC>;
		    close SUBPROC;
		    \$ret;
		}
	    }
	}
*END*

    die "$@\n" if $@;
    goto &$AUTOLOAD;
}

1;
__END__

=head1 NAME

Shell - run shell commands transparently within perl

=head1 SYNOPSIS

See below.

=head1 DESCRIPTION

  Date: Thu, 22 Sep 94 16:18:16 -0700
  Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
  To: perl5-porters@isu.edu
  From: Larry Wall <lwall@scalpel.netlabs.com>
  Subject: a new module I just wrote

Here's one that'll whack your mind a little out.

    #!/usr/bin/perl

    use Shell;

    $foo = echo("howdy", "<funny>", "world");
    print $foo;

    $passwd = cat("</etc/passwd");
    print $passwd;

    sub ps;
    print ps -ww;

    cp("/etc/passwd", "/tmp/passwd");

That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
usage should be

    use Shell qw(echo cat ps cp);

Larry


If you set $Shell::capture_stderr to 1, the module will attempt to
capture the STDERR of the process as well.

The module now should work on Win32.

 Jenda

=head1 AUTHOR

Larry Wall

Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>

=cut
Commit	Line	Data
a0d0e21e	1	package Shell;
253924a2	2	use vars qw($capture_stderr $VERSION);
a0d0e21e	3
253924a2	4	$VERSION = '0.2';
4633a7c4	5
a0d0e21e	6	sub import {
	7	my $self = shift;
	8	my ($callpack, $callfile, $callline) = caller;
	9	my @EXPORT;
	10	if (@_) {
	11	@EXPORT = @_;
	12	}
	13	else {
	14	@EXPORT = 'AUTOLOAD';
	15	}
	16	foreach $sym (@EXPORT) {
	17	*{"${callpack}::$sym"} = \&{"Shell::$sym"};
	18	}
	19	};
	20
	21	AUTOLOAD {
	22	my $cmd = $AUTOLOAD;
	23	$cmd =~ s/^.*:://;
253924a2	24	eval <<"END";
253924a2	25	sub $AUTOLOAD {
4633a7c4	26	if (\@_ < 1) {
253924a2	27	\$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
4633a7c4	28	}
253924a2	29	elsif ('$^O' eq 'os2') {
4633a7c4	30	local(\SAVEOUT, \READ, \*WRITE);
	31
	32	open SAVEOUT, '>&STDOUT' or die;
	33	pipe READ, WRITE or die;
	34	open STDOUT, '>&WRITE' or die;
	35	close WRITE;
	36
253924a2	37	my \$pid = system(1, '$cmd', \@_);
253924a2	38	die "Can't execute $cmd: \$!\\n" if \$pid < 0;
4633a7c4	39
	40	open STDOUT, '>&SAVEOUT' or die;
	41	close SAVEOUT;
	42
	43	if (wantarray) {
	44	my \@ret = <READ>;
	45	close READ;
	46	waitpid \$pid, 0;
	47	\@ret;
	48	}
	49	else {
	50	local(\$/) = undef;
	51	my \$ret = <READ>;
	52	close READ;
	53	waitpid \$pid, 0;
	54	\$ret;
	55	}
a0d0e21e	56	}
a0d0e21e	57	else {
253924a2	58	my \$a;
	59	my \@arr = \@_;
	60	if ('$^O' eq 'MSWin32') {
	61	# XXX this special-casing should not be needed
	62	# if we do quoting right on Windows. :-(
	63	#
	64	# First, escape all quotes. Cover the case where we
	65	# want to pass along a quote preceded by a backslash
	66	# (i.e., C<"param \\""" end">).
	67	# Ugly, yup? You know, windoze.
	68	# Enclose in quotes only the parameters that need it:
	69	# try this: c:\> dir "/w"
	70	# and this: c:\> dir /w
	71	for (\@arr) {
	72	s/"/\\\\"/g;
	73	s/\\\\\\\\"/\\\\\\\\"""/g;
	74	\$_ = qq["\$_"] if /\s/;
	75	}
	76	}
	77	else {
	78	for (\@arr) {
	79	s/(['\\\\])/\\\\\$1/g;
	80	\$_ = "'\$_'";
	81	}
	82	}
	83	push \@arr, '2>&1' if \$Shell::capture_stderr;
	84	open(SUBPROC, join(' ', '$cmd', \@arr, '\|'))
	85	or die "Can't exec $cmd: \$!\\n";
a0d0e21e	86	if (wantarray) {
	87	my \@ret = <SUBPROC>;
	88	close SUBPROC; # XXX Oughta use a destructor.
	89	\@ret;
	90	}
	91	else {
	92	local(\$/) = undef;
	93	my \$ret = <SUBPROC>;
	94	close SUBPROC;
	95	\$ret;
	96	}
	97	}
	98	}
253924a2	99	END
	100
	101	die "$@\n" if $@;
a0d0e21e	102	goto &$AUTOLOAD;
	103	}
	104
	105	1;
a5f75d66	106	__END__
	107
	108	=head1 NAME
	109
	110	Shell - run shell commands transparently within perl
	111
	112	=head1 SYNOPSIS
	113
	114	See below.
	115
	116	=head1 DESCRIPTION
	117
	118	Date: Thu, 22 Sep 94 16:18:16 -0700
	119	Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
	120	To: perl5-porters@isu.edu
	121	From: Larry Wall <lwall@scalpel.netlabs.com>
	122	Subject: a new module I just wrote
	123
	124	Here's one that'll whack your mind a little out.
	125
	126	#!/usr/bin/perl
	127
	128	use Shell;
	129
	130	$foo = echo("howdy", "<funny>", "world");
	131	print $foo;
	132
	133	$passwd = cat("</etc/passwd");
	134	print $passwd;
	135
	136	sub ps;
	137	print ps -ww;
	138
	139	cp("/etc/passwd", "/tmp/passwd");
	140
	141	That's maybe too gonzo. It actually exports an AUTOLOAD to the current
	142	package (and uncovered a bug in Beta 3, by the way). Maybe the usual
	143	usage should be
	144
	145	use Shell qw(echo cat ps cp);
	146
	147	Larry
	148
	149
253924a2	150	If you set $Shell::capture_stderr to 1, the module will attempt to
	151	capture the STDERR of the process as well.
	152
	153	The module now should work on Win32.
	154
	155	Jenda
	156
a5f75d66	157	=head1 AUTHOR
	158
	159	Larry Wall
	160
253924a2	161	Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>
253924a2	162
a5f75d66	163	=cut