#!/usr/local/bin/perl
# make-sw-cache
#
# College of Computer Science
# Northeastern University
#
# Robert Leslie
# <django@ccs.neu.edu>
# 08 Jun 93
#
# MCS Division
# Argonne National Laboratory
#
# Ivan Judson
# <judson@mcs.anl.gov>
# 07 July 93
#
# Joe Bester
# <bester@mcs.anl.gov>
# 23 Sep 97
$vers = "v5.0";
#
# $Id: make-sw-cache,v 5.0 1997/09/23 20:56:03 bester Exp $
#
# $Log: make-sw-cache,v $
# Revision 5.0  1997/09/23  20:56:03  bester
# # -5.0- New database format.
# #       Multiple architecture support.
# #       Caches created for all shells.
# # -4.5- Added Two more Keywords, ARCH and HOST, that allow you to
# #    put in a path and a man path for the given HOST/ARCH.
# #    Moved the path printing into a subroutine to accomadate the
# #       new keywords.  The new information remains in the environment
# #    in the same order as the .software.
# # -4.4-    Added one more error check (missing db file), cleaned up some
# #    comments. Changed #!/usr/local/bin/... to #!/local/bin/...
# # -4.3-    Eliminated need for tmp file, as perl does better than shells do.
# #    Fixed a bug caused by an existing .software with no keywords.
# # -4.2-    Enhanced database format: logical lines can be extended with \.
# #    Note this makes it incompatible with make-sw-cache.csh.
# # -4.1-    Made several perl optimizations, such as removing `whoami` and
# #    inserting the duplication check code into the main routine.
# # -4.0-    Rewrote this script in perl, so as to make it run faster and less
# #    dependent on custom hacks such as `remove-dups'.
# # -3.0- Moved the make-cache part into its own file, since it doesn't have
# #    to run inside the user environment under its own shell format! As
# #    long as it produces a cache file for the proper shell, who cares.
# # -2.8- Added tmp hack to delete .software.cache files, in favor of
# #    the new name '.software-cache.csh'
# # -2.7- Removed `whoami` check for root, since the path might not be
# #    set correctly for it, and $HOME == "/" should be good enough.
# # -2.6- Added check for home = /, which now acts as if user was root.
# # -2.5- Removed hack for deleting obsolete .software.cache files.
# # -2.4- Added check for user 'root' -- don't set a path.
# # -2.3- Added tmp hack to delete obsolete .software.cache files.
#
#
# Based on ideas from Remy Evard <remy@ccs.neu.edu> ...
#
# Set up a user's PATH and MANPATH environment based on the contents
# of ~/.software.
#
# Exit codes:
#   0  Successful completion. The user's .software-cache was created.
#   1  A .software-cache was created, but the user's .software had errors.
#   2  No .software-cache was created because of a strange environment.
#   3  No .software-cache was created because write permission was denied.
#   4  This script was aborted because of a fatal error.
#
# This script should produce no output other than a .software-cache file
#
# ============================================================================

# Look at user's environment
($USER, $HOME, $SHELL, $SHOSTNAME, $LHOSTNAME, $ARCH) = ($ENV{'USER'}, 
  $ENV{'HOME'}, $ENV{'SHELL'}, $ENV{'HOSTNAME'}, $ENV{'HOST'}, $ENV{'ARCH'});

# Never run this as root or with a strange environment...
exit 2 if ($> == 0 || $< != $> || $HOME eq "/");

# read the site defaults
push(@INC, '/software/common/adm/packages/software-5.0/etc');
require 'software.config';

if(defined $ARGV[0] && -r $ARGV[0]) {
    $softfile=$ARGV[0];
} else {
    $softfile = $default_softfile;        # User's .software file
}

open(CACHEF_CSH, "> $cachefile.csh") || exit 3;
open(CACHEF_SH,  "> $cachefile.sh") || exit 3;

# Read the .software file, stripping out comments.
# If the file is empty or missing, it is assumed to contain @softdef.

