/*This line lets emacs recognize this as -*- C -*- Code
 *-----------------------------------------------------------------------------
 *
 * Project:	Tcl Modules
 * Created:	91/10/23
 * Author:	John L. Furlani<john.furlani@East.Sun.COM>
 *
 * Description:
 *      General routines that are called throughout Modules which are
 *  not necessarily specific to any single block of functionality.
 *	
 * $Log: utility.c,v $
 * Revision 2.0  1993/02/21  00:01:22  jlf
 * Release version of Modules v2.0
 *
 *
 * Revision 1.9  1993/02/03  02:34:59  jlf
 * Changed _LOADED_MODULEFILES_ to _LMFILES_ because csh seems to have a
 * problem with the larger name.  Grrr..
 *
 * Revision 1.8  1993/01/26  22:34:43  jlf
 * Added a cast to remove a warning message.
 *
 * Revision 1.7  1993/01/25  18:48:13  jlf
 * Changed the method for keeping and unwinding failed modulefiles.
 * The output returns to its optimized state where only the aggregate
 * changes to the environment are sent to the executing shell.
 *
 * Revision 1.6  1993/01/23  01:01:23  jlf
 * Fixed a number of memory leaks and large static arrays.
 *
 * Revision 1.5  1993/01/20  21:54:20  jlf
 * Modified IsLoaded so it will ignore the case where _LOADED_MODULEFILES_
 * is not set or is corrupted.  This makes the new version of modulecmd
 * backward compatible with the old version midstream.
 *
 * Revision 1.4  1993/01/20  17:47:20  jlf
 * Fixed IsLoaded.  It was not indicating that a modulefile is loaded when
 * the basename was used or when filename was NULL.
 *
 * Revision 1.3  1993/01/20  03:36:51  jlf
 * Added _LOADED_MODULEFILES_ environment variable.
 * Changed IsLoaded to use _LOADED_MODULEFILES_ environment variable.
 * Fixed a couple of alias setting/unsetting bugs.
 *
 * Revision 1.2  1992/11/18  23:05:17  jlf
 * Fixed the bug in IsLoaded by setting realname to the given modulename
 * in the default case instead of NULL.
 *
 * Removed the fred tmporary name and changed tmpnam to tempname with
 * a specific Modules prefix.  Also added #defines which allow for
 * aliases and functions to be sent back to the shell instead of being
 * put into a file and that will not create functions if the Bourne
 * shell on a particular system doesn't support it.
 *
 * Revision 1.1  1992/11/05  23:26:20  jlf
 * Initial revision
 *
 *---------------------------------------------------------------------------*/
static char Id[] =
    "$Id: utility.c,v 2.0 1993/02/21 00:01:22 jlf Exp jlf $";

#include "global.h"
#include <regexp.h>

char  cmd_separator = ';';

/*------------------------------------------------------------------------
*
*  Function:	store_shell_alias/variable
*  Created:	92/10/14
*  RespEngr:	John L. Furlani
*
*  Description:
*	
*	Keeps the old value of the variable around if it is touched in the
*   modulefile to enable undoing a modulefile by resetting the evironment to
*   it started.
*
*       This is the same for unset_shell_variable()
*	
*-----------------------------------------------------------------------*/
int
store_shell_alias(Tcl_HashTable* htable,
                  const char*    alias,
                  const char*    value)
{
    int   new;
    Tcl_HashEntry* hentry;

    /*
     *  If I haven't already created an entry for keeping this environment
     *  variable's old value, then create one.
     *
     *  This ensures that I only store the value as it is the very beginning
     *  of the modulefile and not as later values.
     */
    hentry = Tcl_CreateHashEntry(htable, (char*) alias, &new);
    if(value)
        Tcl_SetHashValue(hentry, (char*) strdup((char*)value));
    else
        Tcl_SetHashValue(hentry, (char*) NULL);
    
    return TCL_OK;
}

