/*****
 ** ** Module Header ******************************************************* **
 ** 									     **
 **   Modules Revision 3.0						     **
 **   Providing a flexible user environment				     **
 ** 									     **
 **   File:		cmdModule.c					     **
 **   First Edition:	1991/10/23					     **
 ** 									     **
 **   Authors:	John Furlan, jlf@behere.com				     **
 **		Jens Hamisch, jens@Strawberry.COM			     **
 **		R.K. Owen, <rk@owen.sj.ca.us> or <rkowen@nersc.gov>	     **
 ** 									     **
 **   Description:	The actual module command from the Tcl level. This   **
 **			routines calls other ModuleCmd routines to carry out **
 **			the subcommand requested. 			     **
 ** 									     **
 **   Exports:		cmdModule					     **
 **			Read_Modulefile					     **
 **			Execute_TclFile					     **
 **			CallModuleProcedure				     **
 ** 									     **
 **   Notes:								     **
 ** 									     **
 ** ************************************************************************ **
 ****/

/** ** Copyright *********************************************************** **
 ** 									     **
 ** Copyright 1991-1994 by John L. Furlan.                      	     **
 ** see LICENSE.GPL, which must be provided, for details		     **
 ** 									     ** 
 ** ************************************************************************ **/

static char Id[] = "@(#)$Id: cmdModule.c,v 1.23 2009/09/02 20:37:39 rkowen Exp $";
static void *UseId[] = { &UseId, Id };

/** ************************************************************************ **/
/** 				      HEADERS				     **/
/** ************************************************************************ **/

#include "modules_def.h"

/** ************************************************************************ **/
/** 				  LOCAL DATATYPES			     **/
/** ************************************************************************ **/

/** not applicable **/

/** ************************************************************************ **/
/** 				     CONSTANTS				     **/
/** ************************************************************************ **/

/** not applicable **/

/** ************************************************************************ **/
/**				      MACROS				     **/
/** ************************************************************************ **/

/** not applicable **/

/** ************************************************************************ **/
/** 				    LOCAL DATA				     **/
/** ************************************************************************ **/

char	_fil_stdin[] = "stdin";
char	_fil_stdout[] = "stdout";
char	_fil_stderr[] = "stderr";
char	_fil_devnull[] = "/dev/null";
int	linenum = 0;
static	char	module_name[] = __FILE__;
char	 *module_command;

/** ************************************************************************ **/
/**				    PROTOTYPES				     **/
/** ************************************************************************ **/

/** not applicable **/


/*++++
 ** ** Function-Header ***************************************************** **
 ** 									     **
 **   Function:		cmdModule					     **
 ** 									     **
 **   Description:	Evaluation of the module command line and callup of  **
 **			the according subroutine			     **
 ** 									     **
 **   First Edition:	1991/10/23					     **
 ** 									     **
 **   Parameters:	ClientData	 client_data			     **
 **			Tcl_Interp	*interp		According Tcl interp.**
 **			int		 objc		Number of arguments  **
 **			Tcl_Obj		*objv[]		Argument array	     **
 ** 									     **
 **   Result:		int	TCL_OK		Successful completion	     **
 **				TCL_ERROR	Any error		     **
 ** 									     **
 **   Attached Globals:	g_flags		These are set up accordingly before  **
 **					this function is called in order to  **
 **					control everything		     **
 **			g_current_module	The module which is handled  **
 **						by the current command	     **
 ** 									     **
 ** ************************************************************************ **
 ++++*/