@options = ();
if ( -e $softfile ) {        # check to see it it exists FIRST !
 if (-f $softfile && open(SOFTFILE, $softfile)) {
  while (<SOFTFILE>) {
    s/#.*$//;            # strip comments
    push(@options, split);    # break on whitespace into words
  }
  close(SOFTFILE);
  @options = (@softdef) if (! @options);
 }
} else {
  @options = (@softdef);
}

%paths=();            # don't duplicate paths in the same architecture
%manpaths=();        # likewise for manpaths
$in_case=0;            # indent case statements

# read the system software database
%env=();

open (DB, $database);
while(<DB>) {
    $x=chop;
    if(! $x eq "\n") { $_ .= $x; }
    local ($key,$val)=split(/->/, $_, 2);
    $env{$key}=$val;
}
close DB;


# Start writing the cache...

$header=
"# DO NOT MODIFY THIS FILE DIRECTLY!
#
# This file is created automatically by the software system. You can force
# its recreation by altering or touching the following file:
#\n";
print CACHEF_CSH $header;
print CACHEF_SH $header;

if ( -e $softfile ) {    # check to see if it exists FIRST !
    print CACHEF_CSH '# ' . `/bin/ls -l $softfile` . "#\n";
    print CACHEF_SH '# ' . `/bin/ls -l $softfile` . "#\n";
 } else {
    print CACHEF_CSH "# You have no .software.\n";
    print CACHEF_SH "# You have no .software.\n";
}

@options = &macresolv(@options);

print CACHEF_CSH "# Current options: @options\n#\n";    # for posterity
print CACHEF_SH "# Current options: @options\n#\n";    # for posterity

print CACHEF_CSH "if (\$?WHATAMI == 0) setenv WHATAMI `/bin/whatami`\n";
print CACHEF_SH  "WHATAMI=\${WHATAMI:-`/bin/whatami`}; export WHATAMI;\n";

print CACHEF_CSH "if (\$?ARCH == 0) setenv ARCH \$WHATAMI\n";
print CACHEF_SH  "ARCH=\${ARCH:-\$WHATAMI}; export ARCH\n";

# Build a new path
$errorsfound = 0;                # Error flag
%seen = ();                        # Avoid duplicates
%setenv = ();
foreach (@options) {
    if (/=/) {
        @parse = split(/=/);
        if ($parse[0] eq "PATH") {&push_all($parse[0], $parse[1]);}
        elsif ($parse[0] eq "MANPATH") {&push_all($parse[0], $parse[1]);}
        elsif ($parse[0] eq "HOST") { 
            &printpaths();     
            @tpath=""; @tmpath="";
            ($host,$path,$mpath)=split(/:/,$parse[1]);
            &print_cond("\"\$HOST\" == \"$host\" || \"\$HOSTNAME\" == \"$host\"",
                        $path, $mpath);
        } elsif ($parse[0] eq "ARCH") { 
            ($arch, $path, $mpath)= split(/:/,$parse[1]);
            if($supported{$arch}) {
                unless($path eq "") { &push_arch($arch,"PATH",$path); }
                unless($mpath eq "") { &push_arch($arch,"MANPATH",$mpath); }
            } else {
                &printpaths();     
                @tpath=""; @tmpath="";
                &print_cond("\"\$ARCH\" == \"$arch\"",$path,$mpath);
                @tpath=""; @tmpath="";
            }
        } else {
            &setenv($parse[0], $parse[1]);
          }
    } else {
        tr/A-Z/a-z/;            # downcase word
        if (! $seen{$_}) {        # not a duplicate?
            if (! $env{"D:$_"}) {            # not in db?
                print CACHEF_CSH "# Error: Word '$_' not recognized\n";
                print CACHEF_SH "# Error: Word '$_' not recognized\n";
                $errorsfound++;
            } else {
                $seen{$_} = 1;                    # mark as seen
                &add_paths($_);
            }
        }
    }
}


&printpaths();

print CACHEF_CSH "#\n# End of cache ($vers)\n";
print CACHEF_SH "#\n# End of cache ($vers)\n";
close(CACHEF_CSH);
close(CACHEF_SH);

