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

package Shell;
use 5.006_001;
use strict;
use warnings;
use File::Spec::Functions;

our($capture_stderr, $raw, $VERSION, $AUTOLOAD);

$VERSION = '0.6';

sub new { bless \my $foo, shift }
sub DESTROY { }

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

sub AUTOLOAD {
    shift if ref $_[0] && $_[0]->isa( 'Shell' );
    my $cmd = $AUTOLOAD;
    $cmd =~ s/^.*:://;
    my $null = File::Spec::Functions::devnull();
    $Shell::capture_stderr ||= 0;
    eval <<"*END*";
	sub $AUTOLOAD {
	    shift if ref \$_[0] && \$_[0]->isa( 'Shell' );
	    if (\@_ < 1) {
		\$Shell::capture_stderr ==  1 ? `$cmd 2>&1` : 
		\$Shell::capture_stderr == -1 ? `$cmd 2>$null` : 
		`$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 = \@_;
		unless( \$Shell::raw ){
		  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 ==  1;
		push \@arr, '2>$null' if \$Shell::capture_stderr == -1;
		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

   use Shell qw(cat ps cp);
   $passwd = cat('</etc/passwd');
   @pslines = ps('-ww'),
   cp("/etc/passwd", "/tmp/passwd");

   # object oriented 
   my $sh = Shell->new;
   print $sh->ls('-l');

=head1 DESCRIPTION

=head2 Caveats

This package is included as a show case, illustrating a few Perl features.
It shouldn't be used for production programs. Although it does provide a 
simple interface for obtaining the standard output of arbitrary commands,
there may be better ways of achieving what you need.

Running shell commands while obtaining standard output can be done with the
C<qx/STRING/> operator, or by calling C<open> with a filename expression that
ends with C<|>, giving you the option to process one line at a time.
If you don't need to process standard output at all, you might use C<system>
(in preference of doing a print with the collected standard output).

Since Shell.pm and all of the aforementioned techniques use your system's
shell to call some local command, none of them is portable across different 
systems. Note, however, that there are several built in functions and 
library packages providing portable implementations of functions operating
on files, such as: C<glob>, C<link> and C<unlink>, C<mkdir> and C<rmdir>, 
C<rename>, C<File::Compare>, C<File::Copy>, C<File::Find> etc.

Using Shell.pm while importing C<foo> creates a subroutine C<foo> in the
namespace of the importing package. Calling C<foo> with arguments C<arg1>,
C<arg2>,... results in a shell command C<foo arg1 arg2...>, where the 
function name and the arguments are joined with a blank. (See the subsection 
on Escaping magic characters.) Since the result is essentially a command
line to be passed to the shell, your notion of arguments to the Perl
function is not necessarily identical to what the shell treats as a
command line token, to be passed as an individual argument to the program.
Furthermore, note that this implies that C<foo> is callable by file name
only, which frequently depends on the setting of the program's environment.

Creating a Shell object gives you the opportunity to call any command
in the usual OO notation without requiring you to announce it in the
C<use Shell> statement. Don't assume any additional semantics being
associated with a Shell object: in no way is it similar to a shell
process with its environment or current working directory or any
other setting.

=head2 Escaping Magic Characters

It is, in general, impossible to take care of quoting the shell's
magic characters. For some obscure reason, however, Shell.pm quotes
apostrophes (C<'>) and backslashes (C<\>) on UNIX, and spaces and
quotes (C<">) on Windows.

=head2 Configuration

If you set $Shell::capture_stderr to true, the module will attempt to
capture the standard error output of the process as well. This is
done by adding C<2E<gt>&1> to the command line, so don't try this on
a system not supporting this redirection.

If you set $Shell::raw to true no quoting whatsoever is done.

=head1 BUGS

Quoting should be off by default.

It isn't possible to call shell built in commands, but it can be
done by using a workaround, e.g. shell( '-c', 'set' ).

Capturing standard error does not work on some systems (e.g. VMS).

=head1 AUTHOR

  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", "/etc/passwd.orig");

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 Wall

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

Changes for OO syntax and bug fixes by Casey West <casey@geeknest.com>.

C<$Shell::raw> and pod rewrite by Wolfgang Laun.

=cut
Commit	Line	Data
a0d0e21e	1	package Shell;
3b825e41	2	use 5.006_001;
8d5b6de5	3	use strict;
8d5b6de5	4	use warnings;
d0b4fbd9	5	use File::Spec::Functions;
d0b4fbd9	6
96412ebc	7	our($capture_stderr, $raw, $VERSION, $AUTOLOAD);
a0d0e21e	8
96412ebc	9	$VERSION = '0.6';
8d5b6de5	10
605870ff	11	sub new { bless \my $foo, shift }
8d5b6de5	12	sub DESTROY { }
4633a7c4	13
a0d0e21e	14	sub import {
	15	my $self = shift;
	16	my ($callpack, $callfile, $callline) = caller;
	17	my @EXPORT;
	18	if (@_) {
	19	@EXPORT = @_;
8d5b6de5	20	} else {
a0d0e21e	21	@EXPORT = 'AUTOLOAD';
a0d0e21e	22	}
8d5b6de5	23	foreach my $sym (@EXPORT) {
8d5b6de5	24	no strict 'refs';
a0d0e21e	25	*{"${callpack}::$sym"} = \&{"Shell::$sym"};
a0d0e21e	26	}
8d5b6de5	27	}
a0d0e21e	28
8d5b6de5	29	sub AUTOLOAD {
8d5b6de5	30	shift if ref $_[0] && $_[0]->isa( 'Shell' );
a0d0e21e	31	my $cmd = $AUTOLOAD;
a0d0e21e	32	$cmd =~ s/^.*:://;
d0b4fbd9	33	my $null = File::Spec::Functions::devnull();
c4a2e7a5	34	$Shell::capture_stderr \|\|= 0;
253924a2	35	eval <<"END";
253924a2	36	sub $AUTOLOAD {
51947a20	37	shift if ref \$_[0] && \$_[0]->isa( 'Shell' );
4633a7c4	38	if (\@_ < 1) {
c4a2e7a5	39	\$Shell::capture_stderr == 1 ? `$cmd 2>&1` :
d0b4fbd9	40	\$Shell::capture_stderr == -1 ? `$cmd 2>$null` :
c4a2e7a5	41	`$cmd`;
8d5b6de5	42	} elsif ('$^O' eq 'os2') {
4633a7c4	43	local(\SAVEOUT, \READ, \*WRITE);
	44
	45	open SAVEOUT, '>&STDOUT' or die;
	46	pipe READ, WRITE or die;
	47	open STDOUT, '>&WRITE' or die;
	48	close WRITE;
	49
253924a2	50	my \$pid = system(1, '$cmd', \@_);
253924a2	51	die "Can't execute $cmd: \$!\\n" if \$pid < 0;
4633a7c4	52
	53	open STDOUT, '>&SAVEOUT' or die;
	54	close SAVEOUT;
	55
	56	if (wantarray) {
	57	my \@ret = <READ>;
	58	close READ;
	59	waitpid \$pid, 0;
	60	\@ret;
8d5b6de5	61	} else {
4633a7c4	62	local(\$/) = undef;
	63	my \$ret = <READ>;
	64	close READ;
	65	waitpid \$pid, 0;
	66	\$ret;
	67	}
8d5b6de5	68	} else {
253924a2	69	my \$a;
253924a2	70	my \@arr = \@_;
96412ebc	71	unless( \$Shell::raw ){
96412ebc	72	if ('$^O' eq 'MSWin32') {
253924a2	73	# XXX this special-casing should not be needed
	74	# if we do quoting right on Windows. :-(
	75	#
	76	# First, escape all quotes. Cover the case where we
	77	# want to pass along a quote preceded by a backslash
	78	# (i.e., C<"param \\""" end">).
	79	# Ugly, yup? You know, windoze.
	80	# Enclose in quotes only the parameters that need it:
	81	# try this: c:\> dir "/w"
	82	# and this: c:\> dir /w
	83	for (\@arr) {
	84	s/"/\\\\"/g;
	85	s/\\\\\\\\"/\\\\\\\\"""/g;
6570f784	86	\$_ = qq["\$_"] if /\\s/;
253924a2	87	}
96412ebc	88	} else {
253924a2	89	for (\@arr) {
253924a2	90	s/(['\\\\])/\\\\\$1/g;
8d5b6de5	91	\$_ = \$_;
96412ebc	92	}
96412ebc	93	}
253924a2	94	}
c4a2e7a5	95	push \@arr, '2>&1' if \$Shell::capture_stderr == 1;
d0b4fbd9	96	push \@arr, '2>$null' if \$Shell::capture_stderr == -1;
253924a2	97	open(SUBPROC, join(' ', '$cmd', \@arr, '\|'))
253924a2	98	or die "Can't exec $cmd: \$!\\n";
a0d0e21e	99	if (wantarray) {
	100	my \@ret = <SUBPROC>;
	101	close SUBPROC; # XXX Oughta use a destructor.
	102	\@ret;
8d5b6de5	103	} else {
a0d0e21e	104	local(\$/) = undef;
	105	my \$ret = <SUBPROC>;
	106	close SUBPROC;
	107	\$ret;
	108	}
	109	}
	110	}
253924a2	111	END
	112
	113	die "$@\n" if $@;
a0d0e21e	114	goto &$AUTOLOAD;
	115	}
	116
	117	1;
8d5b6de5	118
a5f75d66	119	__END__
	120
	121	=head1 NAME
	122
	123	Shell - run shell commands transparently within perl
	124
	125	=head1 SYNOPSIS
	126
96412ebc	127	use Shell qw(cat ps cp);
	128	$passwd = cat('</etc/passwd');
	129	@pslines = ps('-ww'),
	130	cp("/etc/passwd", "/tmp/passwd");
	131
	132	# object oriented
	133	my $sh = Shell->new;
	134	print $sh->ls('-l');
a5f75d66	135
	136	=head1 DESCRIPTION
	137
96412ebc	138	=head2 Caveats
	139
	140	This package is included as a show case, illustrating a few Perl features.
	141	It shouldn't be used for production programs. Although it does provide a
	142	simple interface for obtaining the standard output of arbitrary commands,
	143	there may be better ways of achieving what you need.
	144
	145	Running shell commands while obtaining standard output can be done with the
	146	C<qx/STRING/> operator, or by calling C<open> with a filename expression that
	147	ends with C<\|>, giving you the option to process one line at a time.
	148	If you don't need to process standard output at all, you might use C<system>
	149	(in preference of doing a print with the collected standard output).
	150
	151	Since Shell.pm and all of the aforementioned techniques use your system's
	152	shell to call some local command, none of them is portable across different
	153	systems. Note, however, that there are several built in functions and
	154	library packages providing portable implementations of functions operating
	155	on files, such as: C<glob>, C<link> and C<unlink>, C<mkdir> and C<rmdir>,
	156	C<rename>, C<File::Compare>, C<File::Copy>, C<File::Find> etc.
	157
	158	Using Shell.pm while importing C<foo> creates a subroutine C<foo> in the
	159	namespace of the importing package. Calling C<foo> with arguments C<arg1>,
	160	C<arg2>,... results in a shell command C<foo arg1 arg2...>, where the
	161	function name and the arguments are joined with a blank. (See the subsection
	162	on Escaping magic characters.) Since the result is essentially a command
	163	line to be passed to the shell, your notion of arguments to the Perl
	164	function is not necessarily identical to what the shell treats as a
	165	command line token, to be passed as an individual argument to the program.
	166	Furthermore, note that this implies that C<foo> is callable by file name
	167	only, which frequently depends on the setting of the program's environment.
	168
	169	Creating a Shell object gives you the opportunity to call any command
	170	in the usual OO notation without requiring you to announce it in the
	171	C<use Shell> statement. Don't assume any additional semantics being
	172	associated with a Shell object: in no way is it similar to a shell
	173	process with its environment or current working directory or any
	174	other setting.
	175
	176	=head2 Escaping Magic Characters
	177
	178	It is, in general, impossible to take care of quoting the shell's
	179	magic characters. For some obscure reason, however, Shell.pm quotes
	180	apostrophes (C<'>) and backslashes (C<\>) on UNIX, and spaces and
	181	quotes (C<">) on Windows.
	182
	183	=head2 Configuration
	184
	185	If you set $Shell::capture_stderr to true, the module will attempt to
	186	capture the standard error output of the process as well. This is
	187	done by adding C<2E<gt>&1> to the command line, so don't try this on
	188	a system not supporting this redirection.
	189
	190	If you set $Shell::raw to true no quoting whatsoever is done.
	191
	192	=head1 BUGS
	193
	194	Quoting should be off by default.
	195
	196	It isn't possible to call shell built in commands, but it can be
	197	done by using a workaround, e.g. shell( '-c', 'set' ).
	198
	199	Capturing standard error does not work on some systems (e.g. VMS).
	200
	201	=head1 AUTHOR
202
a5f75d66	203	Date: Thu, 22 Sep 94 16:18:16 -0700
	204	Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
	205	To: perl5-porters@isu.edu
	206	From: Larry Wall <lwall@scalpel.netlabs.com>
	207	Subject: a new module I just wrote
	208
	209	Here's one that'll whack your mind a little out.
	210
	211	#!/usr/bin/perl
	212
	213	use Shell;
	214
	215	$foo = echo("howdy", "<funny>", "world");
	216	print $foo;
	217
	218	$passwd = cat("</etc/passwd");
	219	print $passwd;
	220
	221	sub ps;
	222	print ps -ww;
	223
2359510d	224	cp("/etc/passwd", "/etc/passwd.orig");
a5f75d66	225
	226	That's maybe too gonzo. It actually exports an AUTOLOAD to the current
	227	package (and uncovered a bug in Beta 3, by the way). Maybe the usual
	228	usage should be
	229
	230	use Shell qw(echo cat ps cp);
	231
a5f75d66	232	Larry Wall
a5f75d66	233
96412ebc	234	Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>.
	235
	236	Changes for OO syntax and bug fixes by Casey West <casey@geeknest.com>.
253924a2	237
96412ebc	238	C<$Shell::raw> and pod rewrite by Wolfgang Laun.
8d5b6de5	239
a5f75d66	240	=cut