home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Topware / activeperl / ActivePerl / Perl / lib / dotsh.pl < prev    next >
Encoding:
Text File  |  1999-07-28  |  2.3 KB  |  77 lines
  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;
  77.