exit 1 if ($errorsfound);

exit 0;                # all done!

# Resolve macros (recursively)
sub macresolv {
    local($i, @new);
    @new = @_;
    for ($i = 0; $i < @new; $i++) {
        if($new[$i] =~ /^@/) {
            splice(@new, $i, 1, &macresolv(split(/ /, $env{"MACRO:$new[$i]"})));
        }
                
    }
    return @new;
}

sub setenv {
    ($var, $val) = @_;

    unless ($val eq "") {
        $val =~ s#\$([^{][^/:]*)([:/])#\${$1}$2#g; # replace $foo with ${foo}
        if($in_case==1) {
            print CACHEF_CSH "    ";
            print CACHEF_SH  "    ";
        }
        print CACHEF_CSH "setenv $var $val\n";
        print CACHEF_SH  "$var=$val; export $var\n";
    }

}

sub addenv {
    ($var, $val) = @_;
    unless ($val eq "")    {
        $val =~ s#\$([^{][^/:]*)([:/])#\${$1}$2#g; # replace $foo with ${foo}

        if($in_case==1) {
            print CACHEF_CSH "    ";
            print CACHEF_SH  "    ";
        }
        print CACHEF_CSH "setenv $var \${$var}:$val\n";
        print CACHEF_SH  "$var=\${$var}:$val; export $var\n";
    } 

}

sub print_cond {
    local ($condition, $path, $mpath) = @_;

    print CACHEF_CSH "#\nif ($condition) then\n";
    unless($path eq "") {
        print CACHEF_CSH " setenv PATH \${PATH}:$path\n";
    }
    unless($mpath eq "") {
        print CACHEF_CSH " setenv MANPATH \${MANPATH}:$mpath\n";
    }
    print CACHEF_CSH "endif\n";

    # convert csh-style conditional to sh-style
    $condition =~ s,==,=,g;
    $condition =~ s,\|\|,-o,g;

    print CACHEF_SH "#\nif [ $condition ]; then\n";
    unless($path eq "")  {
        print CACHEF_SH " PATH=\${PATH}:$path; export PATH;\n";
    }
    unless($mpath eq "") {
        print CACHEF_SH " MANPATH=\${MANPATH}:$mpath; export MANPATH\n";
    }
    print CACHEF_SH "fi\n";
}

sub push_arch {
    local ($arch, $var, $path) = @_;

    if($newenv{"$var:$arch"}) { $newenv{"$var:$arch"} .= ":$path"; }
    else { $newenv{"$var:$arch"} = "$path"; }
}


sub push_all {
    local ($var, $val)=@_;
    foreach $arch (keys %supported) {
        &push_arch($arch, $var, $val);
    }
}

# sort architectures with "default" last for switch statements
sub mysort
{
    if($a eq "default") { 1; }
    elsif($b eq "default") { 0; }
    else { $a cmp $b;}
}

# print paths for all architectures
sub printpaths {
	if(keys %newenv) {
    print CACHEF_CSH "switch(\$WHATAMI)\n";
    print CACHEF_SH  "case \$WHATAMI in\n";
    $in_case=1;
    local (@set);

    foreach $arch (sort mysort keys %supported) {
        if($arch eq "default") { 
            print CACHEF_CSH "  default:\n";
            print CACHEF_SH  "  *)\n";
        } else {
            print CACHEF_CSH "  case $arch:\n";
            print CACHEF_SH  "  $arch)\n ";
        }
        foreach $key (keys %newenv) {
            if($key =~ /$arch$/) {
                $key =~ s,(.*):$arch,$1,;
                if($preset{$key}) {&addenv($key, $newenv{"$key:$arch"});} 
                else { &setenv($key, $newenv{"$key:$arch"}); }
                unshift(@set, $key);
            }
        }
        print CACHEF_CSH "\n  breaksw\n\n";
        print CACHEF_SH  "\n  ;;\n\n";
    }
    while($_=shift @set) { $preset{$_}=1}
    %newenv=();
    print CACHEF_CSH "endsw\n";
    print CACHEF_SH  "esac\n";
    $in_case=0;
    }
}