int
store_shell_variable(Tcl_HashTable* htable,
                         const char* var,
                         const char* oldval)
{
    int   new;
    Tcl_HashEntry* hentry;

    hentry = Tcl_CreateHashEntry(htable, (char*) var, &new);
    if(new == 0) {
        char* val = (char*)Tcl_GetHashValue(hentry);
        if(val) free(val);
    }
    if(oldval)
        Tcl_SetHashValue(hentry, (char*) strdup((char*)oldval));
    
    return TCL_OK;
}

int
clear_shell_variable(Tcl_HashTable* htable,
                         const char* var)
{
    int   new;
    Tcl_HashEntry* hentry;

    /*
     *  If I haven't already created an entry for keeping this environment
     *  variable's value, then just leave.
     *
     *  Otherwise, remove this entry from the hash table.
     */
    if(hentry = Tcl_FindHashEntry(htable, (char*) var)) {
        char* tmp = (char*)Tcl_GetHashValue(hentry);
        free(tmp);
        Tcl_DeleteHashEntry(hentry);
    }
    
    return TCL_OK;
}

/*------------------------------------------------------------------------
*
*  Function:	Clear_Global_Hash_Tables
*  Created:	92/10/14
*  RespEngr:	John L. Furlani
*
*  Description:
*	Deletes and reinitializes our environment hash tables.
*	
*	
*-----------------------------------------------------------------------*/
void
Clear_Global_Hash_Tables(void) {
  Tcl_HashSearch   searchPtr;
  Tcl_HashEntry*   hashEntry;
  Tcl_HashTable*   table[4];
  char*            var = NULL;
  char*            val = NULL;
  int              i;

  table[0] = setenvHashTable;
  table[1] = unsetenvHashTable;
  table[2] = aliasSetHashTable;
  table[3] = aliasUnsetHashTable;
  
  for(i = 0; i < 4; i++) {
    if((hashEntry = Tcl_FirstHashEntry(table[i], &searchPtr)) == NULL) {
      break;
    }

    do {
        /*
         *  Whatever is in HashValue must be free'd
         */
        val = (char*)Tcl_GetHashValue(hashEntry);
        if(val) free(val);
    } 
    while(hashEntry = Tcl_NextHashEntry(&searchPtr));
    Tcl_DeleteHashTable(table[i]);
    Tcl_InitHashTable(table[i], TCL_STRING_KEYS);
  }
}

/*------------------------------------------------------------------------
*
*  Function:	Delete_Hash_Tables
*  Created:	92/10/14
*  RespEngr:	John L. Furlani
*
*  Description:
*	Deletes and reinitializes our environment hash tables.
*	
*	
*-----------------------------------------------------------------------*/
void
Delete_Global_Hash_Tables(void) {
    Tcl_HashSearch   searchPtr;
    Tcl_HashEntry*   hashEntry;
    Tcl_HashTable*   table[4];
    char*            var = NULL;
    char*            val = NULL;
    int              i;

    table[0] = setenvHashTable;
    table[1] = unsetenvHashTable;
    table[2] = aliasSetHashTable;
    table[3] = aliasUnsetHashTable;
  
    for(i = 0; i < 4; i++) {
        if((hashEntry = Tcl_FirstHashEntry(table[i], &searchPtr)) == NULL) {
            free((char*)table[i]);
            continue;
        }

        do {
            /*
             *  Whatever is in HashValue must be free'd
             */
            val = (char*)Tcl_GetHashValue(hashEntry);
            if(val) free(val);
        } 
        while(hashEntry = Tcl_NextHashEntry(&searchPtr));
        Tcl_DeleteHashTable(table[i]);
        free((char*)table[i]);
    }
}

/*------------------------------------------------------------------------
*
*  Function:	Delete_Hash_Tables
*  Created:	92/10/14
*  RespEngr:	John L. Furlani
*
*  Description:
*	Deletes and reinitializes our environment hash tables.
*	
*	
*-----------------------------------------------------------------------*/
void
Delete_Hash_Tables(Tcl_HashTable** oldTables) {
    Tcl_HashSearch   searchPtr;
    Tcl_HashEntry*   hashEntry;
    char*            var = NULL;
    char*            val = NULL;
    int              i;

    for(i = 0; i < 4; i++) {
        if((hashEntry = Tcl_FirstHashEntry(oldTables[i], &searchPtr)) == NULL) {
            free((char*)oldTables[i]);
            continue;
        }

        do {
            /*
             *  Whatever is in HashValue must be free'd
             */
            val = (char*)Tcl_GetHashValue(hashEntry);
            if(val) free(val);
        } 
        while(hashEntry = Tcl_NextHashEntry(&searchPtr));
        Tcl_DeleteHashTable(oldTables[i]);
        free((char*)oldTables[i]);
    }
}

