#!/usr/bin/perl -- -*- perl -*-
#
# Copyright (c) 2002-2004 The Trustees of Indiana University.  
#                         All rights reserved.
#
# This file is part of the Env-switcher software package.  For license
# information, see the LICENSE file in the top-level directory of the
# Env-switcher source distribution.
#
# $Id: switcher.in,v 1.19 2004/03/07 22:06:55 jsquyres Exp $
#
# Main workhorse for the env-switcher package.
#

use Data::Dumper;
use strict;

#
# Global variables
#

my $prefix = "/opt/env-switcher";
my $system_filename = "/opt/env-switcher/etc/switcher.ini";
my $tag_dir = "/opt/env-switcher/share/env-switcher";
my $user_filename = $ENV{'HOME'} . "/.switcher.ini";

my $global_tag = "global";

my $announce_attribute = "announce";
my $default_attribute = "default";
my $exists_attribute = "exists";

my $default_announce_value = "none";

# Initialize some action indicators

my $user_tags_modified = 0;
my $system_tags_modified = 0;

my $switcher_silent = 0;
my $switcher_force = 0;
my $switcher_system = 0;
my $switcher_user = 0;

my $announce_load = 0;
my $announce_warn = 0;
my $announce_error = 0;

my $clui_tag;
my $system_tags;
my $user_tags;

############################################################################
#
# print_warning
#
# Similar to printf, but don't print anything if --silent was given on
# the command line.  If --silent was not given, print to stderr.
#
############################################################################

sub print_warning {
    my ($str) = @_;

    return if ($switcher_silent);
    print STDERR $str;
}

############################################################################
#
# print_error
#
# Similar to printf; print to stderr.  Right now, --silent does not
# override this.
#
############################################################################

sub print_error {
    my ($str) = @_;

    print STDERR "ERROR: $str";
}

############################################################################
#
# display_help
#
# Show the help message.
#
############################################################################

