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