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' **/
