Win32 pacifying from mjd.
[perl.git] / lib / dotsh.pl
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 ('/tmp/foo', 'arg1');
31 #      &dotsh ('/tmp/foo');
32 #      &dotsh ('/tmp/foo arg1 ... argN');
33 #
34 sub dotsh {
35    local(@sh) = @_;
36    local($tmp,$key,$shell,$command,$args,$vars) = '';
37    local(*dotsh);
38    undef *dotsh;
39    $dotsh = shift(@sh);
40    @dotsh = split (/\s/, $dotsh);
41    $command = shift (@dotsh);
42    $args = join (" ", @dotsh);
43    $vars = join ("\n", @sh);
44    open (_SH_ENV, "$command") || die "Could not open $dotsh!\n";
45    chop($_ = <_SH_ENV>);
46    $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/);
47    close (_SH_ENV);
48    if (!$shell) {
49       if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/bash$|\/csh$/) {
50          $shell = "$ENV{'SHELL'} -c";
51       } else {
52          print "SHELL not recognized!\nUsing /bin/sh...\n";
53          $shell = "/bin/sh -c";
54       }
55    }
56    if (length($vars) > 0) {
57       system "$shell \"$vars;. $command $args; set > /tmp/_sh_env$$\"";
58    } else {
59       system "$shell \". $command $args; set > /tmp/_sh_env$$\"";
60    }
61
62    open (_SH_ENV, "/tmp/_sh_env$$") || die "Could not open /tmp/_sh_env$$!\n";
63    while (<_SH_ENV>) {
64        chop;
65        m/^([^=]*)=(.*)/s;
66        $ENV{$1} = $2;
67    }
68    close (_SH_ENV);
69    system "rm -f /tmp/_sh_env$$";
70
71    foreach $key (keys(%ENV)) {
72        $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
73    }
74    eval $tmp;
75 }
76 1;