/*------------------------------------------------------------------------
*
*  Function:	Copy_Hash_Tables
*  Created:	93/01/24
*  RespEngr:	John L. Furlani
*
*  Description:
*	Deletes and reinitializes our environment hash tables.
*	
*	
*-----------------------------------------------------------------------*/
Tcl_HashTable**
Copy_Hash_Tables(void) {
    Tcl_HashSearch   searchPtr;
    Tcl_HashEntry*   oldHashEntry;
    Tcl_HashEntry*   newHashEntry;
    Tcl_HashTable*   oldTable[4];
    Tcl_HashTable**  newTable;
    char*            var = NULL;
    char*            val = NULL;
    int              i, new;

    oldTable[0] = setenvHashTable;
    oldTable[1] = unsetenvHashTable;
    oldTable[2] = aliasSetHashTable;
    oldTable[3] = aliasUnsetHashTable;

    if(((newTable = (Tcl_HashTable**)malloc(sizeof(Tcl_HashTable*)*4)) == NULL)||
       ((newTable[0] = (Tcl_HashTable*)malloc(sizeof(Tcl_HashTable))) == NULL) ||
       ((newTable[1] = (Tcl_HashTable*)malloc(sizeof(Tcl_HashTable))) == NULL) ||
       ((newTable[2] = (Tcl_HashTable*)malloc(sizeof(Tcl_HashTable))) == NULL) ||
       ((newTable[3] = (Tcl_HashTable*)malloc(sizeof(Tcl_HashTable))) == NULL)) {
        fprintf(stderr, 
                "ERROR allocating memory for hash table copy in Copy_Hash_Table()\n");
        exit(1);
    }

    Tcl_InitHashTable(newTable[0], TCL_STRING_KEYS);
    Tcl_InitHashTable(newTable[1], TCL_STRING_KEYS);
    Tcl_InitHashTable(newTable[2], TCL_STRING_KEYS);
    Tcl_InitHashTable(newTable[3], TCL_STRING_KEYS);

    for(i = 0; i < 4; i++) {
        if((oldHashEntry = Tcl_FirstHashEntry(oldTable[i], &searchPtr)) == NULL) {
            continue;
        }

        do {
            /*
             *  Copy all the entries
             */
            var = (char*)Tcl_GetHashKey(oldTable[i], oldHashEntry);
            val = (char*)Tcl_GetHashValue(oldHashEntry);

            newHashEntry = Tcl_CreateHashEntry(newTable[i], 
                                               var, &new);
            if(val)
                Tcl_SetHashValue(newHashEntry, strdup(val));
        } 
        while(oldHashEntry = Tcl_NextHashEntry(&searchPtr));
    }
    return newTable;
}