sub display_help {
    print "switcher syntax:

General options (applied to most major commands)
  --force    Do the action without prompting for confirmation
  --silent   Do not print any status/warning messages
             (equivalent to setting \"announce\" tag to \"error\")

Most commonly used option:
  \$ switcher <tag> = <name>

For example:
  \$ switcher mpi = lam-7.0.2

To list all available <tag> and <name> values, use:

  \$ switcher --list        # List all available <tag> values
  \$ switcher <tag> --list  # List all available <name> values for <tag>

For more help, type \"switcher --more-help\" or \"man switcher\"
";
}

############################################################################
#
# display_more_help
#
# Show the more detailed help message.
#
############################################################################

sub display_more_help {
    print "switcher syntax:

General options (applied to most major commands)
  --force    Do the action without prompting for confirmation
  --silent   Do not print any status/warning messages

Set a tag equal to a name
  \$ switcher <tag> = <name>

List all available tags
  \$ switcher --list            

List all available names for <tag>
  \$ switcher <tag> --list      

Resolve and show all atrributes for <tag> for system scope, user
scope, or effective scope
  \$ switcher <tag> --show [--system|--user]
  (--system or --user must be the last argument)

Add the tag <tag>
  \$ switcher <tag> --add-tag

Remove the tag <tag>
  \$ switcher <tag> --rm-tag

Add the name <name> to <tag>, and copy the modulefile named \"<name>\"
from the directory <dir>
  \$ switcher <tag> --add-name <name> <dir>

Remove the name <name> from <tag>
  \$ switcher <tag> --rm-name <name>

Add the attribute <attribute> with value <value> to a <tag> in the
system or user scope (--user is implied)
  \$ switcher <tag> --add-attr <attribute> <value> [--system|--user]
  (--system or --user must be the last argument)

Remove <attribute> from <tag> in the system or user scope (--user is
implied)
  \$ switcher <tag> --rm-attr <attribute> [--system|--user]
  (--system or --user must be the last argument)
";
}

############################################################################
#
# get_yn_prompt
#
# Display a prompt and get a "y" or "n" answer.  If "" is supplied,
# use a default value.  Return either "y" or "n" (guaranteed to be
# lower case) answer to the caller.
#
############################################################################

sub get_yn_prompt {
    my ($prompt, $default_answer) = @_;
    my $answer;

    # Loop until we get a valid answer

    while (1) {
	print $prompt;
	chomp($answer = <STDIN>);
	if ($answer eq "") {
	    $answer = $default_answer;
	}
	if ($answer =~ /[yn]/i) {
	    last;
	}
	print "\nPlease answer \"y\" or \"n\"\n\n";
    }

    # Return a lower case version of the answer

    lc($answer);
}

############################################################################
#
# resolve_attribute
#
# Resolve an attribute for a given tag.  Use the following order for
# resolution:
#
# 1. Look for the tag/attribute combination in the user's defaults.
# 2. If not found there, look for the attribute in the user's "global"
#    section.
# 3. If not found there, look for the tag/attribute combination in the
#    system's defaults.
# 4. If not found there, look for the attribute in the system's
#    "global" section.
# 5. If not found there, return an empty string.
#
############################################################################

sub resolve_attribute {
    my ($system, $user, $tag, $attribute) = @_;

    my $tags;
    my $level;

    # Look through all the strings indicated in the function
    # description, and return the first one of them that is defined,
    # or "" if none of them are defined.

    if ($system == 1) {
        $tags = $system_tags;
        $level = "system";
    } elsif ($user == 1) {
        $tags = $user_tags;
        $level = "user";
    } else {
        my $found;
        my $attr;
        ($found, $attr) = resolve_attribute(0, 1, $tag, $attribute);
        ($found, $attr) = resolve_attribute(1, 0, $tag, $attribute)
            if ($found == 0);
        return ($found, $attr);
    }

    # Look in the tags for the value.  First look for the attribute in
    # the specific tag.

    if (defined($tags->{$tag}) &&
        defined($tags->{$tag}->{$attribute})) {
        return (1, {
            tag => $tag,
            attribute => $attribute,
            value => $tags->{$tag}->{$attribute},
            level => $level,
        });
    }

    # If we didn't find it there, look for it in the global tag.

    if (defined($tags->{$global_tag}) && 
        defined($tags->{$global_tag}->{$attribute})) {
        return (1, {
            tag => $global_tag,
            attribute => $attribute,
            value => $tags->{$global_tag}->{$attribute},
            level => $level,
        });
    }

    # Didn't find anything; return blank

    return (0, {});
}

############################################################################
#
# resolve_tag
#
# Return an anonymous hash of resolved attributes for a given tag.
# This function assumes that the tag does exist.  The hash will
# contain the union of attributes from:
#
# - When resolving just against the user file:
#   - specific tag section from the user's file
#   - global tag section from the user's file
#
# - When resolving just against the system file:
#   - specific tag section from the system's file
#   - global tag section from the system's file
#
# - Otherwise:
#   - specific tag section from the user's file
#   - global tag section from the user's file
#   - specific tag section from the system's file
#   - global tag section from the system's file
#
# Rules for order of precedence of resolution are defined by the
# resolve_attribute subroutine.
#
############################################################################

sub resolve_tag {
    my ($system, $user) = @_;
    my $collated_names;
    my $attributes;

    # Define "$both" as the overall scope

    my $both = ($system == 0 && $user == 0) ? 1 : 0;
    
    # Get a list of attributes from the user scope

    if ($both || $user) {
        foreach my $tag ($global_tag, $clui_tag) {
            if (defined($user_tags->{$tag})) {
                foreach my $key (keys %{$user_tags->{$tag}}) {
                    $collated_names->{$key} = 1;
                }
            }
        }
    }

    # Get a list of attributes from the system scope

    if ($both || $system) {
        foreach my $tag ($global_tag, $clui_tag) {
            if (defined($system_tags->{$tag})) {
                foreach my $key (keys %{$system_tags->{$tag}}) {
                    $collated_names->{$key} = 1;
                }
            }
        }
    }

    # Now resolve all the attribute names that we found in the desired
    # scope.

    foreach my $key (keys(%{$collated_names})) {
        my ($found, $result) = resolve_attribute($system, $user, 
                                                 $clui_tag, $key);
        if ($found) {
            $attributes->{$key} = $result;
        }
    }

    # Return the hash

    $attributes;
}


############################################################################
#
# resolve_announce
#
# Figure out which kind of announcements we want.  Since this is a
# per-tag kind of decision, it's a subroutine.  Load up the global
# variables $announce_load, $announce_warn, $announce_error to each be
# either 0 or 1.
#
############################################################################

sub resolve_announce {
    my ($a) = @_;

    if (!$a) {
        $a = $default_announce_value;
    } elsif ($a =~ /all/i) {
	$a = "warn,error,load";
    }

    if (!$switcher_silent) {
	if ($a =~ /all/i) {
	    $announce_error = $announce_warn = $announce_load = 1;
	} 
	if ($a =~ /warn/i) {
	    $announce_warn = 1;
	}
	if ($a =~ /error/i) {
	    $announce_error = 1;
	}
	if ($a =~ /load/i) {
	    $announce_load = 1;
	}
    }
}

############################################################################
#
# list_tags
#
# List all available tags.  This can be done in two ways:
#
# 1. list all the section names in the system-default.ini file
# 2. list all the directory names in the $tag_dir directory
# 
# Hypothetically, these two should always be in sync.  However, it
# seems easier for the #2 to get out of sync by having sysadmins put
# junk in the $tag_dir directory, so we'll go with #1.  Hence, if a
# tag does not have a corresponding section in system-default.ini, it
# doesn't exist.
#
############################################################################

sub list_tags {
    foreach my $tag (sort(keys(%{$system_tags}))) {
        print "$tag\n"
            if ($tag ne $global_tag);
    }
}

############################################################################
#
# list_names
#
# List all the names for a given tag.  Simply traverse $tag_dir/<tag>
# and list all files in there (excluding files named .version).
#
############################################################################

sub list_names {
    my $dir = "$tag_dir/$clui_tag";

    # Special case -- ignore the "global" tag

    if ($clui_tag eq $global_tag) {
	return 0;
    }

    # Check to ensure that the tag exists in the system-default.ini
    # file

    if (!defined($system_tags->{$clui_tag})) {
	print_error("Tag \"$clui_tag\" does not exist\n");
	return 1;
    }

    # Check to ensure the directory exists.  Technically, this is an
    # error, because we have confirmed that that the tag is supposed
    # to exist because it is in the system-default.ini file.

    if (! -d $dir) {
	print_error("Tag directory \"$dir\" does not exist\n");
	return 1;
    }

    # Open the directory 

    if (!opendir DIR, $dir) {
	print_error("Unable to open tag directory \"$dir\"\n");
	return 1;
    }

    # Traverse all the files in there (not subdirectories, and not
    # files named .version).

    my @files = grep { $_ ne ".version" && -f "$dir/$_" } readdir(DIR);
    foreach (@files) {
	print "$_\n";
    }

    # All done

    closedir DIR;

    return 0;
}

############################################################################
#
# add_tag
#
# If the tag already exists (i.e., if it exists in the system_tags
# hash)
#
# - if !$switcher_force, prompt to empty the contents of the tag
# - if yes, or if $switcher_force, empty the contents of the tag
#
# If the tag does not already exist:
#
# - add an entry in the system_tags hash
# - if $tag_dir/$clui_tag already exists, print out a warning
# - if $tag_dir/$clui_tag does not already exist, make it
# 
# Mark the system-default file as modified so that it will be saved on
# the way out of the script.
#
############################################################################

sub add_tag {
    # See if the tag already exists in the system_tags hash

    if (defined($system_tags->{$clui_tag})) {
	if ($switcher_force) {
	    !rm_tag() || return 1;
	} else {

	    # Prompt and get a valid input
	    
	    my $answer = get_yn_prompt("Tag \"$clui_tag\" already exists\n" .
				       "Delete all of its names (y/N)? ", "n");

	    # Do we want to delete it?

	    if ($answer eq "y") {
		!rm_tag() || return 1;
	    } else {
		print "Names for tag \"$clui_tag\" NOT deleted\n";
		return 1;
	    }
	}
    }

    # By this point, the tag is guaranteed not to be in the
    # system_tags hash.  So add it (it has no attributes), and mark
    # the file as dirty so that it will be saved on the way out.

    $system_tags->{$clui_tag}->{$exists_attribute} = 1;
    $system_tags_modified = 1;

    # Now go test and see if $tag_dir/env-switcher/$clui_tag exists.
    # If it does, print a warning.  If not, attempt to create it.

    my $dir = "$tag_dir/$clui_tag";
    if (opendir DIR, $dir) {
	print_warning("Warning: tag directory already exists:\n" .
		      "  $dir\n" .
		      "Warning: previous files not deleted, " .
		      "but no names added to tag \"$clui_tag\"\n");
    } else {
	if (!mkdir $dir) {
	    print_error("Unable to create tag directory ".
			"\"$dir\"\n");
	}
    }

    # Upon success, silence is golden

    0;
}

############################################################################
#
# rm_tag
#
############################################################################

sub rm_tag {
    # Ensure that the tag already exists in the system_tags hash

    if (!defined($system_tags->{$clui_tag})) {
	print_error("Tag \"$clui_tag\" does not exist\n");
	return 1;
    }

    # Remove the tag's directory.  Use a quick sanity check before
    # attempting to remove it to see if we seem to have permission to
    # remove it.  Cheat and use system() to invoke "rm -rf ..." rather
    # than implementing rm -rf.

    my $dir = "$tag_dir/$clui_tag";
    if (! -w $dir || system("rm -rf $dir") != 0) {
	print_error("Unable to remove tag directory:\n" .
		    "  $dir\n" .
		    "Tag NOT removed\n");
	return 1;
    }

    # Remove all the attributes for this tag

    delete $system_tags->{$clui_tag};
    $system_tags_modified = 1;
    if (defined($user_tags->{$clui_tag})) {
        delete $user_tags->{$clui_tag};
        $user_tags_modified = 1;
    }

    # Upon success, silence is golden

    0;
}

############################################################################
#
# add_name
#
# Create a name under a specified tag.
#
# If the tag/name combination already exists, prompt to see if we want
# to overwrite it (unless --force was provided, then just do it
# silently).
#
# If the tag doesn't already exist, call add_tag to silently make the
# tag before adding the name.
#
############################################################################

sub add_name {
    my ($name, $src_dir) = @_;
    my $dir = "$tag_dir/$clui_tag";
    my $dest_file = "$dir/$name";
    my $src_file = "$src_dir/$name";

    # Does the tag already exist?  If not, go create it.

    if (!defined($system_tags->{$clui_tag})) {
	!add_tag() || return 1;
    }

    # Quick sanity check to see if we can write to the tag directory

    if (! -w $dir) {
	print_error("You do not have permission to write to the " .
		    "tag directory:\n" .
		    "  $dir\n" .
		    "\"$clui_tag\"/\"$name\" combination NOT created\n");
	return 1;
    }

    # Does the name already exist?

    if (-f $dest_file) {
	print_warning("Warning: there already exists a " .
                      "\"$clui_tag\"/\"$name\" combination\n");
	!rm_name($name) || return 1;
	print_warning("Warning: prior \"$clui_tag\"/\"$name\" combination " .
		      "removed\n");
    }

    # Corner case: if we're replacing the only name that exists on a
    # tag, then we just removed the whole thing -- including the tag.
    # So ensure that the tag still exists, and if it doesn't, create
    # it.  Do the same thing that we did above -- check for existence
    # of the tag and make it if it doesn't exit.  It makes sense to do
    # this same check twice instead of just deferring until now to do
    # it because we *need* to check for the existence of the tag
    # first, yadda, yadda, yadda because if we don't, it may be
    # possible to remove a file in the destination directory that may
    # not be officially registered as a tag/name combination.  Hence,
    # do this here to minimize the chance of stomping on
    # sysadmin-modified/created files.

    if (!defined($system_tags->{$clui_tag})) {
	!add_tag() || return 1;
    }

    # Now everything is clear, and we're good to try to copy the new
    # file into place.  See if the new file exists.

    if (! -r $src_file) {
	print_error("Source file does not exist:\n" .
		    "  $src_file\n" .
		    "\"$clui_tag\"/\"$name\" combination NOT created\n");
	return 1;
    }

    # Copy the file over.  Cheat an use system() to invoke "cp"
    # instead of re-implementing it here.

    if (system("cp $src_file $dest_file") != 0) {
	print_error("Unable to copy source file to destination:\n" .
		    "  $src_file\n" .
		    "  $dest_file\n" .
		    "\"$clui_tag\"/\"$name\" combination NOT created\n");
	return 1;
    }

    # Upon success, silence is golden

    0;
}

############################################################################
#
# rm_name
#
# Remove a name associated with a specific tag.  If the name exists,
# and we have permission to delete it, prompt the user for
# confirmation before actually deleting it, unless "--force" was used,
# in which case delete the name without prompting for confirmation.
#
############################################################################

sub rm_name {
    my ($name) = @_;
    my $dir = "$tag_dir/$clui_tag";
    my $file = "$dir/$name";

    # Does the name exist?

    if (! -f $file) {
	print_error("\"$clui_tag\"/\"$name\" combination does not exist\n");
	return 1;
    }

    # Quick sanity check to see if we seem to have permissions to
    # delete the name
    
    if (! -w $dir || ! -w $file) {
	print_error("You do not have permission to remove the file:\n" .
		    "  $file\n" .
		    "\"$clui_tag\"/\"$name\" combination NOT removed\n");
	return 1;
    }
    
    # Since we now know that we *can* delete it, see if we really want to
    
    if (!$switcher_force) {
	my $answer = get_yn_prompt("Delete \"$clui_tag\"/\"$name\" " .
				   "combination (y/N)? ", "n");
	
	if ($answer eq "n") {
	    print_warning("Warning: \"$clui_tag\"/\"$name\" combination " .
			  "NOT deleted\n");
	    return 1;
	}
    }
    
    # Ok, we've got the go-ahead to remove the name
    
    if (unlink($file) != 1) {
	print_error("Unable to unlink the file:\n" .
		    "  $file\n" .
		    "\"$clui_tag\"/\"$name\" combination NOT removed\n");
	return 1;
    }

    # Was this the last name in this tag?  If so, delete the tag as
    # well.  This is important for the case where RPM's are
    # adding/removing names.  If an RPM creates a name on a tag that
    # doesn't already exist, switcher will create the tag.  If the RPM
    # removes the last name in the tag, the tag should be removed as
    # well.  Consider the following scenario:
    #
    # rpm -ivh modules*rpm switcher*rpm lam-module*rpm
    #
    # --> at this point, the lam-module RPM will do an --add-name on
    # --> the "mpi" tag.  So /opt/switcher*/share/mpi/lam-<version>
    # --> will exist.
    #
    # rpm -e lam-module
    #
    # --> at this point, we want /opt/switcher*/share/ to be empty,
    # --> becuase the lam removed the lam-<version> name.  This will
    # --> allow the following to remove the entire /opt/switcher*
    # --> tree:
    #
    # rpm -e switcher

    # Open the directory and count the number of names left in it

    if (!opendir DIR, $dir) {
	print_error("Unable to open tag directory \"$dir\"\n");
	return 1;
    }
    my @files = grep { $_ ne "." && $_ ne ".." } readdir(DIR);
    closedir DIR;

    # If it was the last one, remove the tag

    if ($#files == -1) {
	return rm_tag();
    }

    # Upon success, silence is golden

    0;
}

############################################################################
#
# add_attr
#
# Add an attribute value under a specified tag.  The attribute may be
# added to either the system or the user file.  
#
############################################################################

sub add_attr {
    my ($attr, $value) = @_;
    my ($tags, $answer);
    
    # Don't allow the addition/modification of the special tag "exists"

    if ($attr eq $exists_attribute) {
	print_error("Cannot add/modify special tag \"$exists_attribute\"\n");
	return 1;
    }

    # Ensure that the tag exists.

    if (!defined($system_tags->{$clui_tag}) && $clui_tag ne $global_tag) {
	print_error("Tag \"$clui_tag\" does not exist\n" .
		    "Attribute \"$attr\" NOT added\n");
	return 1;
    }

    # Decide which scope we're in

    if ($switcher_system == 1) {
	$tags = $system_tags;
	$system_tags_modified = 1;
    } else {
	$tags = $user_tags;
	$user_tags_modified = 1;
    }

    # Does the attribute already exist?

    if (defined($tags->{$clui_tag}->{$attr}) && !$switcher_force) {
	print_warning("Warning: $clui_tag:$attr already has a value:\n" .
		      "  " . $tags->{$clui_tag}->{$attr} . "\n");
	$answer = get_yn_prompt("Replace old attribute value (y/N)? ", "n");
	if ($answer eq "n") {
	    print_warning("Warning: $clui_tag:$attr value NOT changed\n");
	    $user_tags_modified = $system_tags_modified = 0;
	    return 1;
	}
    }

    # Define the attribute

    $tags->{$clui_tag}->{$attr} = $value;

    # Unless silent, remind the user that this will take effect for
    # all new shells.

    if (!$switcher_silent) {
	print "Attribute successfully set; new attribute setting will be " .
	    "effective for\nfuture shells\n";
    }

    0;
}

############################################################################
#
# rm_attr
#
# Delete an attribute from a specified tag.  Unless --force is given,
# prompt for confirmation.
#
############################################################################

sub rm_attr {
    my ($attr) = @_;
    my ($tags, $attr_name, $answer);

    # Ensure that the tag exists.

    if (!defined($system_tags->{$clui_tag})) {
	print_error("Tag \"$clui_tag\" does not exist\n" .
		    "Attribute \"$attr\" NOT removed\n");
	return 1;
    }

    # Don't allow the removal of the special tag "exists"

    if ($attr eq "$exists_attribute") {
	print_error("Cannot remove special tag \"$exists_attribute\"\n");
	return 1;
    }

    # Decide which scope we're in

    if ($switcher_system == 1) {
	$tags = $system_tags;
	$system_tags_modified = 1;
    } else {
	$tags = $user_tags;
	$user_tags_modified = 1;
    }

    # Ensure that the attribute exists

    if (!defined($tags->{$clui_tag}->{$attr}) && !$switcher_force) {
	print_error("\"$clui_tag\"/\"$attr\" combination does not exist\n");
	return 1;
    }

    # Prompt for confirmation unless --force was given

    if (!$switcher_force) {
	$answer = get_yn_prompt("Remove attribute \"$attr\" from tag " .
				"\"$clui_tag\" (y/N)? ", "n");
	if ($answer eq "n") {
	    print "Attribute \"$attr\" NOT removed from tag \"$clui_tag\"\n";
	    return 1;
	}
    }

    # Whack it

    delete($tags->{$clui_tag}->{$attr});

    # Upon success, silence is golden

    0;
}

############################################################################
#
# show
#
# Display all the attributes for a given tag.  Limit the scope of
# resolution according to the --system and --user flags.
#
############################################################################

sub show {
    # Ensure that this tag exists

    if (!defined($system_tags->{$clui_tag})) {
	print_error("Tag \"$clui_tag\" does not exist\n");
	return 1;
    }

    # Select all the attributes for this tag and sort them

    my $attributes = resolve_tag($switcher_system, $switcher_user);

    # Display what we got back

    foreach my $key (sort(keys(%{$attributes}))) {
        print $attributes->{$key}->{level} . ":$key=" .
            $attributes->{$key}->{value} . "\n";
    }

    # Upon success, silence is golden

    0;
}

############################################################################
#
# examine_tags
#
# Look at all tags, resolve all the attributes, and either output the
# list of module commands to execute that will setup the environment,
# or display an announcement message for each.
#
############################################################################

sub examine_tags {
    my ($want_default, $want_announce) = @_;
    my ($attributes, $default_attr, $default_value);
    my ($announce_attr, $announce_value);
    
    # Iterate through all the tags in the system file.  Resolve each
    # one.

    foreach (keys(%{$system_tags})) {
	$clui_tag = $_;

	# Skip the global tag

	next if ($clui_tag eq $global_tag);

	# Select all the attributes for this tag and sort them
	
	$attributes = resolve_tag(0, 0);
	
	# Extract the default and announce attribute values.  The
	# announce attribute may be on the $clui_tag or the
	# $global_tag

        $default_attr = resolve_attribute(0, 0, $clui_tag,
                                          $default_attribute);
        $default_value = $default_attr->{value};
        $announce_attr = resolve_attribute(0, 0, $clui_tag,
                                           $announce_attribute);
        $announce_value = $announce_attr->{value};
	resolve_announce($announce_value);

	# List the default tags

	if ($want_default == 1 && $default_value && $default_value ne "none") {
	    if (-f "$tag_dir/$clui_tag/$default_value") {
		print "$clui_tag/$default_value\n";
	    }
	}

	# Print announcement notices

	if ($want_announce && $default_value && $default_value ne "none") {
	    if ($announce_load &&-f "$tag_dir/$clui_tag/$default_value") {
                print "echo switcher:$clui_tag: Loading $default_value;\n";
	    } elsif ($announce_warn && 
                     ! -f "$tag_dir/$clui_tag/$default_value") {
		print "echo switcher:$clui_tag: Cannot find modulefile for $default_value -- skipping;\n";
	    }
	}
    }

    # Now go see if there is any tags in the user file that are not in
    # the system default so that we can print out warnings.

    foreach my $tag (sort(keys(%{$user_tags}))) {
        $clui_tag = $tag;
        my $attributes = resolve_tag(0, 0);
        $announce_attr = resolve_attribute(0, 0, $clui_tag,
                                           $announce_attribute);
        $announce_value = $announce_attr->{value};
        resolve_announce($announce_value);
        if (!defined($system_tags->{$clui_tag})) {
            if ($announce_warn) {
		print "echo switcher: Tag \"$clui_tag\" is in user defaults, but does not exist;\n";
            }
        }
    }


    # Upon success, silence is golden

    0;
}

############################################################################
#
# show_exec
#
# Take all the tags, resolve all the attributes, and come up with a
# list of module commands to execute that will setup the environment.
#
############################################################################

sub show_exec {
    return examine_tags(1, 0);
}

############################################################################
#
# announce
#
# Take all the tags, resolve all the attributes, and display an
# announcement message for each.
#
############################################################################

sub announce {
    return examine_tags(0, 1);
}

############################################################################
#
# write_ini_file
#
# Write out the contents of an AppConfig in a .ini-style file.
#
############################################################################

sub write_ini_file {
    my ($filename, $contents) = @_;

    # Quick sanity check to see if we can write to this file

    if (-f $filename && ! -w $filename) {
	print_error("Cannot write to file \"$filename\"\n" .
		    "Data NOT saved\n");
	return 1;
    }

    # Open the output file -- completely overwrite it

    if (!open FILE, ">$filename") {
	if (-f $filename) {
	    print_error("Cannot write to file \"$filename\"\n" .
			"Data NOT saved\n");
	}
	return 1;
    }

    # Write out the header.  $< is the UID.

    my ($username) = getpwuid $<;
    my $now_string = localtime;
    print FILE "# WARNING: This file is automatically generated
# WARNING: DO NOT EDIT BY HAND!!
# Generated by $username on $now_string\n";
        
    # Iterate over the contents, writing out the file

    foreach my $section (sort(keys(%{$contents}))) {
        print FILE "[$section]\n";

        foreach my $key (sort(keys(%{$contents->{$section}}))) {
            print FILE "$key = " . $contents->{$section}->{$key} . "\n";
        }
        print FILE "\n";
    }

    # All done

    close FILE;

    # Upon success, silence is golden

    0;
}

############################################################################
#
# read_ini_file
#
# Read in the contents of an .ini-style file.
#
############################################################################

sub read_ini_file {
    my ($filename) = @_;
    my $tags = {};
    my $line_num = 0;

    # Quick sanity check to see if we can read the file

    if (! -f $filename || ! -r $filename) {
        print_error("Cannot read ini file (\"$filename\")\n");
        return $tags;
    }

    # Read the file for all it's worth

    if (!open(FILE, $filename)) {
        print_error("Cannot open ini file (\"$filename\")\n");
        return $tags;
    }

    my $section = "global";
    while (<FILE>) {
        ++$line_num;
        chomp;
        my $line = $_;

        # Eliminate whitespace on the beginning and the end
        
        $line =~ s/^[ \t]+//;
        $line =~ s/[ \t]+$//;

        # Skip blank lines

        if ($line eq "") {
            next;
        } 

        # Skip comments

        elsif (substr($line, 0, 1) eq "#") {
            next;
        } 

        # If we get a new section name, save it

        elsif ($line =~ /^\[.+\]$/) {
            $section = $line;
            $section =~ s/^\[(.+)\]$/$1/;
        } 

        # Now get the name and attribute

        elsif ($line =~ /[a-zA-Z0-9_\-]+[ \t]*=[ \t]*.+/) {
            my $key = $line;
            my $value = $line;

            $key =~ s/([a-zA-Z0-9_\-]+)[ \t]*=[ \t]*.+/$1/;
            $value =~ s/[a-zA-Z0-9_\-]+[ \t]*=[ \t]*(.+)/$1/;

            $tags->{$section}->{$key} = $value;
        } 

        # Whoops; an unknown line...

        else {
            print_warning("Skipped unknown line $line_num in $filename:
  $line\n");
        }
    }

    close FILE;
    return $tags;
}

############################################################################
#
# main
#
############################################################################

#
# Commands are of the form:
#
# Tagless:
# switcher
# switcher [--help|--more-help]
# switcher --list
# switcher --announce (hidden command)
# switcher --show-exec (hidden command)
#
# Requires a tag:
# switcher <tag> = <name> [<args>]
# switcher <tag> [<command> [<args>]]
#
# <args> can be:
# --force
# --silent
#
# <command> can be:
# [empty]
# --list
# --show [--system|--user]
# --add-tag
# --rm-tag
# --add-name <name> <dir>
# --rm-name <name>
# --add-attr <attribute> <value> [--system|--user]
# --rm-attr <attribute> [--system|--user]

# Initially, switcher used AppConfig for command line parsing and
# other stuff.  But it has too many problems.  So let's replace it
# with something more generic.  :-\

# DISCLAIMER: This command line parsing scheme is less than efficient
# -- we run through the entire command line multiple times.  But
# given: a) the complicated syntax, b) at least one option can mean
# something different depending on how it's used (--list), c) no one
# gives a damn about efficiency of command-line parsing, and d) code
# is read MUCH more than it is written, it's *WAY* more straightfoward
# to do it this way than try to be clever and super efficient.

# First, scan through and find global options

my $i = 0;
while ($i <= $#ARGV) {
    my $a = $ARGV[$i];
    $switcher_silent = 1 if ($a eq "--silent");
    $switcher_force = 1 if ($a eq "--force");
    $switcher_system = 1 if ($a eq "--system");
    $switcher_user = 1 if ($a eq "--user");

    if ($a eq "--help" || $a eq "-h") {
        display_help();
        exit 0;
    } elsif ($a eq "--more-help") {
        display_more_help();
        exit 0;
    }

    ++$i;
}

# Check for bozo cases

if ($switcher_system + $switcher_user == 2) {
    print_error("Cannot specify both --system and --user\n");
    display_help();
    exit 0;
}

# Now that we know if we're silenr or not, read in the system defaults
# file.  It is not an error if it does not exist -- this may be the
# first time that we're running.  If it does not exist, ensure that it
# is written on the way out.

if (-f $system_filename) {
    $system_tags = read_ini_file($system_filename);
} else {
    $system_tags = {};
    $system_tags_modified = 1;
}

# Ensure that that the special tag "global" exists.

if (defined($system_tags->{global})) {
    $system_tags->{global}->{$exists_attribute} = 1;
} else {
    $system_tags->{global} = {
        $exists_attribute => 1,
    }
}

# If we have a user defaults file, read it.

if (-f $user_filename) {
    $user_tags = read_ini_file($user_filename);
} else {
    $user_tags = {};
}

# Ensure that that the special tag "global" exists.

if (defined($user_tags->{global})) {
    $user_tags->{global}->{$exists_attribute} = 1;
} else {
    $user_tags->{global} = {
        $exists_attribute => 1,
    }
}

# Continue parsing the command line.  Scan through and see if there's
# something that can be considered a tag

my @processed_argv;
my $i = 0;
while ($i <= $#ARGV) {
    my $a = $ARGV[$i];

    # Can skip these looking for a tag (it may be an error if there is
    # no tag for some of these, but that's not the point here -- we're
    # just looking for the tag, not trying to determine if it's an
    # error if there is no tag or not).

    if ($a eq "--list" || $a eq "--add-tag" || $a eq "--rm-tag" ||
        $a eq "--show" || $a eq "--show-exec" || $a eq "--announce") {
        push(@processed_argv, $a);
        ++$i;
    } elsif ($a eq "--force" || $a eq "--silent" || 
             $a eq "--system" || $a eq "--user") {

        # These don't need to be saved in @processed_argv

        ++$i;
    }

    # All these commands take arguments, so skip over them

    elsif ($a eq "--rm-name" || $a eq "--rm-attr") {
        push(@processed_argv, $a);
        push(@processed_argv, $ARGV[$i + 1]) if ($i + 1 <= $#ARGV);
        $i += 2;
    } elsif ($a eq "--add-name" || $a eq "--add-attr") {
        push(@processed_argv, $a);
        push(@processed_argv, $ARGV[$i + 1]) if ($i + 1 <= $#ARGV);
        push(@processed_argv, $ARGV[$i + 2]) if ($i + 2 <= $#ARGV);
        $i += 3;
    }

    # If it begins with "-", it's unrecognized

    elsif (substr($a, 0, 1) eq "-") {
        print_error("Unrecognized command \"$a\"\n");
        display_help();
        exit 1;
    }

    # If it's "=", then convert it into --add-attr (makes things
    # simpler below)

    elsif ($a eq "=") {
        push(@processed_argv, "--add-attr");
        push(@processed_argv, "default");
        push(@processed_argv, $ARGV[$i + 1]) if ($i + 1 <= $#ARGV);
        $i += 2;
    }

    # If we've gotten this far, then it must be the tag.  If we
    # already have a tag, it's an error.

    elsif ($clui_tag) {
        print_error("Already have a tag (\"$clui_tag\"); cannot specify a second tag (\"$a\")\n");
        display_help();
        exit(1);
    } else {

        # The tag does not get saved in @processed_argv; makes things
        # simpler below

        $clui_tag = $a;
        ++$i;
    }
}

# Ok, we have no errors and we potentially have a tag.  
# If we have no tag, do a quick and easy parse

if (!$clui_tag) {

    # Check for the special case where there's no args at all

    push(@processed_argv, "--list")
        if ($#processed_argv < 0);

    # See if we have any commands that require a tag.  If so, error.

    $i = 0;
    while ($i <= $#processed_argv) {
        my $a = $processed_argv[$i];
        
        # All these commands take arguments, so skip over them

        if ($a eq "--add-tag" || $a eq "--rm-tag" ||
            $a eq "--add-name" || $a eq "--rm-name" ||
            $a eq "--add-attr" || $a eq "--rm-attr") {
            print_error("Command \"$a\" requires a tag\n");
            display_help();
            exit 1;
        }

        ++$i;
    }

    # Ok, so we have a command with no tag.  Do it (note that --help,
    # -h, and --more-help have already been taken care of, above).

    $i = 0;
    while ($i <= $#processed_argv) {
        my $a = $processed_argv[$i];

        if ($a eq "--list") {
	    list_tags();
            exit 0;
        } elsif ($a eq "--announce") {
            announce();
            exit 0;
        } elsif ($a eq "--show-exec") {
	    show_exec();
            exit 0;
        } else {
            print_error("Unrecognized command with no tag (\"$a\")\n");
            show_help();
            exit 1;
        }
        ++$i;
    }    
}

# Check to see if we got a tag and no commands.

push(@processed_argv, "--show")
    if ($#processed_argv < 0);

# If we're here, it means that we have a tag and at least one command
# to go with it.  Handle them.

my $ret;
$i = 0;
while ($i <= $#processed_argv) {
    my $a = $processed_argv[$i];
    my $arg1 = "";
    my $arg2 = "";

    $ret = 0;
    $arg1 = $processed_argv[$i + 1] if ($i + 1 <= $#processed_argv);
    $arg2 = $processed_argv[$i + 2] if ($i + 2 <= $#processed_argv);

    # First, look for commands that should not have a tag

    if ($a eq "--help" || $a eq "-h") {
        display_help();
        exit 0;
    } elsif ($a eq "--more-help") {
        display_more_help();
        exit 0;
    } elsif ($a eq "--announce" || $a eq "--show-exec") {
        print_error("Command \"$a\" cannot be used with a tag\n");
        display_help();
        exit 0;
    }

    # Ok, we have a valid command.  Do it.

    # --List

    elsif ($a eq "--list") {
        $ret = list_names();
        ++$i;
    }

    # --show [--system|--user]

    elsif ($a eq "--show") {
        $ret = show();
        ++$i;
    }

    # --add-tag

    elsif ($a eq "--add-tag") {
        $ret = add_tag();
        $i += 1;
    }

    # --rm-tag

    elsif ($a eq "--rm-tag") {
        $ret = rm_tag();
        $i += 1;
    }

    # --add-name <name> <dir>

    elsif ($a eq "--add-name") {
        if (!$arg1 || !$arg2) {
            print_error("Must specify <name> and <dir> " .
                        "arguments with --add-name\n");
            display_help();
            exit(1);
        } elsif (! -d $arg2) {
            print_error("<dir> argument must be a valid, " .
                        "readable directory\n");
            display_help();
            exit(1);
        }

        $ret = add_name($arg1, $arg2);
        $i += 3;
    }

    # --rm-name <name>

    elsif ($a eq "--rm-name") {
        if (!$arg1) {
            print_error("Must specify <name> argument with --rm-name\n");
            display_help();
            exit(1);
        }

        $ret = rm_name($arg1);
        $i += 2;
    }

    # --add-attr <attribute> <value>

    elsif ($a eq "--add-attr") {
        if (!$arg1) {
            print_error("Must specify <attribute> and <value> " .
                        "arguments with --add-attr\n");
            display_help();
            exit(1);
        }

        $ret = add_attr($arg1, $arg2);
        $i += 3;
    }

    # --rm-attr <attribute>

    elsif ($a eq "--rm-attr") {
        if (!$arg1) {
            print_error("Must specify <attribute> argument with --rm-attr\n");
            display_help();
            exit(1);
        }

        $ret = rm_attr($arg1);
        $i += 2;
    }

    # Unknown

    else {
        print_error("Unrecognized command (\"$a\")\n");
        exit 1;
    }

    # Handle the return code

    exit($ret) if ($ret);
}

# Write out new files if necessary

if ($ret == 0) {
    if ($system_tags_modified) {
        write_ini_file($system_filename, $system_tags);
    }
    if ($user_tags_modified) {
        write_ini_file($user_filename, $user_tags);
    }
}

# Done

exit $ret;
