int Read_Modulefile( Tcl_Interp *interp, char *filename) { int result; char *startp, *endp; #if WITH_DEBUGGING_UTIL ErrorLogger( NO_ERR_START, LOC, _proc_Read_Modulefile, NULL); #endif /** ** 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); #if WITH_DEBUGGING_UTIL if(EM_ERROR == ReturnValue(interp, result)) ErrorLogger( NO_ERR_DEBUG, LOC, "Execution of '", filename, "' failed", NULL); #endif /** ** Return the result as derivered from the module file execution **/ #if WITH_DEBUGGING_UTIL ErrorLogger( NO_ERR_END, LOC, _proc_Read_Modulefile, NULL); #endif return( result); } /** End of 'Read_Modulefile' **/
int SourceVers( Tcl_Interp *interp, char *path, char *name) { struct stat stats; /** Buffer for the stat() systemcall **/ int save_flags; char *buffer; char *modname; /** ptr to module part of name **/ int Result = TCL_OK; char *version; char *new_argv[3]; char *mod, *ver; /** ** If there's a problem with the input parameters it means, that ** we do not have to source anything ** Only a valid TCL interpreter should be there **/ if( !path || !name) return( TCL_OK); if( !interp) return( TCL_ERROR); /** ** Build the full name of the RC file and check whether it exists and ** has the magic cookie inside **/ if ((char *) NULL == (buffer = stringer(NULL, 0, path,"/",version_file, NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) return( TCL_ERROR); if( !stat( buffer, &stats)) { if( #if VERSION_MAGIC != 0 check_magic( buffer, MODULES_MAGIC_COOKIE, MODULES_MAGIC_COOKIE_LENGTH) #else 1 #endif ) { save_flags = g_flags; g_flags = M_LOAD; if( TCL_ERROR != (Result = Execute_TclFile( interp, buffer)) && (version = (char *) Tcl_GetVar(interp, "ModulesVersion", 0))) { /** ** The version has been specified in the ** '.version' file. Set up the result code **/ /* for deep modulefile dirs ... just use lowest part */ if (!(modname = (char*) strrchr( name, '/'))) { modname = name; } else { modname++; } null_free((void *) &buffer); if ((char *) NULL == (buffer = stringer(NULL, 0, modname,"/",version, NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) return( TCL_ERROR); new_argv[0] = "module-version"; new_argv[1] = buffer; new_argv[2] = _default; /** ** Define the default version **/ if( TCL_OK != cmdModuleVersion( (ClientData) 0, (Tcl_Interp *) NULL, 3, (CONST84 char **) new_argv)) { Result = TCL_ERROR; } } /** if( Execute...) **/ g_flags = save_flags; } else ErrorLogger( ERR_MAGIC, LOC, buffer, NULL); } /** if( !stat) **/ /** ** free buffer memory **/ null_free((void *) &buffer); /** ** Result determines if this was successful **/ return( Result); } /** End of 'SourceVers' **/
int SourceRC(Tcl_Interp *interp, char *path, char *name) { struct stat stats; /** Buffer for the stat() systemcall **/ int save_flags, i = 0; char *buffer; int Result = TCL_OK; static char **srclist = (char **)NULL; static int listsize = 0, listndx = 0; /* dummy condition to use 'i': */ if (i == 0) { ; } /** ** If there is a problem with the input parameters it means, that ** we do not have to source anything ** Only a valid TCL interpreter should be there **/ if (!path || !name) { return (TCL_OK); } if (!interp) { return (TCL_ERROR); } /** ** Build the full name of the RC file ** Avoid duplicate sourcing **/ if ((char *)NULL == (buffer = stringer(NULL, 0, path,"/", name, NULL))) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind0; } } /** ** Check whether the RC file exists and has the magic cookie inside **/ if (!stat(buffer, &stats)) { if (check_magic(buffer, MODULES_MAGIC_COOKIE, MODULES_MAGIC_COOKIE_LENGTH)) { /** ** Set the flags to 'load only'. This prevents from accidently ** printing something **/ save_flags = g_flags; g_flags = M_LOAD; /** ** Source now **/ if (TCL_ERROR == Execute_TclFile(interp, buffer)) { if (OK != ErrorLogger(ERR_SOURCE, LOC, buffer, NULL)) { Result = TCL_ERROR; } } g_flags = save_flags; /** ** Save the currently sourced file in the list ** Check whether the list is big enough to fit in a new entry **/ if (!listsize) { listsize = SRCFRAG; if ((char **)NULL == (srclist = (char **)module_malloc((size_t)((unsigned long)listsize * sizeof(char **))))) { ErrorLogger(ERR_ALLOC, LOC, NULL); goto unwind1; } } else if ((listndx + 1) >= listsize) { listsize += SRCFRAG; if (!(srclist = (char **)module_realloc(srclist, (size_t)((unsigned long)listsize * sizeof(char **))))) { ErrorLogger(ERR_ALLOC, LOC, NULL); goto unwind1; } } /** ** Put the current RC files name on the list: **/ srclist[listndx++] = buffer; } else { ErrorLogger(ERR_MAGIC, LOC, buffer, NULL); null_free((void *)&buffer); } } /** end "if (!stat)" **/ /** ** Return our result **/ return (Result); unwind1: null_free((void *)&buffer); unwind0: return (TCL_ERROR); } /** End of 'SourceRC' **/
int cmdModule( ClientData client_data, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { int return_val = -1, i; int store_flags = g_flags; char *store_curmodule = NULL; char *save_module_command = NULL; int match = 0; /** ** These skip the arguments past the shell and command. **/ int num_modulefiles = argc - 2; char **modulefile_list = (char **) argv + 2; #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);} #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_START, LOC, _proc_cmdModule, NULL); #endif /** ** Help or whatis mode? **/ if( g_flags & (M_HELP | M_WHATIS)) return( TCL_OK); /** ** Parameter check **/ if( argc < 2) { (void) ErrorLogger( ERR_USAGE, LOC, "module", " command ", " [arguments ...] ", NULL); (void) ModuleCmd_Help( interp, 0, modulefile_list); 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 ", argv[ 0]); for( i=1; i<argc; i++) fprintf( stderr, "%s ", argv[ i]); fprintf( stderr, "\n"); return( TCL_OK); } /** ** For recursion. This can be called multiple times. **/ save_module_command = module_command; module_command = strdup( argv[1]); if( g_current_module) store_curmodule = g_current_module; /** ** 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); } /** ** Tracing **/ if( CheckTracingList(interp, module_command, num_modulefiles, modulefile_list)) Module_Tracing( return_val, argc, (char **) argv); /** ** 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); /** ** Clean up from recursion **/ g_flags = store_flags; if( store_curmodule) g_current_module = store_curmodule; module_command = save_module_command; /** ** Return on success **/ #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_END, LOC, _proc_cmdModule, NULL); #endif return( return_val); } /** End of 'cmdModule' **/