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

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