/*------------------------------------------------------------------------
*
*  Function:	Unwind_Modulefile_Changes
*  Created:	92/10/14
*  RespEngr:	John L. Furlani
*
*  Description:
*	Once a the loading or unloading of a modulefile fails, any changes it
*   has made to the environment must be undone and reset to its previous
*   state.  This function is responsible for unwinding any changes a
*   modulefile has made.
*	
*-----------------------------------------------------------------------*/
int
Unwind_Modulefile_Changes(Tcl_Interp* interp, const char* modulename, 
                          Tcl_HashTable** oldTables) 
{
  Tcl_HashSearch   searchPtr;
  Tcl_HashEntry*   hashEntry;
  char*            var = NULL;
  char*            val = NULL;
  int              i;

  if(oldTables) {
      for(i = 0; i < 2; i++) {
          if((hashEntry = Tcl_FirstHashEntry(oldTables[i], &searchPtr)) == NULL) {
              continue;
          }

          do {
              var = (char*) Tcl_GetHashKey(oldTables[i], hashEntry);

              /*
               *  The hashEntry will contain the appropriate value for the
               *  specified 'var' because it will have been aquired depending
               *  upon whether the unset or set table was used.
               */
              val = (char*)Tcl_GetHashValue(hashEntry);
              if(val)
                  (void) Tcl_SetVar2(interp, "env", var, val, TCL_GLOBAL_ONLY);
          } 
          while(hashEntry = Tcl_NextHashEntry(&searchPtr));
      }

      /*
         Delete and reset the hash tables now that the current contents have been
         flushed.
         */
      Delete_Global_Hash_Tables();
  
      setenvHashTable     = oldTables[0];
      unsetenvHashTable   = oldTables[1];
      aliasSetHashTable   = oldTables[2];
      aliasUnsetHashTable = oldTables[3];
  } else {
      Clear_Global_Hash_Tables();
  }

  /*
   *  Issue an appropriate error message depending upon how much information
   *    we have.
   */
  fprintf(stderr,
          "-------------------------------------------------------------------\n");
        
  if(*interp->result) {
      if(modulename) {
          if(interp->errorLine) {
              fprintf(stderr,
                      "\nERROR around line# %d with modulefile '%s':\n\t%s\n",
                      interp->errorLine, modulename, interp->result);
          } else {
              fprintf(stderr, "\nERROR with modulefile '%s':\n\t%s\n", 
                      modulename, interp->result);
          }
      } else {
          if(interp->errorLine) {
              fprintf(stderr, "\nERROR around line# %d:\n\t%s\n",
                      interp->errorLine, interp->result);
          } else {
              fprintf(stderr, "\nERROR:  %s\n", interp->result);
          }
      }
  }
        
  fprintf(stderr, "\nAn error occured while processing your module command.\n");
  if(modulename) {
      fprintf(stderr, "\t-- Only changes pertaining to the \n\t\t'%s' \
modulefile were not completed\n", modulename);
  } else {
      fprintf(stderr, "\t-- NO changes were made to the environment\n");
  }
        
  fprintf(stderr,
          "\n-------------------------------------------------------------------\n");

  return TCL_OK;
}

/*------------------------------------------------------------------------
*
*  Function:	Output_Modulefile_Changes
*  Created:	92/10/14
*  RespEngr:	John L. Furlani
*
*  Description:
*	Is used to flush out the changes of the current modulefile in a manner
*   depending upon whether the modulefile was successfull or unsuccessfull.
*	
*-----------------------------------------------------------------------*/
int
Output_Modulefile_Changes(Tcl_Interp* interp)
{
  Tcl_HashSearch   searchPtr;
  Tcl_HashEntry*   hashEntry;
  Tcl_HashTable*   table[2];
  char*            var = NULL;
  char*            val = NULL;
  int              i;


  table[0] = setenvHashTable;
  table[1] = unsetenvHashTable;
  
  for(i = 0; i < 2; i++) {
    if((hashEntry = Tcl_FirstHashEntry(table[i], &searchPtr)) == NULL) {
      continue;
    }

    do {
	var = (char*) Tcl_GetHashKey(table[i], hashEntry);

        if(i == 1) {
            output_unset_variable((char*) var);
        } else {
            val = Tcl_GetVar2(interp, "env", var, TCL_GLOBAL_ONLY);
            if(val) {
                output_set_variable((char*) var, val);
            }
        }
      } 
    while(hashEntry = Tcl_NextHashEntry(&searchPtr));
  }

  fflush(stdout);

  Output_Modulefile_Aliases(interp);
  
  /*
    Delete and reset the hash tables now that the current contents have been
    flushed.
    */
  Clear_Global_Hash_Tables();
  
  return TCL_OK;
}  

static FILE* aliasfile = stdout;
static char  alias_separator = ';';

