/*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:
 *      The actual module command from the Tcl level.  This routines calls
 *  other ModuleCmd routines to carry out the subcommand requested. 
 *	
 * $Log: cmdModule.c,v $
 *
 *
 * Revision 1.4  1993/01/23  01:01:23  jlf
 * Fixed a number of memory leaks and large static arrays.
 *
 * Revision 1.3  1993/01/22  17:37:35  jlf
 * Added purge sub-command.
 *
 * Revision 1.2  1993/01/20  03:35:14  jlf
 * Updated to use new version of ModuleCmd_Load()
 *
 * Revision 1.1  1992/11/05  23:33:59  jlf
 * Initial revision
 *
 *---------------------------------------------------------------------------*/
static char Id[] =
    "$Id: cmdModule.c,v 2.0 1993/02/21 00:00:49 jlf Exp jlf $";

#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>

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


int  cmdModule(ClientData client_data,
	       Tcl_Interp* interp,
	       int         argc,
	       char*       argv[])
{
    int     return_val = -1;
    int     store_flags = flags;
    char*   store_curmodule = NULL;

    /*
     *  These skip the arguments past the shell and command.
     */
    int     num_modulefiles = argc - 2;
    char**  modulefile_list = argv + 2;
    char*   module_command  = argv[1];

    /*
     *  For recursion.  This can be called multiple times.
     */
    if(current_module)
	store_curmodule = current_module;
    
    /*
     *  If the command is '-', we want to just start 
     *    interpreting Tcl from stdin.
     */
    if(!strcmp(module_command, "-")) {
	return Execute_TclFile(interp, "stdin");
    }

    if(regexec(addPtr, module_command)) {
	return_val = 
            ModuleCmd_Load(interp, 1, num_modulefiles, modulefile_list);
#ifdef FORCE_PATH
        ForcePath(interp, FORCE_PATHNAME);
#endif
    } else if(regexec(rmPtr, module_command)) {
	return_val = 
            ModuleCmd_Load(interp, 0, num_modulefiles, modulefile_list);
    } else if(regexec(swPtr, module_command)) {
	return_val = 
            ModuleCmd_Switch(interp, num_modulefiles, modulefile_list);
    } else if(regexec(dispPtr, module_command)) {
	return_val = ModuleCmd_Display(interp, modulefile_list);
    } else if(regexec(listPtr, module_command)) {
	return_val = ModuleCmd_List(interp, modulefile_list);
    } else if(regexec(availPtr, module_command)) {
	return_val = ModuleCmd_Avail(interp, modulefile_list);
    } else if(regexec(clearPtr, module_command)) {
	return_val = ModuleCmd_Clear(interp, num_modulefiles, modulefile_list);
    } else if(regexec(updatePtr, module_command)) {
	return_val = ModuleCmd_Update(interp, num_modulefiles, modulefile_list);
    } else if(regexec(purgePtr, module_command)) {
	return_val = ModuleCmd_Purge(interp, num_modulefiles, modulefile_list);
    } else if(regexec(initPtr, module_command)) {
	
	initPtr = regcomp("^inita|^ia");
	if(regexec(initPtr, module_command)) {
	    flags |= M_LOAD;
	    return_val = ModuleCmd_Init(interp, num_modulefiles, modulefile_list);
	    flags &= ~M_LOAD;
	}
	
	initPtr = regcomp("^initr|^ir");
	if(regexec(initPtr, module_command)) {
	    flags |= M_REMOVE;
	    return_val = ModuleCmd_Init(interp, num_modulefiles, modulefile_list);
	    flags &= ~M_REMOVE;
	}
	
	initPtr = regcomp("^initl|^il");
	if(regexec(initPtr, module_command)) {
	    flags |= M_DISPLAY;
	    return_val = ModuleCmd_Init(interp, num_modulefiles, modulefile_list);
	    flags &= ~M_DISPLAY;
	}
	
	initPtr = regcomp("^inits|^is");
	if(regexec(initPtr, module_command)) {
	    flags |= M_SWITCH;
	    return_val = ModuleCmd_Init(interp, num_modulefiles, modulefile_list);
	    flags &= ~M_SWITCH;
	}
	
	initPtr = regcomp("^initc|^ic");
	if(regexec(initPtr, module_command)) {
	    flags |= M_CLEAR;
	    return_val = ModuleCmd_Init(interp, num_modulefiles, modulefile_list);
	    flags &= ~M_CLEAR;
	}
	
	initPtr = regcomp("^initp|^ip");
	if(regexec(initPtr, module_command)) {
	    flags |= (M_PREPEND | M_LOAD);
	    return_val = ModuleCmd_Init(interp, num_modulefiles, modulefile_list);
	    flags &= ~(M_PREPEND | M_LOAD);
	}
    } else if(regexec(usePtr, module_command)) {
	int tmpflags = flags;
	flags = M_LOAD;
	return_val = ModuleCmd_Use(interp, num_modulefiles, modulefile_list);
	flags = tmpflags;
    } else if(regexec(unusePtr, module_command)) {
	return_val = ModuleCmd_UnUse(interp, num_modulefiles, modulefile_list);
    } else if(regexec(helpPtr, module_command)) {
	return_val = ModuleCmd_Help(interp, num_modulefiles, modulefile_list);
    }
    
    flags = store_flags;
    if(store_curmodule)
	current_module = store_curmodule;
    
    if(return_val < 0) {
	Tcl_AppendResult(interp,
			 "'", module_command,
                         "' is an Unrecognized module subcommand", NULL);
	return TCL_ERROR;
    }

    return return_val;
}


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

    if(filename) {
	if((infile = fopen(filename, "r")) == NULL) {
	    Tcl_AppendResult(interp, "'", filename,
			     "' couldn't be opened for reading", NULL);
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendResult(interp, "Internal Error:  Read_Modulefile was given ",
			 "a NULL filename", NULL);
	return TCL_ERROR;
    }

    if(line == NULL) {
        if((line = (char*)malloc(LINELENGTH*sizeof(char))) == NULL) {
            fprintf(stderr, "Couldn't malloc array for reading modulefile\n");
            return TCL_ERROR;
        }
    }

    /*
      Get the first line to verify that it is a Modulefile by
      checking the magic heading.
      
      Every Modulefile should have '#%Module' at the top.
      */
    
    if(fgets(line, LINELENGTH, infile) == NULL) {
	Tcl_AppendResult(interp, "'", filename, "' isn't a Modulefile",
			 " -- missing '#%Module' as first characters", NULL);
	return TCL_ERROR;
    }
    
    if(strncmp(line, MODULES_MAGIC_COOKIE, MODULES_MAGIC_COOKIE_LENGTH)) {
	Tcl_AppendResult(interp, "'", filename, "' isn't a Modulefile\n",
			 "\t\t-- missing '#%Module' as first characters", NULL);
	return TCL_ERROR;
    }

    result = Execute_TclFile(interp, filename);

    if(result == TCL_ERROR) {
	if (*interp->result) {
	    regexp* retexpPtr = regcomp("^EXIT ");
	    if(regexec(retexpPtr, interp->result)) {
		if(*retexpPtr->endp[0] != '\0')
		    result = atoi(retexpPtr->endp[0]);
	    }
            free(retexpPtr);
	}
    }

    fclose(infile);
    return result;
}