int cmdModule(
	ClientData client_data,
	Tcl_Interp * interp,
	int objc,
	Tcl_Obj * CONST84 objv[]
) {
	int             return_val = -1,	/** exit return value	     **/
	    store_flags = g_flags,		/** local copy of flags	     **/
	    match = 0,				/** found match		     **/
	    i;
	char           *store_curmodule = NULL,	/** current module name	     **/
	    *save_module_command = NULL;	/** save module command	     **/
    /**
     **  These skip the arguments past the shell and command.
     **/
	int             num_modulefiles = objc - 2;
	char          **modulefile_list;
	int             argc;

#if 0
	int             x = 0;
#  define _XD	fprintf(stderr,":%d:",++x),
#else
#  define _XD
#endif

#define	_MTCH	_XD match =
#define	_ISERR	((match == -1) && (*TCL_RESULT(interp)))
#define _TCLCHK(a) {if(_ISERR) ErrorLogger(ERR_EXEC,LOC,TCL_RESULT(a),NULL);}

    /**
     **  Help or whatis mode?
     **/
	if (g_flags & (M_HELP | M_WHATIS))
		return (TCL_OK);
    /**
     **  Parameter check
     **/
	if (objc < 2) {
		(void)ErrorLogger(ERR_USAGE, LOC, "module", " command ",
				  " [arguments ...] ", NULL);
		(void)ModuleCmd_Help(interp, 0, NULL);
		return (TCL_ERROR);	/** -------- EXIT (FAILURE) -------> **/
	}
    /**
     **  Non-persist mode?
     **/
	if (g_flags & M_NONPERSIST) {
		return (TCL_OK);
	}
    /**
     **  Display whatis mode?
     **/
	if (g_flags & M_DISPLAY) {
		fprintf(stderr, "%s\t\t ", Tcl_GetString(objv[0]));
		for (i = 1; i < objc; i++)
			fprintf(stderr, "%s ", Tcl_GetString(objv[i]));
		fprintf(stderr, "\n");
		return (TCL_OK);
	}
    /**
     **  For recursion.  This can be called multiple times.
     **/
	save_module_command = module_command;
	module_command = stringer(NULL, 0, Tcl_GetString(objv[1]), NULL);

	if (g_current_module)
		store_curmodule = g_current_module;

	/* convert the modulefile_list from Objv to Argv to pass along */
	Tcl_ObjvToArgv(&argc, &modulefile_list, objc - 2, objv + 2);

    /**
     **  If the command is '-', we want to just start 
     **    interpreting Tcl from stdin.
     **/
	if (_XD ! strcmp(module_command, "-")) {
		return_val = Execute_TclFile(interp, _fil_stdin);
    /**
     **  Evaluate the module command and call the according subroutine
     **  --- module LOAD|ADD
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, addRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Load(interp, 1, num_modulefiles, modulefile_list);
       /**
        **  We always say the load succeeded.  ModuleCmd_Load will
        **  output any necessary error messages.
        **/
		return_val = TCL_OK;
    /**
     **  --- module UNLOAD
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, rmRE))) {
		_TCLCHK(interp);
		ModuleCmd_Load(interp, 0, num_modulefiles, modulefile_list);
		return_val = TCL_OK;
    /**
     **  --- module SWITCH
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, swRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Switch(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module DISPLAY
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, dispRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Display(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module LIST
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, listRE))) {
		_TCLCHK(interp);
		if (!(sw_format & SW_SET)) {	/* default format options */
			sw_format |= (SW_HUMAN | SW_TERSE);
			sw_format &= ~(SW_PARSE | SW_LONG);
		}
		/* use SW_LIST to indicate LIST & not AVAIL */
		sw_format |= SW_LIST;
		return_val =
		    ModuleCmd_List(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module AVAIL
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, availRE))) {
		_TCLCHK(interp);
		if (!(sw_format & SW_SET)) {	/* default format options */
			sw_format |= (SW_HUMAN | SW_TERSE);
			sw_format &= ~(SW_PARSE | SW_LONG);
		}
		/* use SW_LIST to indicate LIST & not AVAIL */
		sw_format &= ~SW_LIST;
		return_val =
		    ModuleCmd_Avail(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module WHATIS and APROPOS
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, whatisRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Whatis(interp, num_modulefiles, modulefile_list);

	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, aproposRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Apropos(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module CLEAR
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, clearRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Clear(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module UPDATE
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, updateRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Update(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module PURGE
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, purgeRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Purge(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module INIT
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, initRE))) {
		_TCLCHK(interp);

		if (Tcl_RegExpMatch(interp, module_command, "^inita|^ia")) {
			/* initadd */
			_TCLCHK(interp);
			g_flags |= M_LOAD;
			return_val =
			    ModuleCmd_Init(interp, num_modulefiles,
					   modulefile_list);
			g_flags &= ~M_LOAD;
		}

		if (Tcl_RegExpMatch(interp, module_command, "^initr|^iw")) {
			/* initrm */
			_TCLCHK(interp);
			g_flags |= M_REMOVE;
			return_val =
			    ModuleCmd_Init(interp, num_modulefiles,
					   modulefile_list);
			g_flags &= ~M_REMOVE;
		}

		if (Tcl_RegExpMatch(interp, module_command, "^initl|^il")) {
			/* initlist */
			_TCLCHK(interp);
			g_flags |= M_DISPLAY;
			return_val =
			    ModuleCmd_Init(interp, num_modulefiles,
					   modulefile_list);
			g_flags &= ~M_DISPLAY;
		}

		if (Tcl_RegExpMatch(interp, module_command, "^inits|^is")) {
			/* initswitch */
			_TCLCHK(interp);
			g_flags |= M_SWITCH;
			return_val =
			    ModuleCmd_Init(interp, num_modulefiles,
					   modulefile_list);
			g_flags &= ~M_SWITCH;
		}

		if (Tcl_RegExpMatch(interp, module_command, "^initc|^ic")) {
			/* initclear */
			_TCLCHK(interp);
			g_flags |= M_CLEAR;
			return_val =
			    ModuleCmd_Init(interp, num_modulefiles,
					   modulefile_list);
			g_flags &= ~M_CLEAR;
		}

		if (Tcl_RegExpMatch(interp, module_command, "^initp|^ip")) {
			/*initprepend */
			_TCLCHK(interp);
			g_flags |= (M_PREPEND | M_LOAD);
			return_val =
			    ModuleCmd_Init(interp, num_modulefiles,
					   modulefile_list);
			g_flags &= ~(M_PREPEND | M_LOAD);
		}
    /**
     **  --- module USE
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, useRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Use(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module UNUSE
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, unuseRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_UnUse(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module REFRESH 
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, refreshRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Refresh(interp, num_modulefiles, modulefile_list);
    /**
     **  --- module HELP
     **/
	} else if ((_MTCH Tcl_RegExpMatch(interp, module_command, helpRE))) {
		_TCLCHK(interp);
		return_val =
		    ModuleCmd_Help(interp, num_modulefiles, modulefile_list);
	}
    /**
     **  Evaluate the subcommands return value in order to get rid of unrecog-
     **  nized commands
     **/
	if (return_val < 0)
		if (OK != ErrorLogger(ERR_COMMAND, LOC, module_command, NULL))
			return (TCL_ERROR); /** ------ EXIT (FAILURE) -----> **/
    /**
     **  Clean up from recursion
     **/
	g_flags = store_flags;
	if (store_curmodule)
		g_current_module = store_curmodule;

	module_command = save_module_command;

    /**
     **  Return on success
     **/
	return (return_val);

} /** End of 'cmdModule' **/

/*++++
 ** ** Function-Header ***************************************************** **
 ** 									     **
 **   Function:		Read_Modulefile					     **
 ** 									     **
 **   Description:	Check the passed filename for to be a valid module   **
 **			and execute the according command file		     **
 ** 									     **
 **   First Edition:	1991/10/23					     **
 ** 									     **
 **   Parameters:	Tcl_Interp	*interp		According Tcl interp.**
 **		 	char		*filename			     **
 ** 									     **
 **   Result:		int	TCL_OK		Successful completion	     **
 **				TCL_BREAK	break command		     **
 **				TCL_ERROR	Any error		     **
 ** 									     **
 **   Attached Globals:							     **
 ** 									     **
 ** ************************************************************************ **
 ++++*/

int   Read_Modulefile( Tcl_Interp	*interp, 
		       char		*filename)
{
    int    result;

    /**
     **  Parameter check. A valid filename is to be given.
     **/
    if( !filename) {
	if( OK != ErrorLogger( ERR_PARAM, LOC, "filename", NULL))
	    return( TCL_ERROR);		/** -------- EXIT (FAILURE) -------> **/
    }

    /**
     **  Check for the module 'magic cookie'
     **  Trust stdin as a valid module file ...
     **/
    
    if( !strcmp( filename, _fil_stdin) && !check_magic( filename,
    	MODULES_MAGIC_COOKIE, MODULES_MAGIC_COOKIE_LENGTH)) {
	if( OK != ErrorLogger( ERR_MAGIC, LOC, filename, NULL))
	    return( TCL_ERROR);		/** -------- EXIT (FAILURE) -------> **/
    }

    /**
     **  Now do execute that module file and evaluate the result of the
     **  latest executed command
     **/

    result = Execute_TclFile(interp, filename);

    /**
     **  Return the result as derivered from the module file execution
     **/
    return( result);

} /** End of 'Read_Modulefile' **/

/*++++
 ** ** Function-Header ***************************************************** **
 ** 									     **
 **   Function:		Execute_TclFile					     **
 ** 									     **
 **   Description:	Read in and execute all commands concerning the Tcl  **
 **			file passed as parameter			     **
 ** 									     **
 **   First Edition:	1991/10/23					     **
 ** 									     **
 **   Parameters:	Tcl_Interp	*interp		According Tcl interp.**
 **		 	char		*filename			     **
 ** 									     **
 **   Result:		int	TCL_OK		Successful completion	     **
 **				TCL_ERROR	Any error		     **
 ** 									     **
 **   Attached Globals:	line		Input read buffer		     **
 ** 									     **
 ** ************************************************************************ **
 ++++*/

int	 Execute_TclFile(	Tcl_Interp	*interp,
		     		char		*filename)
{
    FILE	*infile;
    int		 gotPartial = 0;
    int		 result = 0;
    EM_RetVal	 em_result = EM_OK;
    char	*cmd;
    Tcl_DString	 cmdbuf;

    /**
     **  If there isn't a line buffer allocated so far, do it now
     **/
    if( line == NULL) {
        if( NULL == (line = (char*) module_malloc(LINELENGTH * sizeof(char)))) {
	    if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
		return( TCL_ERROR);	/** -------- EXIT (FAILURE) -------> **/
        }
    }

    /**
     **  If we're supposed to be interpreting from stdin, set infile 
     **  equal to stdin, otherwise, open the file and interpret
     **/

    if( !strcmp( filename, _fil_stdin)) {
	infile = stdin;
    } else {
	if( NULL == (infile = fopen( filename, "r"))) {
	    if( OK != ErrorLogger( ERR_OPEN, LOC, filename,
		_(em_reading), NULL))
		return( TCL_ERROR);	/** -------- EXIT (FAILURE) -------> **/
	}
    }
    
    /**
     **  Allow access to which file is being loaded.
     **/

    linenum = 0;
    Tcl_SetVar( interp, "ModulesCurrentModulefile", filename, 0);
    Tcl_DStringInit( &cmdbuf);
    
    while( 1) {

        linenum++;
	if( fgets(line, LINELENGTH, infile) == NULL) {
	    if( !gotPartial) {
		break;	/** while **/
	    }
	    line[0] = '\0';
	}
	
	/**
	 **  Put the whole command on the command buffer
	 **/

	cmd = Tcl_DStringAppend( &cmdbuf, line, (-1));
	
	if( line[0] != 0  && !Tcl_CommandComplete(cmd)) {
	    gotPartial++;
	    continue;
	}
	
	/**
	 **  Now evaluate the command and react on its result
	 **  Reinitialize the command buffer
	 **/

        result = Tcl_Eval( interp, cmd);

	if( EM_ERROR == (em_result = ReturnValue(interp, result))) {
	    ErrorLogger( ERR_EXEC, LOC, cmd, NULL);
	}

	Tcl_DStringTrunc( &cmdbuf, 0);

        switch( result) {

            case TCL_OK:	gotPartial = 0;
			        continue;	/** while **/
	    
            case TCL_ERROR:	interp->errorLine = ((linenum-1)-gotPartial) +
				    interp->errorLine;
	    			/* FALLTHROUGH */

            case TCL_LEVEL0_RETURN:
	    			break;	/** switch **/
	}

	/**
	 **  If the while loop hasn't been continued so far, it is to be broken
	 **  now
	 **/

	break;	/** while **/

    } /** while **/

    /**
     **  Free up what has been used, close the input file and return the result
     **  of the last command to the caller
     **/

    Tcl_DStringFree( &cmdbuf);
    if( EOF == fclose( infile))
	if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL))
	    return( TCL_ERROR);		/** -------- EXIT (FAILURE) -------> **/

    return( result);

} /** End of 'Execute_TclFile' **/