int
Output_Modulefile_Aliases(Tcl_Interp* interp)
{
  Tcl_HashSearch   searchPtr;
  Tcl_HashEntry*   hashEntry;
  Tcl_HashTable*   table[2];
  char*            var = NULL;
  char*            val = NULL;
  int              i;

#ifndef EVAL_ALIAS
  char*            aliasfilename = tempnam(NULL, "M_od_");

  /*
   *  We only need to output stuff into a temporary file if we're setting
   *  stuff.  We can unset variables and aliases by just using eval.
   */
  if(hashEntry = Tcl_FirstHashEntry(aliasSetHashTable, &searchPtr)) {
      if((aliasfile = fopen(aliasfilename, "w+")) == NULL) {
          fprintf(stderr, "Error:  Couldn't create tmpfile for aliases\n");
          fprintf(stderr, "\tNO Aliases will be set\n");
          return TCL_ERROR;
      } else {
          alias_separator = '\n';
          if(!strcmp(shell_derelict, "csh")) {
              fprintf(stdout, "source %s%c", aliasfilename, cmd_separator);
              fprintf(stdout, "/bin/rm -f %s%c", aliasfilename, cmd_separator);
          } else if(!strcmp(shell_derelict, "sh")) {
              fprintf(stdout, ". %s%c", aliasfilename, cmd_separator);
              fprintf(stdout, "/bin/rm -f %s%c", aliasfilename, cmd_separator);
          }
      }
  }

  free(aliasfilename);
#endif
  
  table[0] = aliasSetHashTable;
  table[1] = aliasUnsetHashTable;
  
  for(i=0; i<2; i++) {
    
    if((hashEntry = Tcl_FirstHashEntry(table[i], &searchPtr)) == NULL) {
      continue;
    }

    do {
	var = (char*) Tcl_GetHashKey(table[i], hashEntry);
        val = (char*) Tcl_GetHashValue(hashEntry);
        if(i == 1) {
            output_unset_alias(var, val);
        } else {
            output_set_alias(var, val);
        }
      } 
    while(hashEntry = Tcl_NextHashEntry(&searchPtr));
  }

  return TCL_OK;
}

    
int
output_set_variable(const char* var,
		      const char* val)
{
  if(!strcmp((char*) shell_derelict, "csh")) {
      fprintf(stdout, "setenv %s %s%c", var, val, cmd_separator);
  } else if(!strcmp((char*) shell_derelict, "sh")) {
    fprintf(stdout, "%s=%s%cexport %s%c", var, val, cmd_separator,
	    var, cmd_separator);
  } else if(!strcmp((char*) shell_derelict, "emacs")) {
      fprintf(stdout, "(setenv ""%s"" ""%s"")\n", var, val);
  } else {
    fprintf(stderr, 
	    "ERROR in output_set_shell_variable():  Unrecognized shell derelict %s\n", 
	    shell_derelict);
    return -1;
  }
  return 0;
}

int
output_unset_variable(const char* var)
{
  if(!strcmp(shell_derelict, "csh")) {
      fprintf(stdout, "unsetenv %s%c", var, cmd_separator);
  } else if(!strcmp(shell_derelict, "sh")) {
      fprintf(stdout, "unset %s%c", var, cmd_separator);
  } else if(!strcmp((char*) shell_derelict, "emacs")) {
      fprintf(stdout, "(setenv ""%s"" nil)\n", var);
  } else {
    fprintf(stderr, 
	    "ERROR in output_unset_shell_variable():  Unrecognized shell derelict %s\n", 
	    shell_derelict);
    return -1;
  }
  
  return 0;
}

char*  set_derelict(const char* name) 
{
    if(!strcmp((char*) name, "sh") || 
       !strcmp((char*) name, "bash") || 
       !strcmp((char*) name, "zsh") || 
       !strcmp((char*) name, "ksh")) {
	return strcpy(shell_derelict, "sh");
    } else if(!strcmp((char*) name, "csh") || 
	      !strcmp((char*) name, "tcsh")) {
	return strcpy(shell_derelict, "csh");
    } else if(!strcmp((char*) name, "emacs")) {
	return strcpy(shell_derelict, "emacs");
    }

    return NULL;
}

