File Coverage

blib/lib/dotsh.pl
Criterion Covered Total %
statement 3 32 9.3
branch 0 16 0.0
condition n/a
subroutine 1 2 50.0
pod n/a
total 4 50 8.0


line stmt bran cond sub pod time code
1             #
2             # @(#)dotsh.pl 03/19/94
3             #
4             # This library is no longer being maintained, and is included for backward
5             # compatibility with Perl 4 programs which may require it.
6             #
7             # In particular, this should not be used as an example of modern Perl
8             # programming techniques.
9             #
10             #
11             # Author: Charles Collins
12             #
13             # Description:
14             # This routine takes a shell script and 'dots' it into the current perl
15             # environment. This makes it possible to use existing system scripts
16             # to alter environment variables on the fly.
17             #
18             # Usage:
19             # &dotsh ('ShellScript', 'DependentVariable(s)');
20             #
21             # where
22             #
23             # 'ShellScript' is the full name of the shell script to be dotted
24             #
25             # 'DependentVariable(s)' is an optional list of shell variables in the
26             # form VARIABLE=VALUE,VARIABLE=VALUE,... that 'ShellScript' is
27             # dependent upon. These variables MUST be defined using shell syntax.
28             #
29             # Example:
30             # &dotsh ('/foo/bar', 'arg1');
31             # &dotsh ('/foo/bar');
32             # &dotsh ('/foo/bar arg1 ... argN');
33             #
34 1     1   1059 no warnings "ambiguous";
  1         3  
  1         582  
35              
36             sub dotsh {
37 0     0     local(@sh) = @_;
38 0           local($tmp,$key,$shell,$command,$args,$vars) = '';
39 0           local(*dotsh);
40 0           undef *dotsh;
41 0           $dotsh = shift(@sh);
42 0           @dotsh = split (/\s/, $dotsh);
43 0           $command = shift (@dotsh);
44 0           $args = join (" ", @dotsh);
45 0           $vars = join ("\n", @sh);
46 0 0         open (_SH_ENV, "$command") || die "Could not open $dotsh!\n";
47 0           chop($_ = <_SH_ENV>);
48 0 0         $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/);
49 0           close (_SH_ENV);
50 0 0         if (!$shell) {
51 0 0         if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/bash$|\/csh$/) {
52 0           $shell = "$ENV{'SHELL'} -c";
53             } else {
54 0           print "SHELL not recognized!\nUsing /bin/sh...\n";
55 0           $shell = "/bin/sh -c";
56             }
57             }
58 0 0         if (length($vars) > 0) {
59 0 0         open (_SH_ENV, "$shell \"$vars && . $command $args && set \" |") || die;
60             } else {
61 0 0         open (_SH_ENV, "$shell \". $command $args && set \" |") || die;
62             }
63              
64 0           while (<_SH_ENV>) {
65 0           chop;
66 0           m/^([^=]*)=(.*)/s;
67 0           $ENV{$1} = $2;
68             }
69 0           close (_SH_ENV);
70              
71 0           foreach $key (keys(%ENV)) {
72 0 0         $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
73             }
74 0           eval $tmp;
75             }
76             1;