#!/bin/sh
exec perl -S -x -- "$0" "$@"
#!perl -w
# -*- perl -*-
# vim:ft=perl:

# env-tool $Id: env-tool 39 2005-08-13 17:44:21Z geoffw $
# Copyright Geoffrey Alan Washburn, 2005.
# Some parts copyright Trustees of Boston University, 2002.
# Some parts copyright Joe B Wells, 2002.
# 
# You can redistribute and/or modify this software under the terms of
# the GNU General Public License as published by the Free Software
# Foundation; either version 2, or (at your option) any later version.
# 
# This software is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You may obtain the GNU General Public License by writing to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.

use English;

# Try to minimize Perl foolishness.
use strict;

# For XML Parsing
use XML::Parser;

# Use find to search for configuration files
use File::Find ();

# Use Getopt::Long to parse command-line arguments
use Getopt::Long;

# Need to be able to obtain the current directory to set variables
use Cwd;

# Use data dumper for printing Perl structures
use Data::Dumper;

##############################################################################

# What version of env-tool is this?
my $env_version = 1.2;

# List of TEXINPUTS like environment variables
# *** Whether a variable to be extended is one of the variables
# handled by the kpathsea environment should be specified in the
# .env-config files, not here.
my @TEXINPUTS_like = ("TEXINPUTS", "DVIPSHEADERS", "BSTINPUTS",
                      "BIBINPUTS", "AFMFONTS", "MFBASES",
                      "TEXBIB", "TEXCONFIG", "TEXFORMATS",
                      "TEXINDEXSTYLE", "TEXFONTMAPS", "MFINPUTS",
                      "TEXFONTS", "T1FONTS", "T1INPUTS", "TTFONTS",
                      "VFFONTS", "XDVIFONTS", "GLYPHFONTS",
                      "ENCFONTS", "TEXPSHEADERS", "TFMFONTS");

# By default don't traverse into these directories
my @default_dir_ignores = (".svn", ".snapshot");

# What is our sml-cm called?  Should make this a command-line option
my $sml_cm = "sml-cm";

# Keep a hash of what the "default" environment for variables
# should be if they are not set in the environment
my %default_environment = ();

# This hash stores all the directories we have configuration information
# about. Each hash contains another a hash from tag names to arrays of entries.
# So we might have 
#   $directories{"/usr/local/bin"}{"alias"}[1]{"name"} 
#   $directories{"/usr/local/bin"}{"alias"}[1]{"value"}
# for the name and value components of an alias declared in /usr/local/bin  
my %directories = ();

# Need the two follwing global variables due to stange locality issues.

# Does the user have sml-cm in their path
my $cm_exists = undef;
# What was the CM_PATH returned by sml-cm (if it exists)
my @cm_path = ();

# Boolean constants
my $false_const = (0 == 1);
my $true_const = (1 == 1);

##############################################################################
# Obscure SML Compilation manager stuff

# Return 1 if sml-cm exists in our search path, otherwise 0
sub sml_cm_exists () {
  my @path = split(/:/, $ENV{PATH});

  # For each entry in our PATH
  for(@path) {
    # Does $sml_cm exist and is executable in this directory?
    if(-x "$_/$sml_cm" && -f "$_/$sml_cm") {
        return 1;
    }
  }
  return 0;
}