/*------------------------------------------------------------------------
*
*  Function:	output_set_alias
*  Created:	92/10/15
*  RespEngr:	John L. Furlani
*
*  Description:
*	Actually turns the Modules set-alias information into a string that a
*   shell can source.  Previously, this routine just output the alias
*   information to be eval'd by the shell.  But, some shells don't work well
*   with having their alias information set via the 'eval' command.  So, what
*   we'll do now is output the aliases into a /tmp dotfile, have the shell
*   source the /tmp dotfile and then have the shell remove the /tmp dotfile.
*	
*  Deficiencies/ToDo:
*	
*	
*-----------------------------------------------------------------------*/
int output_function(const char* var, const char* val)
{
    const char* cptr = val;
    int nobackslash = 1;
    
    fprintf(aliasfile, "%s() {%c", var, alias_separator);

    /* need to take care of any backslashes */
    while(*cptr) {
        if(*cptr == '\\') {
            if(!nobackslash) putc(*cptr, aliasfile);
            else nobackslash = 0;
            cptr++;
            continue;
        } else
            nobackslash = 1;
        putc(*cptr++, aliasfile);
    }
    fprintf(aliasfile, ";%c}%c", alias_separator,alias_separator);
}


int
output_set_alias(const char* var,
                 const char* val)
{
    int nobackslash = 1;
    
    if(!strcmp(shell_derelict, "csh")) {
        /* need to switch $* to \!* and $n to \!\!:n
           unless the $ has a backslash before it */
        const char* cptr = val;
        
        fprintf(aliasfile, "alias %s '", var);
        while(*cptr) {
            if(*cptr == '$' && nobackslash) {
                cptr++;
                if(*cptr == '*')
                    fprintf(aliasfile, "\\!");
                else
                    fprintf(aliasfile, "\\!\\!:");
            }
            if(*cptr == '\\') {
                if(!nobackslash) putc(*cptr, aliasfile);
                else nobackslash = 0;
                cptr++;
                continue;
            } else
                nobackslash = 1;

            putc(*cptr++, aliasfile);
        }
        
        fprintf(aliasfile, "'%c", alias_separator);
    } else if(!strcmp(shell_derelict, "sh")) {
        if(shell_name[0] == 's' && !strcmp(shell_name, "sh")) {
            /* need to write a function unless this sh doesn't support functions */
#ifdef HAS_BOURNE_FUNCS
            output_function(var, val);
#endif
        } else if(!strcmp(shell_name, "bash") ||
                  !strcmp(shell_name, "zsh") ||
                  !strcmp(shell_name, "ksh")) {
            /*
             *  Do we need to write a function?
             *  Yes, if it has arguments...
             */
            const char* cptr = val;
            while(*cptr++) {
                if(*cptr == '$') {
                    output_function(var, val);
                    return TCL_OK;
                }
            }
            /*
             *  So, we can just output an alias...
             */
            fprintf(aliasfile, "alias %s='%s'%c", var, val, alias_separator);
        }
    }
    return TCL_OK;
}

int
output_unset_alias(const char* var, const char* val)
{
    if(!strcmp(shell_derelict, "csh")) {
        fprintf(aliasfile, "unalias %s%c", var, alias_separator);
    } else if(!strcmp(shell_derelict, "sh")) {
        if(shell_name[0] == 's' && !strcmp(shell_name, "sh")) {
            /* need to unset a function */
            fprintf(aliasfile, "unset -f %s%c", var, alias_separator);
        } else if(!strcmp(shell_name, "bash")) {
            /*
             *  If we have what the old value should have been, then look to
             *  see if it was a function or an alias because bash spits out an
             *  error if you try to unalias a non-existent alias.
             */
            if(val) {
                /*
                 *  Was it a function?
                 *  Yes, if it has arguments...
                 */
                const char* cptr = val;
                while(*cptr++) {
                    if(*cptr == '$') {
                        fprintf(aliasfile, "unset -f %s%c", var, alias_separator);
                        return TCL_OK;
                    }
                }
                /*
                 *  Well, it wasn't a function, so we'll put out an unalias...
                 */
                fprintf(aliasfile, "unalias %s%c", var, alias_separator);
            } else {
                /*
                 *  We'll assume it was a function because the unalias command
                 *  in bash produces an error.  It's possible that the alias
                 *  will not be cleared properly here because it was an
                 *  unset-alias command.
                 */
                fprintf(aliasfile, "unset -f %s%c", var, alias_separator);
            }
        } else if(!strcmp(shell_name, "zsh") || !strcmp(shell_name, "ksh")) {
            /*
             *  Put out both because we it could be either a function or an
             *  alias.  This will catch both.
             */
            fprintf(aliasfile, "unalias %s%c", var, alias_separator);
            fprintf(aliasfile, "unset -f %s%c", var, alias_separator);
        }
    }
    
    return TCL_OK;
}