int  Execute_TclFile(Tcl_Interp* interp,
		     char*       filename)
{
    FILE*        infile;
    int          gotPartial = 0;
    int          result, linenum = 0;
    char*        cmd;
    Tcl_CmdBuf   cmdbuf;

    if(line == NULL) {
        if((line = (char*)malloc(LINELENGTH*sizeof(char))) == NULL) {
            fprintf(stderr, "Couldn't malloc array for reading modulefile\n");
            return TCL_ERROR;
        }
    }

    /*
     *  If we're supposed to be interpreting from stdin, set infile 
     *    equal to stdin, otherwise, open the file and interpret
     */
    if(!strcmp(filename, "stdin")) {
	infile = stdin;
    } else {
	if((infile = fopen(filename, "r")) == NULL) {
	    Tcl_AppendResult(interp, "'", filename,
			     "' couldn't be opened for reading", NULL);
	    return TCL_ERROR;
	}
    }
    
    /*
     *  Allow access to which file is being loaded.
     */
    Tcl_SetVar(interp, "ModulesCurrentModulefile", filename, 0);
	
    cmdbuf = Tcl_CreateCmdBuf();
    
    while(1) {
        linenum++;
	if(fgets(line, LINELENGTH, infile) == NULL) {
	    if (!gotPartial) {
		goto exit;
	    }
	    line[0] = 0;
	}
	
	cmd = Tcl_AssembleCmd(cmdbuf, line);
	
	if(cmd == NULL) {
	    gotPartial++;
	    continue;
	}
	
        result = Tcl_Eval(interp, cmd, 0, (char**) 0);
        switch(result) {
            case TCL_OK:
	    /* Do Nothing */
            gotPartial = 0;
	    continue;
	    
            case TCL_ERROR:
            interp->errorLine = ((linenum-1)-gotPartial) + interp->errorLine;
            goto exit;
	    
            case TCL_LEVEL0_RETURN:
	    goto exit;
	}
    }

 exit:
    Tcl_DeleteCmdBuf(cmdbuf);

    fclose(infile);
    return result;
}

int  CallModuleProcedure(Tcl_Interp*  interp,
			 Tcl_CmdBuf   cmdbuf,
			 char*        modulefile,
			 char*        procname,
			 int         suppress_output)
{
    char  cmdline[512];
    char*        cmd;
    int          result;
    int          saved_stdout, saved_stderr, devnull;

    /*
     *  Must send stdout and stderr to /dev/null until the 
     *  ModulesHelp procedure is called.
     */
    if(suppress_output) {
	if((devnull = open("/dev/null", O_RDWR)) < 0) {
	    fprintf(stderr, "Open of /dev/null failed\n");
	}
	
	saved_stdout = dup(1);
	close(1);
	dup(devnull);
	
	saved_stderr = dup(2);
	close(2);
	dup(devnull);
    }

    Read_Modulefile(interp, modulefile);

    if(suppress_output) {
	fflush(stdout);
	fflush(stderr);
	
	close(1);
	dup(saved_stdout);
	
	close(2);
	dup(saved_stderr);
    }	

    sprintf(cmdline, "%s\n", procname);
    cmd = Tcl_AssembleCmd(cmdbuf, cmdline);

    result = Tcl_Eval(interp, cmd, 0, (char**) 0);

    return result;
}