sub add_paths {
    local ($key) = $_[0];

    # want to do default first, since others may reference it.
    foreach $arch (reverse sort mysort keys %supported) {
        $hash="$arch:$key";

        # set the PATH
        if($env{"P:$hash"}) {
            $tmp=$env{"P:$hash"};
            if($tmp eq "!") { next;}

            unless($tmp eq "-") {
        $tmp =~ s,\$\$,$env{"P:default:$key"},;    # Expand $$'s
        $tmp=&uniquify($tmp,"PATH:$arch");
        unless ($tmp eq "") {
            if($newenv{"PATH:$arch"}) {
                        $newenv{"PATH:$arch"} = join(":",
                             $newenv{"PATH:$arch"},
                             $tmp);
            } else { 
                        $newenv{"PATH:$arch"} = $tmp; 
            }
        }
            }
        } else {
            unless($arch eq "default" || $env{"P:default:$key"} eq '-'
                   || $env{"P:default:$key"} eq "") {
                if(defined($newenv{"PATH:$arch"})) {
            $tmp=$env{"P:default:$key"};
            $tmp=&uniquify($tmp,"PATH:$arch");
            unless ($tmp eq "") {
                        $newenv{"PATH:$arch"} = join(":",
                                                 $newenv{"PATH:$arch"},
                                                 $tmp);
                    }
                } else {
            $tmp = $env{"P:default:$key"};
            $tmp = &uniquify($tmp,"PATH:$arch");
                    $newenv{"PATH:$arch"} = $tmp;
                }
            }
        }
        # MANPATH
        if($env{"M:$hash"}) {
            $tmp = $env{"M:$hash"};
            unless($tmp eq "-") {
                $tmp =~ s,\$\$,$env{"M:default:$key"},;
        $tmp = &uniquify($tmp,"MANPATH:$arch");
        unless($tmp eq "") {
            if($newenv{"MANPATH:$arch"}) {
                        $newenv{"MANPATH:$arch"} = join(":",
                            $newenv{"MANPATH:$arch"},
                            $tmp);
            } else {
            $newenv{"MANPATH:$arch"} = $tmp;
            }
        }
            }
        } else {
            unless($arch eq "default" || $env{"M:default:$key"} eq '-'
                   || $env{"M:default:$key"} eq "") {
                if($newenv{"MANPATH:$arch"}) {
            $tmp=$env{"M:default:$key"};
            $tmp=&uniquify($tmp,"MANPATH:$arch");
            unless($tmp eq "") {
            $newenv{"MANPATH:$arch"} = join(":",
                           $newenv{"MANPATH:$arch"},
                           $tmp);
            }
                } else {
            $tmp = $env{"M:default:$key"};
            $tmp=&uniquify($tmp,"MANPATH:$arch");
                    $newenv{"MANPATH:$arch"} = $tmp;
                }
            }
        }
        # environment
        if(defined($env{"E:$hash"})) {
            @envlist=split(/ /, $env{"E:$hash"});
            while($evar = shift @envlist) {
                $eval = shift @envlist;
                if($eval eq '-') { next; }
                $eval =~ s,\$\$,$env{"E:default:$key"},;
                $newenv{"$evar:$arch"}=$eval;
            
            }
        }
    
    }
}

sub uniquify {
    local ($newpath,$hashkey) = @_;

    local (@p1, @p2, @p3);
    local($var, $test, $tmp);


    @p1 = split(/:/, $newpath);
    @p2 = split(/:/, $setenv{"$hashkey"});
    @p3 = ();

    foreach $var (@p1) {
        push (@p3, $var);
        foreach $test (@p2) {
            if($var eq $test) {
                pop(@p3);
                last;
            }
        }
    }
    $tmp = join(':', @p3);
    unless($tmp eq "") {
        if($setenv{"$hashkey"}) { 
            $setenv{"$hashkey"} .= ":" . $tmp;
        } else {
            $setenv{"$hashkey"} = $tmp;
        }
    }
    return $tmp;
}