int
IsLoaded(Tcl_Interp* interp, char* modulename, char** realname, char* filename)
{
    char* loaded_modules = Tcl_GetVar2(interp, "env", 
                                       "LOADEDMODULES", TCL_GLOBAL_ONLY);
    char* loaded_modulefiles = Tcl_GetVar2(interp, "env", 
                                           "_LMFILES_", 
                                           TCL_GLOBAL_ONLY);
    char* l_modules = NULL;
    char* l_modulefiles = NULL;
    char* loaded_base = NULL;
    char* loadedmodule_path = NULL;
    int   count = 0;
    
    if(!loaded_modules) { return 0; }
    
    if((l_modules = (char*) malloc(strlen(loaded_modules) + 1)) == NULL) {
	fprintf(stderr, "ERROR:  malloc() failed.\n");
	return 0;
    }
    strcpy(l_modules, loaded_modules);

    if(loaded_modulefiles) {
        if((l_modulefiles = (char*) malloc(strlen(loaded_modulefiles) + 1)) 
           == NULL) {
            fprintf(stderr, "ERROR:  malloc() failed.\n");
            return 0;
        }
        strcpy(l_modulefiles, loaded_modulefiles);
    }

    /* Assume the modulename given was an exact match so
       there is no difference to return -- this will change
       in the case it wasn't an exact match below */
    if(realname)
        *realname= modulename;

    if(*l_modules) {
	loadedmodule_path = strtok(l_modules, ":");
	
	while(loadedmodule_path) {
            loaded_base = get_module_basename(loadedmodule_path);
            
	    if(!strcmp(loadedmodule_path, modulename)) {
		if(loaded_base) free(loaded_base);

		break;
	    } else if(loaded_base) {
		if(!strcmp(loaded_base, modulename)) {
                    /* Since the name given was a basename,
                       return the fully loaded path */
                    if(realname) {
                        if((*realname = 
                            (char*) malloc(strlen(loadedmodule_path) + 1))
                          == NULL) {
                            fprintf(stderr, "ERROR:  malloc() failed.\n");
                            return 0;
                        }
                        strcpy(*realname, loadedmodule_path);
                    }
                    free(loaded_base);
		    break;
		}
	    }
	    loadedmodule_path = strtok(NULL, ":");
            count++;
            if(loaded_base) free(loaded_base);
	}
    }

    if(loadedmodule_path) {  /* we found something so locate 
                                it's associated modulefile */
        if(filename && l_modulefiles && *l_modulefiles) {
            char* modulefile_path = strtok(l_modulefiles, ":");
	
            while(count) {
                if((modulefile_path = strtok(NULL, ":")) == NULL) {
                    /* we don't have a corresponding entry which will
                     * generally suggest that _LMFILES_ has become
                     * corrupted, but it may just mean we're working
                     * intermittantly with an old version.  So, I'll just not
                     * touch filename which means the search will continue
                     * using the old method of looking through MODULEPATH.  
                     */
                    free(l_modules);
                    free(l_modulefiles);
                    return 1;
                }
                count--;
            }
            strcpy(filename, modulefile_path);
            free(l_modules);
            free(l_modulefiles);
            return 1;
	} else {
            if(l_modulefiles) free(l_modulefiles);
            free(l_modules);
            return 1;
        }
    }

    free(l_modules);
    free(l_modulefiles);
    return 0;
}