# If we checked that sml-cm is in our path, we can return an array
# of directories to include in CM_PATH
sub obtain_cm_path () {
  # Evil hack to execute sml-cm and get the output back
  # First save the current CM_PATH
  my $path_tmp = undef;
  my $path_tmp_needed = 0;
  if(exists $ENV{CM_PATH}) {
    $path_tmp = $ENV{CM_PATH};
    delete $ENV{CM_PATH};
    $path_tmp_needed = 1;
  }
  # Delete it so that it is clear when we run $sml_cm

  my $output = `echo "CM.set_path NONE;" |  $sml_cm`;
  # Restore the CM_PATH;
  if($path_tmp_needed) {
    $ENV{CM_PATH} = $path_tmp;
  }
  # The output is expected to look like this (with no trailing newline):
  #   Standard ML of New Jersey, Version 110.0.7, September 28, 2000 [CM; autoload enabled]
  #   - val it = [".","/usr/share/smlnj/lib"] : string list
  #   -
  # Extract out the interesting bit
  $output =~ s/(.*)= \[(.*)\](.*):(.*)/$2/gs;
  # Clean it up some
  # for split did not have grouping parentheses.
  my @processed = split(/^\"|\"$|\"\,\"/, $output);
  # (By default split will return a leading empty field.  Not sure how
  # to turn this off.)
  shift @processed;
  return @processed;
}

##############################################################################

## A function to handle extending the list of TEXINPUTS-like variables

sub extend_texinputs_like ($) {
  my $variable = shift;
  foreach my $name (@TEXINPUTS_like) {
    if($variable eq $name) {
      return;
    }
  }
 
  push @TEXINPUTS_like, $variable;
}

#####################################################################

sub option_error ($$$) {
  my ($option, $name, $other) = @_;
  if($option) {
    die "--$name has no meaning with --$other";
  }
}

#####################################################################

# Validate that somethins is actually a directory.

sub validate_directory ($$) {
  my ($dir, $subname) = @_;
  if(! (-d $dir)) {
    die "$subname: directory argument \"$dir\" is not a directory!";
  }
}

##############################################################################

## Given a reference to a list of regular expressions to ignore, match against
## the given directory.

sub should_ignore_dir ($$) {
  my $dir = shift;
  my $ignores_tmp = shift;
  my @ignores = undef;


  if(defined $ignores_tmp) { 
    @ignores = @{$ignores_tmp};
  } else {
    @ignores = ();
  }

  foreach my $pat (@ignores) {
    my $re = qr/$pat/;
    if($dir =~ /$re/) {
      return (1 == 1);
    }
  }
  return (0 == 1);
}

##############################################################################
# Extend the aliases we are collecting.
  
sub add_alias_entry ($$$$) {
  # No checks because we assume they have been done already.
  my $dir = shift;
  my $name = shift;
  my $value = shift;
  my $ignores = shift;
    
  if(!(should_ignore_dir($dir, $ignores))) {
    if(!(exists $directories{$dir}{"alias"})) {
        @{$directories{$dir}{"alias"}} = ({"name" => $name, "value" => $value});
    } else {
        push @{$directories{$dir}{"alias"}}, {"name" => $name, "value" => $value};
    }
  } else {
    verbosemsg("Ignoring directory $dir for alias $name.");
  }
} 

sub add_relative_alias_entry ($$$$) {
  # No checks because we assume they have been done already.
  my $dir = shift;
  my $name = shift;
  my $value = shift;
  my $ignores = shift;
    
  if(!(should_ignore_dir($dir, $ignores))) {
    if(!(exists $directories{$dir}{"relative-alias"})) {
        @{$directories{$dir}{"relative-alias"}} = ({"name" => $name, "value" => $value});
    } else {
        push @{$directories{$dir}{"relative-alias"}}, {"name" => $name, "value" => $value};
    }
  } else {
    verbosemsg("Ignoring directory $dir for relative alias $name.");
  }
} 

sub add_variable_entry ($$$) {
  # No checks because we assume they have been done already.
  my $dir = shift;
  my $name = shift;
  my $ignores = shift;
    
  if(!(should_ignore_dir($dir, $ignores))) {
    if(!(exists $directories{$dir}{"variable"})) {
        @{$directories{$dir}{"variable"}} = ({"name" => $name});
    } else {
        push @{$directories{$dir}{"variable"}}, {"name" => $name};
    } 
  } else {
    verbosemsg("Ignoring directory $dir for variable $name.");
  }
} 

sub add_variable_body_entry ($$$$) {
  # No checks because we assume they have been done already.
  my $dir = shift;
  my $name = shift;
  my $body = shift;
  my $ignores = shift;
    
  if(!(should_ignore_dir($dir, $ignores))) {
    if(!(exists $directories{$dir}{"variable"})) {
        @{$directories{$dir}{"variable"}} = ({"name" => $name, "body" => $body});
    } else {
        push @{$directories{$dir}{"variable"}}, {"name" => $name, "body" => $body};
    }
  } else {
    verbosemsg("Ignoring directory $dir for variable $name.");
  }
} 

sub add_absolute_variable_entry ($$$$) {
  # No checks because we assume they have been done already.
  my $dir = shift;
  my $name = shift;
  my $body = shift;
  my $ignores = shift;
    
  if(!(should_ignore_dir($dir, $ignores))) {
    if(!(exists $directories{$dir}{"absolute-variable"})) {
        @{$directories{$dir}{"absolute-variable"}} = ({"name" => $name, "body" => $body});
    } else {
        push @{$directories{$dir}{"absolute-variable"}}, {"name" => $name, "body" => $body};
    }
  } else {
    verbosemsg("Ignoring directory $dir for absolute variable $name.");
  }
} 

sub add_kpathsea_variable_entry ($$$) {
  # No checks because we assume they have been done already.
  my $dir = shift;
  my $name = shift;
  my $ignores = shift;
    
  if(!(should_ignore_dir($dir, $ignores))) {
    if(!(exists $directories{$dir}{"kpathsea-variable"})) {
        @{$directories{$dir}{"kpathsea-variable"}} = ({"name" => $name});
    } else {
        push @{$directories{$dir}{"kpathsea-variable"}}, {"name" => $name};
    }
  } else {
    verbosemsg("Ignoring directory $dir for kpathsea variable $name.");
  }
} 

sub add_kpathsea_variable_body_entry ($$$$) {
  # No checks because we assume they have been done already.
  my $dir = shift;
  my $name = shift;
  my $body = shift;
  my $ignores = shift;
    
  if(!(should_ignore_dir($dir, $ignores))) {
    if(!(exists $directories{$dir}{"kpathsea-variable"})) {
        @{$directories{$dir}{"kpathsea-variable"}} = ({"name" => $name, "body" => $body});
    } else {
        push @{$directories{$dir}{"kpathsea-variable"}}, {"name" => $name, "body" => $body};
    }
  } else {
    verbosemsg("Ignoring directory $dir for kpathsea variable $name.");
  }
} 

sub extend_aliases ($$$$$) {
  my $name = shift;
  if ((length $name) <= 0) {
    die "extend_aliases: invalid name argument!";
  }
  my $value = shift;
  if ((length $value) <= 0) {
    die "extend_aliases: invalid value argument for alias name $name!";
  }
  my $realdir = shift;
  # Check that it is really a directory
  if((defined $realdir) && !(-d $realdir)) {
    die "extend_aliases: invalid directory argument for alias $name!"
  }
  # Don't need to check that virtual directories really exist
  my $virtualdir = shift;
  my $ignores = shift;

  if (defined $virtualdir) {
    add_alias_entry($virtualdir, $name, $value, $ignores);
  } elsif (defined $realdir) {
    add_alias_entry($realdir, $name, $value, $ignores);
  } else {
    die "extend_aliases: no valid directory argument provided!";
  }
}  

sub extend_relative_aliases ($$$$$) {
  my $name = shift;
  if ((length $name) <= 0) {
    die "extend_relative_aliases: invalid name argument!";
  }
  my $value = shift;
  if ((length $value) <= 0) {
    die "extend_relative_aliases: invalid value argument for alias name $name!";
  }
  my $realdir = shift;
  # Check that it is really a directory
  if((defined $realdir) && !(-d $realdir)) {
    die "extend_relative_aliases: invalid directory argument for alias $name!"
  }
  # Don't need to check that virtual directories really exist
  my $virtualdir = shift;
  my $ignores = shift;

  if (defined $virtualdir) {
    add_relative_alias_entry($virtualdir, $name, $value, $ignores);
  } elsif (defined $realdir) {
    add_relative_alias_entry($realdir, $name, $value, $ignores);
  } else {
    die "extend_relative_aliases: no valid directory argument provided!";
  }
}  

sub extend_variables ($$$$) {
  my $name = shift;
  if ((length $name) <= 0) {
    die "extend_variables: invalid name argument!";
  }
  my $realdir = shift;
  # Check that it is really a directory
  if((defined $realdir) && !(-d $realdir)) {
    die "extend_variables: invalid directory argument for variable name $name!"
  }
  # Don't need to check that virtual directories really exist
  my $virtualdir = shift;
  my $ignores = shift;

  if (defined $virtualdir) {
    add_variable_entry($virtualdir, $name, $ignores);
  } elsif (defined $realdir) {
    add_variable_entry($realdir, $name, $ignores);
  } else {
    die "extend_variables: no valid directory argument provided!";
  }
}  

sub extend_variables_body ($$$$$) {
  my $name = shift;
  if ((length $name) <= 0) {
    die "extend_variables_body: invalid name argument!";
  }
  my $body = shift;
  if ((length $body) <= 0) {
    die "extend_variables_body: invalid body argument for variable name $name!";
  }
  my $realdir = shift;
  # Check that it is really a directory
  if((defined $realdir) && !(-d $realdir)) {
    die "extend_variables_body: invalid directory argument for variable name $name!"
  }
  # Don't need to check that virtual directories really exist
  my $virtualdir = shift;
  my $ignores = shift;

  if (defined $virtualdir) {
    add_variable_body_entry($virtualdir, $name, $body, $ignores);
  } elsif (defined $realdir) {
    add_variable_body_entry($realdir, $name, $body, $ignores);
  } else {
    die "extend_variables_body: no valid directory argument provided!";
  }
}  

sub extend_kpathsea_variables ($$$$) {
  my $name = shift;
  if ((length $name) <= 0) {
    die "extend_variables_body: invalid name argument!";
  }
  my $realdir = shift;
  # Check that it is really a directory
  if((defined $realdir) && !(-d $realdir)) {
    die "extend_variables_body: invalid directory argument for variable name $name!"
  }
  # Don't need to check that virtual directories really exist
  my $virtualdir = shift;
  my $ignores = shift;

  if (defined $virtualdir) {
    add_kpathsea_variable_entry($virtualdir, $name, $ignores);
  } elsif (defined $realdir) {
    add_kpathsea_variable_entry($realdir, $name, $ignores);
  } else {
    die "extend_variables: no valid directory argument provided!";
  }
}  

sub extend_kpathsea_variables_body ($$$$$) {
  my $name = shift;
  if ((length $name) <= 0) {
    die "extend_kpathsea_variables_body: invalid name argument!";
  }
  my $body = shift;
  if ((length $body) <= 0) {
    die "extend_kpathsea_variables_body: invalid body argument for variable name $name!";
  }
  my $realdir = shift;
  # Check that it is really a directory
  if((defined $realdir) && !(-d $realdir)) {
    die "extend_kpathsea_variables_body: invalid directory argument for variable name $name!"
  }
  # Don't need to check that virtual directories really exist
  my $virtualdir = shift;
  my $ignores = shift;

  if (defined $virtualdir) {
    add_kpathsea_variable_body_entry($virtualdir, $name, $body, $ignores);
  } elsif (defined $realdir) {
    add_kpathsea_variable_body_entry($realdir, $name, $body, $ignores);
  } else {
    die "extend_kpathsea_variables_body: no valid directory argument provided!";
  }
}  

sub extend_absolute_variables ($$$$$) {
  my $name = shift;
  if ((length $name) <= 0) {
    die "extend_absolute_variables: invalid name argument!";
  }
  my $body = shift;
  if ((length $body) <= 0) {
    die "extend_absolute_variables: invalid body argument for variable name $name!";
  }
  my $realdir = shift;
  # Check that it is really a directory
  if((defined $realdir) && !(-d $realdir)) {
    die "extend_absolute_variables: invalid directory argument for variable name $name!"
  }
  # Don't need to check that virtual directories really exist
  my $virtualdir = shift;
  my $ignores = shift;

  if (defined $virtualdir) {
    add_absolute_variable_entry($virtualdir, $name, $body, $ignores);
  } elsif (defined $realdir) {
    add_absolute_variable_entry($realdir, $name, $body, $ignores);
  } else {
    die "extend_absolute_variables: no valid directory argument provided!";
  }
}  

##############################################################################
# Extend the new environment we are building.

sub build_alias_keypairs () {
  my @keypairs = ();
  for(keys %directories) {
    my $dir = $_;
        if(defined $directories{$dir}{"alias"}) {
          my @entries = @{$directories{$dir}{"alias"}};
          foreach my $entry (@entries) {
            my %entry_hash = %{$entry};
            my @pair = ($entry_hash{"name"}, $entry_hash{"value"});
            push @keypairs, \@pair; 
          }
        }
        if(defined $directories{$dir}{"relative-alias"}) {
          my @entries = @{$directories{$dir}{"relative-alias"}};
          foreach my $entry (@entries) {
            my %entry_hash = %{$entry};
            my @pair = ($entry_hash{"name"}, $dir."/".$entry_hash{"value"});
            push @keypairs, \@pair; 
          }
        }
      }
  return @keypairs;
}

sub extend_environment_variable_table ($$$$) {
  my $variable = shift;
  my $dir = shift;
  my $text = shift;
  my $tableref = shift;

  my $separator = undef;
  if(!(defined $dir)) {
    $dir = "";
    $separator = "";
  } else {
    $separator = "/";
  }

  if(!(defined ${$tableref}{$variable})) {
    ${$tableref}{$variable} = [];
  }

  # If it is a TEXINPUTS-like variable we want to check if it is a //
  if(grep($variable, @TEXINPUTS_like)) {
    if(defined $text) {
      if($text eq "//") {
        push @{${$tableref}{$variable}}, ($dir.$text);
      } else {
        push @{${$tableref}{$variable}}, ($dir.$separator.$text);
      }
    } else {
        push @{${$tableref}{$variable}}, ($dir);
    }
  } else {
    if(defined $text) {
      push @{${$tableref}{$variable}}, ($dir.$separator.$text);
    } else {
      push @{${$tableref}{$variable}}, ($dir);
    }
  }
}

sub build_environment_variable_defs () {
  my %table = ();
  
  for(keys %directories) {
    my $dir = $_;
    if(defined $directories{$dir}{"variable"}) {
      my @entries = @{$directories{$dir}{"variable"}};      
      foreach my $entry (@entries) {
        my %entry_hash = %{$entry};
        if(defined $entry_hash{"body"}) {
          extend_environment_variable_table ($entry_hash{"name"}, $dir, $entry_hash{"body"}, \%table);
        } else {
          extend_environment_variable_table ($entry_hash{"name"}, $dir, undef, \%table);
        }
      }
    }
    if(defined $directories{$dir}{"absolute-variable"}) {
      my @entries = @{$directories{$dir}{"absolute-variable"}};      
      foreach my $entry (@entries) {
        my %entry_hash = %{$entry};
        extend_environment_variable_table ($entry_hash{"name"}, undef, $entry_hash{"body"}, \%table);
      }
    }
    if(defined $directories{$dir}{"kpathsea-variable"}) {
      my @entries = @{$directories{$dir}{"kpathsea-variable"}};      
      foreach my $entry (@entries) {
        my %entry_hash = %{$entry};
        extend_texinputs_like($entry_hash{"name"});
        if(defined $entry_hash{"body"}) {
          extend_environment_variable_table ($entry_hash{"name"}, $dir, $entry_hash{"body"}, \%table);
        } else {
          extend_environment_variable_table ($entry_hash{"name"}, $dir, undef, \%table);
        }
      }
    }
  }

  return %table;
}


##############################################################################

sub validate_parent ($\@\@) {
  my $element = shift;
  my @path = @{shift @_};
  my @valid = @{shift @_};
  
  my $parent = pop @path;
  if(!(defined $parent)) {
    die "$element found at the root of the document.\n";
  }
  
  foreach my $tag (@valid) {
    if($parent eq $tag) {
      push @path, $parent;
      return;
    }
  }
 
   die "$element element found underneath a $parent element. Should be one of: ",join(' ',@valid),".\n";
}

sub validate_attribute ($$\%) {
  my $element = shift;
  my $attrname = shift;
  my %attr = %{shift @_};
  
  if(!(exists $attr{$attrname})) {
    die "$element is missing a $attrname attribute.\n";
  } else {
    return $attr{$attrname}
  }
}

##############################################################################

# Code to process a environment configuration file
sub process_config ($$$) {
  my $dir = shift;
  # Check that it is actually a directory
  if(!(-d $dir)) {
    die "process_config: directory argument \"$dir\" is not a directory!";
  }
  my $xml = shift;
  my $ignores = shift;
  
  my @path = ();
  my $current_variable = undef;
  my $current_directory = undef;
  my $current_alias_name = undef;
  my $current_alias_value = undef;
  my $parser = new XML::Parser(ErrorContext => 2);

  # Create a set of handler routines for XML::Parser::Lite
  $parser->setHandlers
    (
     Start => sub {
       shift;
       my $element = shift;
       my %attr = @_;

       # If we are looking at an env-config element
       if($element eq "env-config") {

         # Make sure there is a version attribute
         my $version = validate_attribute "env-config", "version", %attr;

         # Make sure that we understand this version
         if($version > $env_version) {
           die "Attemping to use an incorrect version of env-tool ($version versus $env_version)!\n";
         }
       # If we are looking at a directory element
       } elsif($element eq "directory") {
         # Make sure we are structured properly
         my @valid = ();
         push @valid, "env-config";
         validate_parent("directory", @path, @valid);
         $current_directory = validate_attribute("directory","name",%attr);

       # If we are looking at a variable element
       } elsif($element eq "variable") {
         # Make sure we are structured properly
         my @valid = ("directory", "env-config");
         validate_parent("variable", @path, @valid);
         $current_variable = validate_attribute("variable","name",%attr);
       
       # If we are looking at a alias element
       } elsif($element eq "alias") {
         # Make sure we are structured properly
         my @valid = ("directory", "env-config");
         validate_parent("alias", @path, @valid);
         $current_alias_name = validate_attribute("alias","name",%attr);
         $current_alias_value = validate_attribute("alias","value",%attr);
       
       # If we are looking at a relative alias element
       } elsif($element eq "relative-alias") {
         # Make sure we are structured properly
         my @valid = ("directory", "env-config");
         validate_parent("relative-alias", @path, @valid);
         $current_alias_name = validate_attribute("relative-alias","name",%attr);

       # If we are looking at a variable element
       } elsif($element eq "absolute-variable") {
         # Make sure we are structured properly
         my @valid = ("directory", "env-config");
         validate_parent("absolute-variable", @path, @valid);
         $current_variable = validate_attribute("absolute-variable","name",%attr);

       # If we are looking at a variable element
       } elsif($element eq "kpathsea-variable") {
         # Make sure we are structured properly
         my @valid = ("directory", "env-config");
         validate_parent("kpathsea-variable", @path, @valid);
         $current_variable = validate_attribute("kpathsea-variable","name",%attr);
         extend_texinputs_like($current_variable);
       } else {
         die "unexpected $element element in the input!";
       }
       
       push @path, $element;
     },

     Char => sub {
       shift;
       my $text = shift;
       my $parent = pop @path;

       if((defined $current_variable) && ($parent eq "variable")) {
         extend_variables_body($current_variable, $text, $dir, $current_directory, $ignores);
         undef $current_variable;
       } elsif((defined $current_alias_name) && 
               ($parent eq "relative-alias")) {
         extend_relative_aliases($current_alias_name, $text, $dir, $current_directory, $ignores); 
         undef $current_alias_name;
       } elsif((defined $current_variable) && 
               ($parent eq "kpathsea-variable")) {
         extend_kpathsea_variables_body($current_variable, $text, $dir, $current_directory, $ignores);
         undef $current_variable;
       } elsif((defined $current_variable) && 
               ($parent eq "absolute-variable")) {
         extend_absolute_variables($current_variable, $text, $dir, $current_directory, $ignores);
         undef $current_variable;
       
       # Should really check for invalid character data but this causes all sorts of 
       # bizarre problems with XML::Parser::Lite
       } elsif($text !~ /^\s*$/s) {
         die "unexpected character data inside an $parent element\n";
       }
       push @path, $parent;
     },

     End => sub {
       shift;
       my $element = shift;

       my $parent = pop @path;
       if($element ne $parent) {
         die "Somehow hit a mismatched tag.\n";
       } 
       if($element eq "env-config") {
         #NOP
       } elsif($element eq "directory") {
         if(defined $current_directory) {
           undef $current_directory;
         } else {
           die "Somehow hit a closing directory tag, but the current directory was not defined!\n";
         }
         
       } elsif($element eq "variable") {
         if(defined $current_variable) {
           extend_variables($current_variable, $dir, $current_directory, $ignores);
           undef $current_variable;
         }
         
       } elsif($element eq "relative-alias") {
         if(defined $current_alias_name) {
           die "relative-alias element was empty.\n";
         }
       } elsif($element eq "alias") {
         if(defined $current_alias_name) {
           extend_aliases($current_alias_name, $current_alias_value, 
                          $dir, $current_directory, $ignores);
           undef $current_alias_name;
           undef $current_alias_value;
         }
         
       } elsif($element eq "kpathsea-variable") {
         if(defined $current_variable) {
           extend_kpathsea_variable($current_variable, $dir, $current_directory, $ignores);
           undef $current_variable;
         }
         
       } elsif($element eq "absolute-variable") {
         if(defined $current_variable) {
           die "absolute-variable element was empty.\n";
         }
       } else {
        die "unexpected closing element $element.\n";
       }
     },
    );

  # Parse the configuation file
  $parser->parse($xml);

}

##############################################################################
sub process_file ($$$) {
  my $dir = shift;
  # Check that it is actually a directory
  if(!(-d $dir)) {
    die "process_file: directory argument \"$dir\" is not a directory!";
  }
  my $file = shift;
  my $ignores = shift;
  
  open(XML, $file);
  my @temp = <XML>;
  close XML; 
  process_config $dir, "@temp", $ignores;
}


##############################################################################

# Print the usage information
sub print_usage () {
  print <<END;
Usage: env-tool [-h|--help] [--verbose] [--outputdir dir] 
                [--ignores re] [--lock] [--test] 
                [--sh] [--csh] [--zsh] [--bash] 
                [--ignorecache] [--bg|--condbg] [--safe] [--debug] 
                [--cache] [directories ...]

env-tool's default mode of operation is script generation.  env-tool will
scan the specified directories, or the current if none were specified,
and their children for environment configuation files.  env-tool will
then atomically create outputdir/.env-tool.{bash,csh,sh,zsh} depending
upon the supplied options.  If no specific shell format was specified, all
will be generated.

env-tool also has a cache file generation mode that will scan directories and 
produce an environment configuration file that simulates the result of scanning
the specified directory trees.  

   Universal options:

    -h, --help            print this message
        
        --verbose         print detailed information about the activity of env-tool
                          to stderr
        
        --outputdir dir   set the output directory.  default is ~/
        
        --test            run but do not write output to a file 
        
        --ignores re      prune the specified regular expression from
                          the search.  May be used any number of times.
        
        --lock            force locking so that only one instance can
                          operate at a time.  Creates a lockfile 
                          outputdir/.env-tool.lock
         
   Shell script generation options:
   
        --sh              create outputdir/.env-tool.sh, a script for 
                          Bourne descended shells
                      
        --csh             create outputdir/.env-tool.csh, a script for 
                          C-Shell descended shells
                      
        --zsh             create outputdir/.env-tool.zsh, a script for 
                          optimized for Z-Shell
        
        --bash            create outputdir/.env-tool.zsh, a script for 
                          optimized for the Bourne Again Shell
                      
        --bg              run in the background. Only one instance of 
                          env-tool may run at a time if --lock is used.
                          Can't be used with --condbg.
                      
        --condbg          run in the background if 
                          outputdir/.env-tool.{csh,sh,zsh} already exist. 
                          Only one instance of env-tool may run at a time 
                          if --lock is used.  Can't be used with --bg
                      
        --safe            produce shell scripts that attempt to not 
                          disturb the user's existing configuration
                      
        --debug           output shell code that describes what 
                          it is doing
        
        --ignorecache     ignore env-tool cache files
   
   Cache generation options:
  
        --cache           instead of producing a shell script, output a cache
                          file, outpdir/.env-cache.xml

Try `perldoc env-tool' for more information.
END
  exit 0;
}

##############################################################################

# Utility function to define the default environment
sub init_default_environment () {
  # TEXINPUTS-like variables should have the empty-string as an 
  # entry
  for(@TEXINPUTS_like) {
    $default_environment{$_} = [""]
  }

  # If we are going to extend CM_PATH or overwrite CM_PATH we should
  # use this
  $default_environment{CM_PATH} = [@cm_path];
}

##############################################################################
### Generate a "cache" file

sub gen_cache () {
  my $result = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
  $result .= "<env-config version=\"1.2\">\n";
  for(keys %directories) {
    my $dir = $_;
    $result .= "  <directory name=\"$dir\">\n";
    for(keys %{$directories{$dir}}) {
      my $tag = $_;
      my @entries = @{$directories{$dir}{$tag}};
      foreach my $entry (@entries) {
        my %entry_hash = %{$entry};
        if($tag eq "alias") {
          $result .= "    <alias name=\"".$entry_hash{"name"}."\" value=\"".$entry_hash{"value"}."\" />\n";
        } elsif ($tag eq "relative-alias") {
          $result .= "    <relative-alias name=\"".$entry_hash{"name"}."\">".$entry_hash{"value"}."</relative-alias>\n";
        } elsif ($tag eq "variable") {
          if(defined $entry_hash{"body"}) {
            $result .= "    <variable name=\"".$entry_hash{"name"}."\">".$entry_hash{"body"}."</variable>\n";
          } else {
            $result .= "    <variable name=\"".$entry_hash{"name"}."\" />\n";
          }
        } elsif ($tag eq "absolute-variable") {
          $result .= "    <absolute-variable name=\"".$entry_hash{"name"}."\">".$entry_hash{"body"}."</absolute-variable>\n";
        } elsif ($tag eq "kpathsea-variable") {
          if(defined $entry_hash{"body"}) {
            $result .= "    <kpathsea-variable name=\"".$entry_hash{"name"}."\">".$entry_hash{"body"}."</kpathsea-variable>\n";
          } else {
            $result .= "    <kpathsea-variable name=\"".$entry_hash{"name"}."\" />\n";
          }
        } else {
          die "Unexpected entry type!";
        }
      }
    }
    $result .= "  </directory>\n";
  }
  $result .= "</env-config>\n";
  return $result;
}

##############################################################################
### Shell specific code #####

##############################################################################
### Bourne shell #####

sub gen_prologue_sh () {
  return "";
}

sub gen_epilogue_sh () {
  return "";
}

sub gen_cond_alias_sh ($$$) {
  # Don't need to validate any of the inputs because gen_cond_alias has 
  # already done it for us.
  my $name = shift @_;
  my $value = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .= "alias $name=$value\n";
  if($debug) {
    $result .="echo \"env-tool: aliasing $name with $value\"\n";
  }

  return $result;
}

sub gen_cond_var_sh ($$$$$) {
  # Don't need to validate any of the inputs because gen_cond_var has 
  # already done it for us.
  my $variable = shift @_;
  my $additions_array = shift @_;
  my $default = shift @_;
  my $safe = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .= "case \"x\${$variable:-y}\" in\n  xy)";
  $result .= " export $variable='$default'";
  if($debug) {
    $result .="\n    echo \"env-tool: setting $variable with $default\"";
  }
  $result .=";;\n  *)\n";
    
  for(@$additions_array) {
    $result .="    case \"\$$variable\" in\n      '$_') ;;\n      *:'$_') ;; \n      '$_':*) ;;\n      *:'$_':*) ;;\n      *)";
    if($safe) {
      $result .=" export $variable=\"\$$variable:$_\"";
    } else {
      $result .=" export $variable=\"$_:\$$variable\"";
    }
    if($debug) {
      $result .="\n    echo \"env-tool: extending $variable with $_\"";
    }
    $result .=";;\n    esac\n";
  }
  $result .= ";;\nesac\n";
  
  return $result;
}

##############################################################################
### C-shell ######

sub gen_prologue_csh () {
  return "";
}

sub gen_epilogue_csh () {
  return "";
}

sub gen_cond_alias_csh ($$$) {
  # Don't need to validate any of the inputs because gen_cond_alias has 
  # already done it for us.
  my $name = shift @_;
  my $value = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .="alias $name $value\n";
  if($debug) {
    $result .= "echo \"env-tool: aliasing $name with $value\"\n";
  }

  return $result;
}

sub gen_cond_var_csh ($$$$$) {
  # Don't need to validate any of the inputs because gen_cond_var has 
  # already done it for us.
  my $variable = shift @_;
  my $additions_array = shift @_;
  my $default = shift @_;
  my $safe = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .="if (\$?$variable) then\n";
  for(@$additions_array) {
    $result .= "  if (! ((\"\$$variable\" =~ *:'$_') || (\"\$$variable\" =~ '$_':*) || (\"\$$variable\" =~ *:'$_':*) || (\"\$$variable\" =~ '$_'))) then\n";
    if($safe) {  
      $result .="    setenv $variable \"\$$variable\"':$_';\n";
    } else {
      $result .="    setenv $variable '$_:'\"\$$variable\";\n";
    } 
    if($debug) {
       $result .="    echo \"env-tool: extending $variable with $_\"\n";
    }
    $result .="  endif\n";
  }
  $result .="else\n  setenv $variable '$default';\n";
  if($debug) {
    $result .="    echo \"env-tool: setting $variable with $_\"\n";
  }
  $result .="endif\n";

  return $result;
}

##############################################################################
### bash shell ######

sub gen_prologue_bash () {

my $result=<<END;
\# Helper function
extend_env() {
case "\${!1}" in
  "\$2") ;;
  *:"\$2") ;;
  "\$2":*) ;;
  *:"\$2":*) ;;
  *) if \$4; then
       echo "env-tool: extending \$1 with \$2"
     fi 
     if \$3; then
       export \$1="\${!1}:\$2"
     else 
       export \$1="\$2:\${!1}"
     fi;;
esac
}
extend_env_list () { 
  local in_array;
  in_array=( \$2 );
  for ext in \${in_array[@]}
  do
    extend_env \$1 \$ext \$3 \$4
  done
}


END

  return $result;
}

sub gen_epilogue_bash () {
  return "\nunset -f extend_env\nunset -f extend_env_list\n";
}

sub gen_cond_alias_bash ($$$) {
  # Don't need to validate any of the inputs because gen_cond_alias has 
  # already done it for us.
  my $name = shift @_;
  my $value = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .= "alias $name=$value\n";
  if($debug) {
    $result .="echo \"env-tool: aliasing $name with $value\"\n";
  }

  return $result;
}

sub gen_cond_var_bash ($$$$$) {
  # Don't need to validate any of the inputs because gen_cond_var has 
  # already done it for us.
  my $variable = shift @_;
  my $additions_array = shift @_;
  my $default = shift @_;
  my $safe = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .= "case \"x\${$variable:-y}\" in\n  xy)";
  $result .= " export $variable='$default'";
  if($debug) {
    $result .="\n    echo \"env-tool: setting $variable with $default\"";
  }
  $result .=";;\n  *)\n";
    
  my $safe_string = undef;
  my $debug_string = undef;
  if($safe) { $safe_string = "true"; } else { $safe_string = "false" } 
  if($debug) { $debug_string = "true"; } else { $debug_string = "false" } 
  $result .="    TEMPARRAY=\"".(join(' ', @$additions_array))."\";\n";
  $result .="    extend_env_list $variable \"\$TEMPARRAY\" $safe_string $debug_string;\n";
  $result .= ";;\nesac\n";
  
  return $result;
}


##############################################################################
### Z shell ######

sub gen_prologue_zsh () {

my $result=<<END;
\# Helper function
extend_env() {
case "\${(P)1}" in
  "\$2") ;;
  *:"\$2") ;;
  "\$2":*) ;;
  *:"\$2":*) ;;
  *) if \$4; then
       echo "env-tool: extending \$1 with \$2"
     fi 
     if \$3; then
       export \$1="\${(P)1}:\$2"
     else 
       export \$1="\$2:\${(P)1}"
     fi;;
esac
}
extend_env_list () { 
  for ext in \$@[4,-1]
  do
    extend_env \$1 \$ext \$2 \$3
  done
}
setopt SH_GLOB

END

  return $result;
}

sub gen_epilogue_zsh () {
  return "\nunfunction extend_env\nunfunction extend_env_list\n";
}

sub gen_cond_alias_zsh ($$$) {
  # Don't need to validate any of the inputs because gen_cond_alias has 
  # already done it for us.
  my $name = shift @_;
  my $value = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .= "alias $name=$value\n";
  if($debug) {
    $result .="echo \"env-tool: aliasing $name with $value\"\n";
  }

  return $result;
}

sub gen_cond_var_zsh ($$$$$) {
  # Don't need to validate any of the inputs because gen_cond_var has 
  # already done it for us.
  my $variable = shift @_;
  my $additions_array = shift @_;
  my $default = shift @_;
  my $safe = shift @_;
  my $debug = shift @_;

  my $result = undef;
  $result .= "case \"x\${$variable:-y}\" in\n  xy)";
  $result .= " export $variable='$default'";
  if($debug) {
    $result .="\n    echo \"env-tool: setting $variable with $default\"";
  }
  $result .=";;\n  *)\n";
    
  my $safe_string = undef;
  my $debug_string = undef;
  if($safe) { $safe_string = "true"; } else { $safe_string = "false" } 
  if($debug) { $debug_string = "true"; } else { $debug_string = "false" } 
  $result .="    extend_env_list $variable $safe_string $debug_string " . (join(' ', map { "\"$_\"" } @$additions_array)) . ";\n";
  $result .= ";;\nesac\n";
  
  return $result;
}

##############################################################################
### Glue for all shells ##########

# Spit out any initial setup that is needed
sub gen_prologue ($) {
  my $format = shift @_;
  
  my $result = "\# This file has been automatically generated by env-tool.\n\# You probably do not want to edit this by hand.\n\n";
  
  if($format eq "sh") {
    $result .= gen_prologue_sh();
  } elsif($format eq "csh") {
    $result .= gen_prologue_csh();
  } elsif($format eq "zsh") {
    $result .= gen_prologue_zsh();
  } elsif($format eq "bash") {
    $result .= gen_prologue_bash();
  } else {
    die "gen_prologue: Invalid format $format.";
  }
  
  return $result;
}

# Spit out any closing setup that is needed
sub gen_epilogue ($) {
  my $format = shift @_;
  
  my $result = undef;
  
  if($format eq "sh") {
    $result = gen_epilogue_sh();
  } elsif($format eq "csh") {
    $result = gen_epilogue_csh();
  } elsif($format eq "zsh") {
    $result = gen_epilogue_zsh();
  } elsif($format eq "bash") {
    $result = gen_epilogue_bash();
  } else {
    die "gen_epilogue: Invalid format $format.";
  }

  $result .= "\# Thank you for using env-tool!";

  return $result;
}

# Utitity function to generate shell conditions for aliases
sub gen_cond_alias ($$$$) {
  my $format = shift @_;
  my $name = shift @_;
  # Check that the length is non-zero
  if ((length $name) <= 0) {
    die "gen_cond_alias: Invalid name argument.";
  }
  my $value = shift @_;
  # Check that the length is non-zero
  if ((length $value) <= 0) {
    die "gen_cond_alias: Invalid value argument for alias name $name.";
  }
  my $debug = shift @_;

  my $result = undef;
  
  if($format eq "sh") {
    $result = gen_cond_alias_sh($name, $value, $debug);
  } elsif($format eq "csh") {
    $result = gen_cond_alias_csh($name, $value, $debug);
  } elsif($format eq "zsh") {
    $result = gen_cond_alias_zsh($name, $value, $debug);
  } elsif($format eq "bash") {
    $result = gen_cond_alias_bash($name, $value, $debug);
  } else {
    die "gen_cond_alias: Invalid format $format for alias $name=$value.";
  }

  return $result;
}

# Utility function to generate shell conditionals for assigning variables
sub gen_cond_var ($$$$$$) {
  my $format = shift @_;
  my $variable = shift @_;
  # Check that the length is non-zero
  if ((length $variable) <= 0) {
    die "gen_cond_var: Invalid variable argument.";
  }
  my $additions_array = shift @_;
  my $default = shift @_;
  my $safe = shift @_;
  my $debug = shift @_;

  my $result = undef;

  if($format eq "sh") {
    $result = gen_cond_var_sh($variable, $additions_array, $default, $safe, $debug);
  } elsif ($format eq "csh") {
    $result = gen_cond_var_csh($variable, $additions_array, $default, $safe, $debug);
  } elsif ($format eq "zsh") {
    $result = gen_cond_var_zsh($variable, $additions_array, $default, $safe, $debug);
  } elsif ($format eq "bash") {
    $result = gen_cond_var_bash($variable, $additions_array, $default, $safe, $debug);
  } else {
     die "gen_cond_var: Invalid format $format for variable $variable";
  }

  return $result;
}

##############################################################################


# Scan the specified directory and its children for configuration files, and
# process them
sub collect_environment ($$$) {
    my ($dir, $ignorecache, $ignores) = @_;

    validate_directory $dir, "collect_environment";

    &File::Find::find(
      sub { my $file = $_;
            if(-d $file) { 
              # Is this a directory we should ignore?
              foreach my $f (@default_dir_ignores) {
                if ($f eq $file) {
                  verbosemsg("Ignoring directory $File::Find::name");
                  $File::Find::prune = 1;
                  return;
                }
              }
            
              # If we can't change to this directory, prune it
              if (!(-x $file)) {
                verbosemsg("Ignoring the directory $File::Find::name because change to it");
                $File::Find::prune = 1;
                return; 
              }
            }

            # Does this file match our ignores list?
            if(should_ignore_dir $file, $ignores) {
              verbosemsg("Ignoring .env-config files in: $File::Find::name");
              $File::Find::prune = 1;
              return;
            }    
                          
                         
            # Check for an ignore file and prune to prevent recursing
            if (-f "$file/.env-config-ignore") {
              verbosemsg("Ignoring .env-config files in: $File::Find::name");
              $File::Find::prune = 1;
              return; 
            }
                          
            # Are we ignoring caches? 
            if(!$ignorecache) {
              # Check for a cache file.  
              # If we can read it, process it and prune the directory.
              my $cachefile = "$file/.env-cache.xml";
              # Can we read it? And is a plain old file?
              if ((-f $cachefile) && (-r $cachefile)) {
                verbosemsg("Reading .env-cache.xml file in: $File::Find::name");
                process_file getcwd, $cachefile, $ignores;
                $File::Find::prune = 1;
                return;
              }
            }  
                          
            # Are we looking at a configuration file?
            if (/^.env-config.xml$/) {
              # Can we read it? And is a plain old file?
              if ((-f $_) && (-r $_)) {
                verbosemsg("Processing $File::Find::dir/$_");
                process_file getcwd, $_, $ignores;
              }                            
          }
         }, $dir);
}

# Write out a script based upon the environment information we have collected
sub gen_script ($$$$$) {
    my ($format, $safe, $debug, $envtableref, $keypairref) = @_;

    verbosemsg("Generating a script for shell type $format"); 

    my $result = gen_prologue $format;

    for(keys %{$envtableref}) {
      #print STDERR "_: [$_]\n";
      if(!(exists $default_environment{$_})) {
        $default_environment{$_} = [];
      }

      #print STDERR "environment{_}: [@{$environment{$_}}]\n";
      my $default = join(":", (@{$default_environment{$_}}, @{${$envtableref}{$_}}));
      #print STDERR "default: [$default]\n";

      $result .= gen_cond_var($format, $_, ${$envtableref}{$_}, $default, $safe, $debug);
      $result .= "\n";      
    }
    
    # Create aliases
    if(!$safe) { 
      foreach my $pair (@{$keypairref}) {
        my ($name, $value) = @{$pair};
        $result .= gen_cond_alias($format, $name, $value, $debug);
      }
    }

    $result .= gen_epilogue($format);
    return $result;
}

#####################################################################

## Bits to do with verbosity
## Maybe in some future version have levels of verbosity.

# Use a global reference so we don't need to pass this around 
my $verboseref = undef;

sub verbosemsg ($) {
  my $msg = shift;
  if($$verboseref) {
    print STDERR $msg,"\n";
  }
}

#####################################################################

## Bits to do with the locking mechanism.

# Use a global reference so we don't need to pass this around
my $lockfileref = undef;

sub detect_lock () {
  verbosemsg("Checking to see if the lockfile \"$$lockfileref\" exists.");
  return (-e $$lockfileref);
}

sub acquire_lock () {
  verbosemsg("Attempting to acquire the lockfile \"$$lockfileref\".");
  if (-e $$lockfileref) {
    die "acquire_lock: lock already exists!";
  } else {
    open(LOCK, ">$$lockfileref");
    print LOCK <<END;
env-tool scanning in progress...
Do not disturb -- unless somehow the owning 
env-tool process has died without cleaning up.
END

   close(LOCK);
   verbosemsg("Lockfile \"$$lockfileref\" acquired");
  }
}

sub remove_lock () {
  verbosemsg("Attempting to remove the lockfile \"$$lockfileref\".");
  if (-e $$lockfileref) {
    if ((unlink $$lockfileref) != 1) {
      die "remove_lock: somehow failed to remove the lock!";
    }
  } else {
    die "remove_lock: tried to remove nonexistant lock!"
  }
  verbosemsg("Lockfile \"$$lockfileref\" removed.");
}

#####################################################################

sub cache_toplevel (\@$$$$) {
  my ($dirsref, $outputdir, $test, $lock, $ignores) = @_;
  my @dirs = @$dirsref;
  
  validate_directory $outputdir, "cache_toplevel";
  foreach my $dir (@dirs) { validate_directory $dir, "cache_toplevel"; }
  
  # Create a lock file so that we don't wind up with multiple instances
  # scanning when several terminals are opened in a short span of time
  # Set up some signal handlers
  
  if ($lock) {
    if (detect_lock()) {
      print "Another env-tool process is already running.\n";
      exit 1;
    } else {
      config_signals();
      acquire_lock();
    }
  }  

  # Scan and collect environment information
  foreach my $dir (@dirs) { collect_environment $dir, $true_const, $ignores; }

  # Search and write to our temporary file
  my $cachedata = gen_cache();
 
  if(!$test) {
    # Create a reasonably race-free temporary filename
    my $tmp_file = "$outputdir/.env-cache.".(unpack("H*", pack("Nn", rand, time, $$)));
    # Specifiy our destination file
    my $dest_file = "$outputdir/.env-cache.xml";
    
    open(CACHE, ">$tmp_file");
    print CACHE $cachedata;
    close(CACHE);
      
    # Atomically update, on systems that have rename(2)
    rename($tmp_file, $dest_file);
  }
  
  if($lock) {
    # Eliminate the lock file
    remove_lock();
  }  
}

# Does most of the actual work
sub script_toplevel (\@\@$$$$$$$$$) {
  my ($dirsref, $formatsref, $bg, $condbg, $outputdir, $safe, $debug, $test, $lock, $ignorecache, $ignores) = @_;
  
  my @dirs = @$dirsref;
  my @formats = @$formatsref;
  
  validate_directory $outputdir, "script_toplevel";
  foreach my $dir (@dirs) { validate_directory $dir, "script_toplevel"; }

  # Decide whether or not we should run in the background
  my $pid = undef;
  if($bg) {
    $pid = fork;
  } elsif ($condbg) { 
    # Check to see whether scripts exist
    if((-e "$outputdir/.env-tool.sh" && (grep ("sh", @formats))) || 
       (-e "$outputdir/.env-tool.bash" && (grep ("bash", @formats))) || 
       (-e "$outputdir/.env-tool.csh" && (grep ("csh", @formats))) || 
       (-e "$outputdir/.env-tool.zsh" && (grep ("zsh", @formats)))) {
      $pid = fork;
    } else {
      $pid = 0;
    }
  } else {
    $pid = 0;
  }

  # Are we the process that is going to do the work?
  if($pid == 0) {
    # Create a lock file so that we don't wind up with multiple instances
    # scanning when several terminals are opened in a short span of time
    # Set up some signal handlers
    if ($lock) {
      if (detect_lock()) {
        print "Another env-tool process is already running.\n";
        exit 1;
      } else {
        config_signals();
        acquire_lock();
      }
    }  

      # Do this here because otherwise Perl segfaults.  I don't know why.
      $cm_exists = &sml_cm_exists();
      @cm_path = ();

      # *** Should only run this if an extension to CM_PATH has been
      # requested.
      if($cm_exists) {
        @cm_path = &obtain_cm_path();
      }

      # Scan and collect environment information
      foreach my $dir (@dirs) { collect_environment $dir, $ignorecache, $ignores; }

      # Initialize the default environment
      init_default_environment();

      # For each type of script, atomically update it.
      foreach my $format (@formats) {
    
        # Search and write to our temporary file
        my %envtable = build_environment_variable_defs();
        my @keypairs = build_alias_keypairs();
        my $script = gen_script $format, $safe, $debug, \%envtable, \@keypairs;
    
        if (!$test) {
          # Create a reasonably race-free temporary filename
          my $tmp_file = "$outputdir/.env-tool.".(unpack("H*", pack("Nn", rand, time, $$))).$format;
          # Specifiy our destination file
          my $dest_file = "$outputdir/.env-tool.".$format;
    
          open(SCRIPT, ">$tmp_file");
          print SCRIPT $script;
          close(SCRIPT);

          # Atomically update, on systems that have rename(2)
          rename($tmp_file, $dest_file);
        }   
      }

      if($lock) {
        # Eliminate the lock file
        remove_lock();
      }  
  }    
}

#####################################################################

sub config_signals () {
  verbosemsg("Setting up signal handlers.");
  # Setup signal handlers to clean up lock files.
  sub catch_signal {
    my $signame = shift;
    remove_lock();
    die "Somebody set us up the SIG$signame!";
  }

  # Catch all the ones that might cause us to exit
  $SIG{INT} = \&catch_signal;  
  $SIG{KILL} = \&catch_signal; 
  $SIG{ALRM} = \&catch_signal; 
  $SIG{HUP} = \&catch_signal; 
  $SIG{PIPE} = \&catch_signal; 
  $SIG{POLL} = \&catch_signal; 
  $SIG{PROF} = \&catch_signal; 
  $SIG{TERM} = \&catch_signal; 
  $SIG{USR1} = \&catch_signal; 
  $SIG{USR2} = \&catch_signal; 
  $SIG{VTALRM} = \&catch_signal; 
  $SIG{STKFLT} = \&catch_signal;

  # Catch all the ones that might cause us to core dump
  $SIG{ABRT} = \&catch_signal; 
  $SIG{FPE} = \&catch_signal; 
  $SIG{ILL} = \&catch_signal; 
  $SIG{QUIT} = \&catch_signal; 
  $SIG{SEGV} = \&catch_signal; 
  $SIG{TRAP} = \&catch_signal; 
  $SIG{SYS} = \&catch_signal; 
  $SIG{BUS} = \&catch_signal; 
  $SIG{XCPU} = \&catch_signal; 
  $SIG{XFSZ} = \&catch_signal; 
}

#####################################################################

### Actual program execution begins here
   
# Did the user request help?
my %cmdoptions = ();
GetOptions(\%cmdoptions, "h", "help", "bash", "csh", "sh", "zsh", "bg", "condbg", "cache", 
                         "verbose", "safe", "debug", "test", "lock", "ignores=s@",
                         "ignorecache", "outputdir=s");

$verboseref = \$cmdoptions{verbose};

# Check to see whether we need to print usage
if($cmdoptions{h} || $cmdoptions{help}) {
  &print_usage();
}

# If we are building a cachefile, definitely ignore caches.
if($cmdoptions{cache}) {
  $cmdoptions{ignorecache} = $cmdoptions{cache}
}

my $outputdir = undef;
if($cmdoptions{outputdir}) {
  $outputdir = $cmdoptions{outputdir};
} else {
  verbosemsg("No output directory specified, using $ENV{HOME}");
  $outputdir = $ENV{HOME};
}
validate_directory $outputdir, "env-tool";

$lockfileref = \"$outputdir/.env-tool.lock";


# The remaining options should be directories
my @dirs = @ARGV;

# If there are no directories specified add the current one.
if((scalar @dirs) == 0) {
  push @dirs, getcwd;
}

foreach my $dir (@dirs) { validate_directory $dir, "env-tool"; }

if($cmdoptions{cache}) {
  option_error $cmdoptions{bg}, "bg", "cache";
  option_error $cmdoptions{condbg}, "condbg", "cache";
  option_error $cmdoptions{safe}, "safe", "cache";
  option_error $cmdoptions{debug}, "debug", "cache";
  option_error $cmdoptions{sh}, "sh", "cache";
  option_error $cmdoptions{bash}, "bash", "cache";
  option_error $cmdoptions{csh}, "csh", "cache";
  option_error $cmdoptions{zsh}, "zsh", "cache";

  cache_toplevel @dirs, $outputdir, $cmdoptions{test}, $cmdoptions{lock}, 
                 \@{$cmdoptions{ignores}};
} else {

  # Can't use --bg and --condbg simultaneously
  if($cmdoptions{bg} && $cmdoptions{condbg}) {
    &print_usage();
  }

  # Check to see which format files we should generate
  my @formats = ();
  if($cmdoptions{csh}) {
    push @formats, "csh";
  }
  if($cmdoptions{bash}) {
    push @formats, "bash";
  }
  if($cmdoptions{sh}) {
    push @formats, "sh";
  }
  if($cmdoptions{zsh}) {
    push @formats, "zsh";
  }
  # None were selected? Do all
  if((scalar @formats) == 0) {
    @formats = ("bash", "sh", "csh", "zsh");
  }
  
  script_toplevel @dirs, @formats, $cmdoptions{bg}, $cmdoptions{condbg}, $outputdir,
                  $cmdoptions{safe}, $cmdoptions{debug}, $cmdoptions{test}, $cmdoptions{lock},
                  $cmdoptions{ignorecache}, \@{$cmdoptions{ignores}};
  
}

# Exit successfully 
exit 0;

=head1 NAME

env-tool - a tool for constructing a script to set up a user's environment

=head1 SYNOPSIS

B<env-tool> [B<-h>|B<--help>] [B<--verbose>] [B<--ouputdir> dir]

[B<--ignores> re] [B<--lock>] [B<--test>] 

[B<--sh>] [B<--csh>] [B<--zsh>] [B<--bash>]

[B<--ignorecache>] [B<--bg>|B<--condbg>] [B<--safe>] [B<--debug>]  

[B<--cache>] [directories...]

=head1 DESCRIPTION

env-tool's default mode of operation is script generation.  env-tool will
scan the specified directories, or the current if none were specified,
and their children for environment configuation files.  env-tool will
then atomically create outputdir/.env-tool.{bash,csh,sh,zsh} depending
upon the supplied options.  If no specific shell format was specified, all
will be generated.

env-tool also has a cache file generation mode that will scan directories and 
produce an environment configuration file that simulates the result of scanning
the specified directory trees.  

Environment configuration files are XML documents named either
.env-config.xml or .env-cache.xml and containing some number of alias
and environment variable definitions.  If a directory contains a file
named .env-config-ignore, it and its subdirectories are ignored.  If a
directory contains a .env-cache.xml file, the file is read but its
subdirectories are ignored.

A possible csh-style shell configuration to use env-tool might look
like the following lines added to one's .cshrc file:

  setenv UNSUPPORTED /mnt/eclipse/unsupported
  setenv UNSUPDIRS $UNSUPPORTED/generic $UNSUPPORTED/linux
  if (-x "$UNSUPPORTED/env-tool") then
      # If we do not disconnect it from the tty, then Emacs hangs
      # waiting for this when running a shell command.
      (cd; "$UNSUPPORTED/env-tool" --csh --condbg $UNSUPDIRS) >& /dev/null < /dev/null
  endif

  if (-r "$HOME/.env-tool.csh") then
      source "$HOME/.env-tool.csh"
  endif

A possible sh-style shell configuration to use env-tool might look
like the following lines added to one's .profile file:

  export UNSUPPORTED=/mnt/eclipse/unsupported
  export UNSUPDIRS=${UNSUPPORTED}/{generic,linux}
  [ -x "${UNSUPPORTED}/env-tool" ] &&
  # If we do not disconnect it from the tty, then Emacs hangs
  # waiting for this when running a shell command.
  (${UNSUPPORTED}/env-tool --sh --condbg ${UNSUPDIRS}) > /dev/null 2>&1 0<&1

  [ -r "${HOME}/.env-tool.sh" ] && . "${HOME}/.env-tool.sh"

Finally, when using Z-shell one should place the following bit of code 
in your .zshrc file:
  
  export UNSUPPORTED=/mnt/eclipse/unsupported
  export UNSUPDIRS=${UNSUPPORTED}/{generic,linux}
  [ -x "${UNSUPPORTED}/env-tool" ] &&
  # If we do not disconnect it from the tty, then Emacs hangs
  # waiting for this when running a shell command.
  (${UNSUPPORTED}/env-tool --zsh --condbg ${UNSUPDIRS}) > /dev/null 2>&1 0<&1

and this line in your .zshenv file:

  [ -r "${HOME}/.env-tool.zsh" ] && . "${HOME}/.env-tool.zsh"


A possible .env-config.xml or .env-cache.xml file might look like:

  <?xml version="1.0" encoding="UTF-8"?>
  <env-config version="1.2">
    
    <!-- An alias element will create a shell alias "foo" for "bar",
         if the user has not already defined an alias "foo".  Aliases will
         not be defined if the user has chosen "safe" mode.
         
    -->
    <alias name="foo" value="bar"/>
    
    <!-- A relative-alias element will create a shell alias "foo" 
         with the current dirrectory plus the tag contents.  Aliases will
         not be defined if the user has chosen "safe" mode.
    -->
    <relative-alias name="foo">/bin</relative-alias>

    <!-- A content-less variable element will just add the current 
         directory to the environment variable.
    -->
    <variable name="PATH" />
    
    <!-- This will add the current directory plus the tag contents 
         to the specified environment variable.
    -->
    <variable name="PATH">/bin</variable>

    <!-- A absolute-variable elements will simply add the enclosed text
         to the specified environment variable.
    -->
    <absolute-variable name="PATH">/bin</absolute-variable>

    <!-- Variable elements with contents are added to the environment
         variable with the present directory, a slash, and the contents
         of the variable element.
    -->
    <variable name="CLASSPATH">bar.jar</variable>

    <!-- CM_PATH is special, in that if you do not already have
         CM_PATH set, it will query sml-cm to find out what the 
         default should be in order to extend it rather than overriding
         it.
    -->
    <variable name="CM_PATH" />

    <!-- kpathsea environment variables also behave slightly differently
         as well. If the contents of the variable are "//", then
         the current directory followed by two slashes will be added.
         Additionally, the empty path will be added be default if the
         variable does not exist in the environment.
    -->
    <variable name="TEXINPUTS">//</variable>

    <!-- env-tool recognizes certain variables as being used by kpathsea,
         but if you need to force the correct behavior you can use
         kpathsea-variable. -->
    <kpathsea-variable name="FOOINPUTS">//</kpathsea-variable>
    
    <!-- It is possible to override the name of the current directory
         using a directory tag.  Directory tags may not be nested.  This
         is mostly useful for building cache files. -->
    <directory name="/usr/local/bin"><variable name="PATH" /></directory>

  </env-config>

The options are:

=over 4

=item [B<-h>|B<--help>]

print usage information

=item [B<--verbose>]

prints detailed information about the actions of env-tool to standard error. 

=item B<--outputdir> dir

create output files in the specified directory rather than in ~/. 

=item B<--sh>

create outputdir/.env-tool.sh, a script for Bourne descended shells

=item B<--csh>

create outputdir/.env-tool.csh, a script for C-Shell descended shells

=item B<--zsh>

create outputdir/.env-tool.zsh, a script optimized for Z shell

=item B<--bash>

create outputdir/.env-tool.bash, a script optimized for the Bourne Again Shell

=item B<--ignores> re

prune the specified regular expression from the search.  May be used any number of times.

=item B<--lock>

force locking to avoid multiple instances of env-tool from running
simultaneously.  Creates a file outputdir/.env-tool.lock that in rare
circumstances can be accidentally left behind if the process is killed
in an unforeseen fashion.

=item B<--bg>

run in the background during script generation.  
Only one env-tool process may run at a time if --lock is used.

=item B<--condbg>

run in the background during script generation if outputdir/.env-tool.{bas,csh,sh,zsh}
already exist.  Only one env-tool process may run at a time --lock is used.

=item B<--safe>

env-tool produces configuration files that attempt to be innocuous.  That is
instead of prepending extensions to environment variables, they will be extended,
and no aliases will be defined.

=item B<--debug>

the shell code produce will print debugging information about its actions.

=item B<--test>

run as specified, but do not write output to a file.

=item B<--ignorecache>

during script generation ignore .env-cache.xml cache files.  During cache
generation cache files are alway ignored.

=item B<--cache>

specify cache generation mode.

=head1 VERSION

$Id: env-tool 39 2005-08-13 17:44:21Z geoffw $

=head1 AUTHOR

Geoffery Alan Washburn <washburn@acm.org>

=head1 LICENSE

Copyright Geoffrey Alan Washburn, 2005.

Some parts copyright Trustees of Boston University, 2002.

Some parts copyright Joe B Wells, 2002.

You can redistribute and/or modify this software under the terms of
the GNU General Public License as published by the Free Software
Foundation; either version 2, or (at your option) any later version.

This software is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You may obtain the GNU General Public License by writing to the Free
Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.

=cut

# Local variables:
# mode: perl
# end: