int ModuleCmd_Update( Tcl_Interp *interp,
int count,
char *module_list[])
{
#ifdef BEGINENV
char *buf, /** Read buffer **/
*var_ptr, /** Pointer to a variables name **/
*val_ptr, /** Pointer to a variables value **/
**load_list, /** List of loaded modules **/
*tmpload, /** LOADEDMODULES contents **/
*loaded, /** Buffer for tokenization **/
*filename; /** The name of the file, where the **/
/** beginning environment resides **/
FILE *file; /** Handle to read in a file **/
int list_count = 0,
maxlist = 16, /** Max. number of list entries **/
buffer_size = UPD_BUFSIZE;
/** Current size of the input buffer **/
char *ptr, c; /** Read pointers and char buffer **/
# if BEGINENV == 99
if (!EMGetEnv( interp,"MODULESBEGINENV")) {
ErrorLogger( ERR_BEGINENVX, LOC, NULL);
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
# endif
/**
** Nothing loaded so far - we're ready!
**/
if(!(tmpload = (char *) getenv("LOADEDMODULES"))) {
if( OK != ErrorLogger( ERR_MODULE_PATH, LOC, NULL))
goto unwind0;
else
goto success0;
}
/**
** First I'll update the environment with whatever in _MODULESBEGINENV_
**/
filename = EMGetEnv( interp,"_MODULESBEGINENV_");
if(filename && *filename) {
/**
** Read the begining environment
**/
if((file = fopen( filename, "r"))) {
if(!(buf = stringer(NULL, buffer_size, NULL )))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind0;
while( !feof( file)) {
/**
** Trigger on entries of the type
** <variable> = <value>
**/
ptr = buf;
while( !feof( file)) {
if((ptr-buf) >= buffer_size-10) { /** 10 bytes safety **/
null_free((void *) &buf);
if(!(buf = stringer(NULL,
buffer_size += UPD_BUFSIZE, NULL )))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind0;
}
/**
** Read a character and put it into the read buffer. Check
** for the lines (CR) or a terminator character ...
**/
if( '\n' == (*ptr++ = c = fgetc( file))) {
*ptr++ = c = '\0';
break;
}
if( !c)
break;
} /** while **/
/**
** If there hasn't been a terminator so far, put it at the
** end of the line. Therefor we've left a safety space at the
** buffers end ;-)
**/
if( c)
*ptr++ = '\0';
/**
** Now let's evaluate the read line
**/
if( (var_ptr = strchr( buf, '=')) ) {
*var_ptr = '\0';
val_ptr = var_ptr+1;
var_ptr = buf;
/**
** Reset the environment to the values derivered from the
** _MODULESBEGINENV_.
** Do not change the LOADEDMODULES variable ;-)
** Do not change the TCL_LIBRARY and TK_LIBRARY also.
**/
if( strncmp( var_ptr, "LOADEDMODULES", 12) &&
strncmp( var_ptr, "TCL_LIBRARY", 10 ) &&
strncmp( var_ptr, "TK_LIBRARY", 9 )) {
if( !strncmp( var_ptr, "MODULEPATH", 10))
moduleSetenv( interp, var_ptr, val_ptr, 1);
else
EMSetEnv( interp, var_ptr, val_ptr);
}
} /** if( var_ptr) **/
} /** while **/
/**
** Close the _MODULESBEGINENV_ file anf free up the read buffer.
**/
null_free((void *) &buf);
if( EOF == fclose( file))
if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL))
goto unwind0;
} else { /** if( fopen) **/
if( OK != ErrorLogger( ERR_OPEN, LOC, filename,_(em_reading),NULL))
goto unwind0;
} /** if( fopen) **/
} /** if( filename) **/
null_free((void *) &filename);
/**
** Allocate memory for a buffer to tokenize the list of loaded modules
** and a list buffer
**/
if(!(load_list = (char**) module_malloc( maxlist*sizeof(char**))))
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
goto unwind0;
if(!(loaded = stringer(NULL, 0, tmpload, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind1;
/**
** Tokenize and build the list
**/
if( *loaded) {
for( load_list[ list_count++] = xstrtok( loaded, ":");
load_list[ list_count-1];
load_list[ list_count++] = xstrtok( NULL, ":") ) {
/**
** Conditionally we have to double the space, we've allocated for
** the list
**/
if( list_count >= maxlist) {
maxlist = maxlist<<1;
if(!(load_list = (char**) module_realloc(
(char *) load_list, maxlist*sizeof(char**))))
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
goto unwind1;
} /** if( maxlist) **/
} /** for **/
/**
** Load all the modules in the list
**/
ModuleCmd_Load( interp, 1, list_count, load_list);
}
/**
** Free up what has been allocated and return on success
**/
null_free((void *) &loaded);
null_free((void *) &load_list);
success0:
return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
unwind1:
null_free((void *) &load_list);
unwind0:
null_free((void *) &filename);
#else /* BEGINENV */
ErrorLogger( ERR_BEGINENV, LOC, NULL);
#endif /* !BEGINENV */
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'ModuleCmd_Update' **/
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' **/