/*------------------------------------------------------------------------
*
*  Function:	chk_marked_entry, set_marked_entry
*  Created:	92/10/15
*  RespEngr:	John L. Furlani
*
*  Description:
*	When switching, the variables are marked with a marker that is tested
*   to see if the variable was changed in the second modulefile.  If it was
*   not, then the variable is unset.
*	
*  Deficiencies/ToDo:
*	
*	
*-----------------------------------------------------------------------*/
int
chk_marked_entry(Tcl_HashTable* table, char* var)
{
    Tcl_HashEntry* hentry;

    if(hentry = Tcl_FindHashEntry(table, var))
        return (int) Tcl_GetHashValue(hentry);
    else
        return 0;
}

void
set_marked_entry(Tcl_HashTable* table, char* var, int val)
{
    Tcl_HashEntry* hentry;
    int    new;

    if(hentry = Tcl_CreateHashEntry(table, var, &new)) {
        if(val)
            Tcl_SetHashValue(hentry, val);
    }
}


char* get_module_basename(char* modulename)
{
    char* basename;
    char* version;
    
    basename = (char*)strdup(modulename);
    if(version = strrchr(basename, '/')) {
	*version = '\0';
    } else {
	free(basename);
	basename = NULL;
    }
    
    return basename;
}    

int Update_LoadedList(Tcl_Interp* interp, char* modulename, char* filename)
{
    char* argv[4];
    char* basename;
    
    argv[1] = "LOADEDMODULES";
    argv[2] = modulename;
    argv[3] = NULL;
    
    if(flags & M_REMOVE) {
	argv[0] = "remove-path";
	cmdRemovePath(0, interp, 3, argv);

        argv[1] = "_LMFILES_";
        argv[2] = filename;
        argv[3] = NULL;
	cmdRemovePath(0, interp, 3, argv);
    } else {
	argv[0] = "append-path";
	cmdSetPath(0, interp, 3, argv);

        argv[1] = "_LMFILES_";
        argv[2] = filename;
        argv[3] = NULL;
    
	argv[0] = "append-path";
	cmdSetPath(0, interp, 3, argv);
    }
    
    basename = get_module_basename(modulename);
    
    /* A module with just the basename might have been
       added and now we're removing one of its versions.
       We'll want to look for the basename in the path too.
       */
    if(basename && (flags & M_REMOVE)) {
	argv[2] = basename;
	
	argv[0] = "remove-path";
	cmdRemovePath(0, interp, 3, argv);
    }

    free(basename);
    
    return 1;
}

int ForcePath(Tcl_Interp* interp, char* force_pathname)
{
    char* argv[4];
    char* basename;
    
    argv[1] = "PATH";
    argv[2] = force_pathname;
    argv[3] = NULL;
    
    /*
     *  First remove the pathname that we're forcing...
     */
    argv[0] = "remove-path";
    cmdRemovePath(0, interp, 3, argv);

    /*
     *  Next, add it back to the very end of the list
     */
    argv[0] = "append-path";
    cmdSetPath(0, interp, 3, argv);

    return 1;
}

#include <fcntl.h>

/*
 *  Based on check_magic in Richard Elling's find_by_magic
 *  <Richard.Elling@eng.auburn.edu>
 */
int check_magic(char* filename, char* magic_name, int magic_len)
{
    int  fd;
    int  read_len;
    char buf[BUFSIZ];

    if(magic_len > BUFSIZ) return 0;

    if((fd = open(filename, O_RDONLY)) == -1) return 0;

    read_len = read(fd, buf, magic_len);
    
    close(fd);

    if(read_len < magic_len) return 0;

    return (!strncmp(buf, magic_name, magic_len));
}

#ifdef NO_STRDUP
/*------------------------------------------------------------------------
*
*  Function:	strdup
*  Created:	92/11/09
*  RespEngr:	John L. Furlani
*
*  Description:
*	Makes new space to put a copy of the given string into and then 
*   copies the string into the new space.  Just like the "standard" 
*   stdup(3).
*	
*-----------------------------------------------------------------------*/
char* strdup(char* str)
{
    int len = strlen(str) + 1;
    char* new = malloc(len);
    strcpy(new, str);
    return new;
}
#endif NO_STRDUP