/*++++
 ** ** Function-Header ***************************************************** **
 ** 									     **
 **   Function:		CallModuleProcedure				     **
 ** 									     **
 **   Description:	Call a Tcl Procedure				     **
 **			Executes the passed modulefile (conditionally hidden)**
 **			and then evaluates the passed Tcl procedure	     **
 ** 									     **
 **   First Edition:	1991/10/23					     **
 ** 									     **
 **   Parameters:	Tcl_Interp	*interp		According Tcl interp.**
 **			Tcl_DString	*cmdptr		Buffer fot the Tcl   **
 **							command		     **
 **			char		*modulefile	According module file**
 **			char		*procname	Name of the Tcl Proc.**
 **			int		 suppress_output  Controlls redirect.**
 **							of stdout and stderr **
 ** 									     **
 **   Result:		int	TCL_OK		Successful completion	     **
 **				TCL_ERROR	Any error		     **
 ** 									     **
 **   Attached Globals:	-						     **
 ** 									     **
 ** ************************************************************************ **
 ++++*/

int  CallModuleProcedure(	Tcl_Interp	*interp,
			 	Tcl_DString	*cmdptr,
			 	char		*modulefile,
			 	char		*procname,
			 	int		 suppress_output)
{
    char 	 cmdline[ LINELENGTH];
    char	*cmd;
    int          result;
    int          saved_stdout = 0, saved_stderr = 0, devnull;

    /**
     **  Must send stdout and stderr to /dev/null until the 
     **  ModulesHelp procedure is called.
     **/
    if( suppress_output) {
	if( 0 > (devnull = open( _fil_devnull, O_RDWR))) {
	    if( OK != ErrorLogger( ERR_OPEN, LOC, _fil_devnull,
		_(em_read_write), NULL))
		return( TCL_ERROR);	/** -------- EXIT (FAILURE) -------> **/
	}
	
	/**
	 **  Close STDOUT and reopen it as /dev/null
	 **/

	if( -1 == ( saved_stdout = dup( 1)))
	    if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
	
	if( -1 == close( 1))
	    if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/

	if( -1 == dup( devnull))
	    if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
	
	/**
	 **  Close STDERR and reopen it as /dev/null
	 **/

	if( -1 == ( saved_stdout = dup( 2)))
	    if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
	
	if( -1 == close( 2))
	    if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/

	if( -1 == dup( devnull))
	    if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
    }

    /**
     **  Read the passed module file
     **/

    Read_Modulefile( interp, modulefile);

    /**
     **  Reinstall stdout and stderr
     **/

    if( suppress_output) {

	/**
	 **  Reinstall STDOUT
	 **/

	if( EOF == fflush( stdout))
	    if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stdout, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/

	if( EOF == fflush( stderr))
	    if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stderr, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
	
	if( -1 == close( 1))
	    if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/

	/**
	 **  Reinstall STDERR
	 **/

	if( -1 == dup( saved_stdout))
	    if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
	
	if( -1 == close( 2))
	    if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
	
	if( -1 == dup( saved_stderr))
	    if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL))
		return( TCL_ERROR);	/** ------- EXIT (FAILURE) --------> **/
    }	

    /**
     **  Now evaluate the Tcl Procedure
     **/

    /* sprintf( cmdline, "%s\n", procname); */
    strcpy( cmdline, procname);
    strcat( cmdline, "\n");
    cmd = Tcl_DStringAppend( cmdptr, cmdline, (-1));

    result = Tcl_Eval( interp, cmd);
    Tcl_DStringTrunc( cmdptr, 0);

    return( result);

} /** End of 'CallModuleProcedure' **/