void kpr_close_config(KPR *kpr)
{
while(kpr->next != NULL)
{
null_free(kpr->name);
null_free(kpr->path);
null_free(kpr->arg);
free(kpr);
kpr=kpr->next;
}
}
static
void null_del (null_t *nt)
{
if (nt != NULL) {
null_free (nt);
free (nt);
}
}
//------------------------------------------------------------------------------------------------
// Name: ddx2Release()
// Desc: Zrusi rezervovar na surfacy
//------------------------------------------------------------------------------------------------
void ddx2Release(void)
{
int i;
for(i = 0; i < slist.surf_max; i++) {
ddx2ReleaseBitmap(i);
}
null_free(&slist.p_slist);
}
//------------------------------------------------------------------------------------------------
// Name: ddx2Release()
// Desc: Zrusi rezervovar na surfacy
//------------------------------------------------------------------------------------------------
void ddx2Release(void)
{
if (ddx2InitDone) {
int i;
for (i = 0; i < slist.surf_max; i++) {
ddx2ReleaseBitmap(i);
}
null_free((void **) &slist.p_slist);
ddx2InitDone = FALSE;
}
}
void oe_group_smaz_stejne(K_EDITOR * p_cnf)
{
I_VERTEX *p_group;
BOD p, *p_bod;
int i, j, k, o, v, m;
m = 0;
for (i = 0; i < p_cnf->groupnum; i++) {
k = p_cnf->p_group[i].k;
o = p_cnf->p_group[i].o;
v = p_cnf->p_group[i].v;
p.x = p_cnf->p_kont[k]->p_obj[o]->p_vertex[v].x;
p.y = p_cnf->p_kont[k]->p_obj[o]->p_vertex[v].y;
p.z = p_cnf->p_kont[k]->p_obj[o]->p_vertex[v].z;
for (j = i + 1; j < p_cnf->groupnum; j++) {
k = p_cnf->p_group[j].k;
o = p_cnf->p_group[j].o;
v = p_cnf->p_group[j].v;
p_bod = (BOD *) p_cnf->p_kont[k]->p_obj[o]->p_vertex + v;
if (p.x == p_bod->x && p.y == p_bod->y && p.z == p_bod->z) {
p_cnf->p_group[j].k = -1;
m++;
}
}
}
if (m) {
p_group = malloc(sizeof(p_group[0]) * (p_cnf->groupnum - m));
mtest(p_group);
for (m = 0, i = 0; i < p_cnf->groupnum; i++) {
if (p_cnf->p_group[i].k != -1) {
p_group[m].k = p_cnf->p_group[i].k;
p_group[m].o = p_cnf->p_group[i].o;
p_group[m].v = p_cnf->p_group[i].v;
m++;
}
}
null_free(&p_cnf->p_group);
p_cnf->p_group = p_group;
p_cnf->groupnum = m;
p_cnf->vybr_group = 0;
}
}
void FreeList(char **list, int numelem)
{
register int j;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger(NO_ERR_START, LOC, _proc_FreeList, NULL);
#endif /* WITH_DEBUGGING_UTIL_2 */
/**
** Nothing to do ?
**/
if( !list)
return;
/**
** Free all elements of the list
**/
for( j = 0; j < numelem; j++)
if( list[j] != NULL)
null_free((void *) (list + j));
/**
** Free the entire list
**/
null_free((void *) &list);
} /** End of 'FreeList' **/
/* uvec_close - destroy the uvec contents */
int uvec_close(uvec *uv) {
int i;
if (uv == (uvec *) NULL) {
return -1;
}
*(uv->tag) = '\0';
for (i = 0; i < uv->number; ++i) {
(uv->str_fns.str_free)(&(uv->vector[i]));
uv->vector[i] = (char *) NULL;
}
null_free((void **) &(uv->vector));
/* uv->vector = (char **) NULL; */
uv->capacity = 0;
uv->number = 0;
return 0;
}
int lo_nacti_vertexlist_out(FFILE f, OBJEKT_BOD ** p_vert)
{
GENERIC_HEAD head;
long t = fftell(f);
float v[3];
int i;
if (*p_vert != NULL) {
return ((int) NULL);
}
if (!ffread(&head, sizeof(head), 1, f)) {
ffseek(f, t, SEEK_SET);
return ((int) NULL);
}
if ((head.h[0] != 'V') ||
(head.h[1] != 'V') || (head.h[2] != 'V') || (head.h[3] != 'V')) {
ffseek(f, t, SEEK_SET);
return ((int) NULL);
}
if ((*p_vert =
(OBJEKT_BOD *) mmalloc(sizeof(OBJEKT_BOD) * head.pocet)) == NULL) {
chyba("Nedostatek pameti...");
}
memset(*p_vert, 0, sizeof(OBJEKT_BOD) * head.pocet);
for (i = 0; i < head.pocet; i++) {
if (!ffread(&v, sizeof(v), 1, f)) {
ffseek(f, t, SEEK_SET);
null_free((void **) p_vert);
return ((int) NULL);
}
(*p_vert)[i].x = v[0];
(*p_vert)[i].y = v[1];
(*p_vert)[i].z = v[2];
(*p_vert)[i].dr = (*p_vert)[i].dg = (*p_vert)[i].db = 1.0f;
}
return (head.pocet);
}
int lo_nacti_facelist_out(FFILE f, FACE ** p_face)
{
GENERIC_HEAD head;
long t = fftell(f);
if (*p_face != NULL)
return ((int) NULL);
if (!ffread(&head, sizeof(head), 1, f)) {
ffseek(f, t, SEEK_SET);
return ((int) NULL);
}
if ((head.h[0] != 'F') ||
(head.h[1] != 'F') || (head.h[2] != 'F') || (head.h[3] != 'F')) {
ffseek(f, t, SEEK_SET);
return ((int) NULL);
}
head.pocet *= 3;
if (!head.pocet)
chyba("load facelist -> 0 facu !");
if ((*p_face = (FACE *) mmalloc(sizeof(FACE) * head.pocet)) == NULL) {
chyba("Nedostatek pameti...");
}
if (!ffread(*p_face, sizeof(FACE), head.pocet, f)) {
null_free((void **) p_face);
ffseek(f, t, SEEK_SET);
return ((int) NULL);
}
return (head.pocet);
}
static char *GetModuleName(Tcl_Interp *interp, char *path, char *prefix,
char *modulename)
{
struct stat stats; /** Buffer for the stat() systemcall **/
char *fullpath = NULL; /** Buffer for creating path names **/
char *Result = NULL; /** Our return value **/
char **filelist = NULL; /** Buffer for a list of possible
** module files **/
int numlist; /** Size of this list **/
int i, slen, is_def;
char *s, *t; /** Private string buffer **/
char *mod, *ver; /** Pointer to module and version **/
char *mod1, *ver1; /** Temp pointer **/
#if WITH_DEBUGGING_LOCATE_1
ErrorLogger(NO_ERR_START, LOC, _proc_GetModuleName, NULL);
#endif /* WITH_DEBUGGING_LOCATE_1 */
/**
** Split the modulename into module and version. Use a private buffer
** for this
**/
if ((char *)NULL == (s = stringer(NULL, 0, modulename, NULL))) {
ErrorLogger(ERR_ALLOC, LOC, NULL);
goto unwind0;
}
slen = (int)(strlen(s) + 1);
mod = s;
/* assume that the '=' here is correct, because otherwise 'ver' would not
* be initialized here yet (I think): */
if ((ver = strrchr(mod, '/'))) {
*ver++ = '\0';
}
/**
** Allocate a buffer for full pathname building:
**/
if ((char *)NULL == (fullpath = stringer(NULL, MOD_BUFSIZE, NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind1;
}
}
/**
** Check whether $path/$prefix/$modulename is a directory.
**/
if (prefix) {
if ((char *)NULL == stringer(fullpath, MOD_BUFSIZE, path, "/", prefix,
"/", modulename, NULL)) {
goto unwind1;
}
} else {
if ((char *)NULL == stringer(fullpath, MOD_BUFSIZE, path, "/",
modulename, NULL)) {
goto unwind1;
}
}
if (!stat(fullpath, &stats) && S_ISDIR(stats.st_mode)) {
/**
** So the full modulename is $modulename/default. Recurse on that.
**/
if ((char *)NULL == (t = stringer(NULL, 0, modulename, "/",
_default, NULL))) {
goto unwind1;
}
Result = GetModuleName(interp, path, prefix, t);
null_free((void *)&t);
null_free((void *)&fullpath);
null_free((void *)&s);
return (Result);
}
/**
** Check whether $path/$prefix/$mod is a directory:
**/
if (prefix) {
if ((char *)NULL == stringer(fullpath, MOD_BUFSIZE, path, "/", prefix,
"/", mod, NULL)) {
goto unwind1;
}
} else {
if ((char *)NULL == stringer(fullpath, MOD_BUFSIZE, path, "/",
mod, NULL)) {
goto unwind1;
}
}
is_def = !strcmp(mod, _default);
if (is_def || !stat(fullpath, &stats)) {
/**
** If it is a directory, then do this:
**/
if (!is_def && S_ISDIR( stats.st_mode)) {
/**
** Source the ".modulerc" file if it exists.
** For compatibility source the .version file, too.
**/
if (prefix) {
if ((char *)NULL == stringer(modfil_buf, MOD_BUFSIZE,
prefix, "/", mod, NULL)) {
goto unwind2;
}
} else {
if ((char *)NULL == stringer(modfil_buf, MOD_BUFSIZE,
mod, NULL)) {
goto unwind2;
}
}
if ((char *)NULL == stringer(fullpath, MOD_BUFSIZE, path, "/",
modfil_buf, NULL)) {
goto unwind2;
}
g_current_module = modfil_buf;
if ((TCL_ERROR == SourceRC(interp, fullpath, modulerc_file)) ||
(TCL_ERROR == SourceVers(interp, fullpath, modfil_buf))) {
/* flags = save_flags; */
goto unwind2;
}
/**
** After sourcing the RC files, we have to look up the
** versions again:
**/
if (VersionLookup(modulename, &mod1, &ver1)) {
int len = (int)(strlen(mod1) + strlen(ver1) + 2);
/**
** Maybe we have to enlarge s:
**/
if (len > slen) {
null_free((void *)&s);
if((char *)NULL == (s = stringer( NULL, len, NULL))) {
ErrorLogger( ERR_STRING, LOC, NULL);
goto unwind2;
}
slen = len;
/* dummy condition to use 'slen': */
if (slen == 0) {
;
}
}
/**
** Print the new module/version in the buffer:
**/
if ((char *)NULL == stringer(s, len, mod1, "/", ver1, NULL)) {
ErrorLogger(ERR_STRING, LOC, NULL);
goto unwind2;
}
mod = s;
if (ver = strchr(s, (int)'/')) {
*ver++ = '\0';
}
}
/**
** recursively delve into subdirectories (until ver == NULL).
**/
if (ver) {
int len;
len = (int)(strlen(mod) + 1);
if (prefix) {
len += (strlen(prefix) + 1);
}
/**
** Build the new prefix
**/
if((char *) NULL == (t = stringer(NULL, len, NULL))) {
ErrorLogger( ERR_STRING, LOC, NULL);
goto unwind2;
}
if( prefix) {
if((char *) NULL == stringer(t, len, prefix,"/",mod, NULL)){
ErrorLogger( ERR_STRING, LOC, NULL);
goto unwindt;
}
} else {
if((char *) NULL == stringer(t, len, mod, NULL)){
ErrorLogger( ERR_STRING, LOC, NULL);
goto unwindt;
}
}
/**
** This is the recursion
**/
Result = GetModuleName( interp, path, t, ver);
/**
** Free our temporary prefix buffer
**/
null_free((void *) &t);
if (0) { /* an error occurred */
unwindt:
null_free((void *) &t);
goto unwind2;
}
}
} else { /** if ($path/$prefix/$mod is a directory) **/
/**
** Now 'mod' should be either a file or the word 'default'
** In case of default get the file with the highest version number
** in the current directory
**/
if( is_def) {
if( !prefix)
prefix = ".";
if( NULL == (filelist = SortedDirList( interp, path, prefix,
&numlist)))
goto unwind1;
prefix = (char *)NULL;
/**
** Select the first one on the list which is either a
** modulefile or another directory. We start at the highest
** lexicographical name in the directory since the filelist
** is reverse sorted.
** If it is a directory, then we delve into it.
**/
for( i=0; i<numlist && Result==NULL; i++) {
/**
** Build the full path name and check if it is a
** directory. If it is, recursively try to find there what
** we are/were seeking for
**/
if ((char *)NULL == stringer(fullpath, MOD_BUFSIZE,
path, "/", filelist[i], NULL))
goto unwind2;
if( !stat( fullpath, &stats) && S_ISDIR( stats.st_mode)) {
Result = GetModuleName( interp, path, prefix,
filelist[ i]);
} else {
/**
** Otherwise check the file for a magic cookie ...
**/
if( check_magic( fullpath, MODULES_MAGIC_COOKIE,
MODULES_MAGIC_COOKIE_LENGTH))
Result = filelist[ i];
} /** end "if (!stat)" **/
} /** end for-loop **/
} else { /** default **/
/**
** If mod names a file, we have to check wheter it exists and
** is a valid module file
**/
if( check_magic( fullpath, MODULES_MAGIC_COOKIE,
MODULES_MAGIC_COOKIE_LENGTH))
Result = mod;
else {
ErrorLogger( ERR_MAGIC, LOC, fullpath, NULL);
Result = NULL;
}
} /** if( mod is a filename) **/
/**
** Build the full filename (using prefix and Result) if
** Result is defined
**/
if (Result) {
int len;
len = (int)(strlen(Result) + 1);
if (prefix) {
len += (strlen(prefix) + 1);
}
if((char *) NULL == (t = stringer(NULL, len, NULL))) {
ErrorLogger( ERR_STRING, LOC, NULL);
goto unwind2;
}
if( prefix) {
if((char *) NULL == stringer(t,len, prefix,"/",Result,NULL))
goto unwindt2;
} else {
if((char *) NULL == stringer(t,len, Result,NULL))
goto unwindt2;
}
Result = t;
if (0) { /* an error occurred */
unwindt2:
null_free((void *) &t);
goto unwind2;
}
}
} /** mod is a file **/
} /** mod exists **/
/**
** Free up temporary values and return what we've found
**/
null_free((void*) &fullpath);
null_free((void*) &s);
FreeList(filelist, numlist);
#if WITH_DEBUGGING_LOCATE_1
ErrorLogger(NO_ERR_END, LOC, _proc_GetModuleName, NULL);
#endif /* WITH_DEBUGGING_LOCATE_1 */
return (Result); /** -------- EXIT (SUCCESS) -------> **/
unwind2:
null_free((void *)&fullpath);
unwind1:
null_free((void *)&s);
unwind0:
return(NULL); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'GetModuleName' (that was a lengthy function...) **/
int Locate_ModuleFile( Tcl_Interp *interp,
char *modulename,
char *realname,
char *filename)
{
char *p; /** Tokenization pointer **/
char *result = NULL; /** This functions result **/
char **pathlist; /** List of paths to scan **/
int numpaths, /** Size of this list **/
i; /** Loop counter **/
char *modulespath; /** Buffer for the contents of the **/
/** environment variable MODULEPATH **/
char *mod, *vers; /** Module and version name for sym- **/
/** bolic name lookup **/
/**
** If it is a full path name, that's the module file to load.
**/
#if WITH_DEBUGGING_LOCATE
ErrorLogger( NO_ERR_START, LOC, _proc_Locate_ModuleFile, "modulename = '",
modulename, "'", NULL);
#endif
if( !modulename)
if( OK != ErrorLogger( ERR_PARAM, LOC, "modulename", NULL))
goto unwind0;
if( modulename[0] == '/' || modulename[0] == '.') {
p = (char*) strrchr( modulename, '/');
if(p) {
*p = '\0';
/**
** Check, if what has been specified is a valid version of
** the specified module ...
**/
if((char *) NULL ==
(result = GetModuleName(interp, modulename, NULL,(p+1))))
goto unwind0;
/**
** Reinstall the 'modulefile' which has been corrupted by
** tokenization
**/
*p = '/';
/**
** Reinstall the 'modulefile' which has been corrupted by
** tokenization
**/
*p = '/';
/**
** ... Looks good! Conditionally (if there has been no version
** specified) we have to add the default version
**/
if( !strcmp((p + 1), result)) {
if ((char *) NULL == stringer( filename, MOD_BUFSIZE,
modulename, NULL))
goto unwind1;
} else {
if ((char *) NULL == stringer( filename, MOD_BUFSIZE,
modulename,"/",result, NULL))
goto unwind1;
}
} else {
/**
** Hmm! There's no backslash in 'modulename'. So it MUST begin
** on '.' and MUST be part of the current directory
**/
if( NULL == (result = GetModuleName( interp, modulename, NULL,
modulename)))
goto unwind0;
if( !strcmp( modulename, result) ||
(strlen( modulename) + 1 + strlen( result) + 1 > MOD_BUFSIZE)) {
if ((char *) NULL == stringer( filename, MOD_BUFSIZE,
modulename, NULL))
goto unwind1;
} else {
if ((char *) NULL == stringer( filename, MOD_BUFSIZE,
modulename,"/",result, NULL))
goto unwind1;
}
}
/**
** So it is not a full path name what has been specified. Scan the
** MODULESPATH
**/
} else {
/**
** If I don't find a path in MODULEPATH, there's nothing to search.
**/
if( !( modulespath = (char *) getenv( "MODULEPATH"))) {
if( OK != ErrorLogger( ERR_MODULE_PATH, LOC, NULL)) {
g_current_module = NULL;
goto unwind0;
}
}
/**
** strip off any extraneous new lines
**/
{ char *end;
if ((char *) NULL != (end = strrchr(modulespath, '\n'))) *end = '\0';
}
/**
** Expand the module name (in case it is a symbolic one). This must
** be done once here in order to expand any aliases
**/
if( VersionLookup( modulename, &mod, &vers)) {
if ((char *) NULL == stringer( buf, MOD_BUFSIZE,
mod,"/",vers, NULL))
goto unwind0;
modulename = buf;
}
/**
** Split up the MODULEPATH values into multiple directories
**/
if( NULL == (pathlist = SplitIntoList(interp, modulespath, &numpaths,
_colon)))
goto unwind0;
/**
** Check each directory to see if it contains the module
**/
for(i=0; i<numpaths; i++) {
/* skip empty paths */
if(*pathlist[i] && (NULL != (result =
GetModuleName( interp, pathlist[i], NULL, modulename)))) {
if( strlen( pathlist[i]) + 2 + strlen( result) > MOD_BUFSIZE) {
if ((char *) NULL == stringer( filename, MOD_BUFSIZE,
pathlist[i], NULL))
goto unwind1;
} else {
if ((char *) NULL == stringer( filename, MOD_BUFSIZE,
pathlist[i],"/",result, NULL))
goto unwind1;
}
break;
}
/**
** If we havn't found it, we should try to re-expand the module
** name, because some rc file have been sourced
**/
if( VersionLookup( modulename, &mod, &vers)) {
if ((char *) NULL == stringer( buf, MOD_BUFSIZE,
mod,"/",vers, NULL))
goto unwind1;
modulename = buf;
}
} /** for **/
/**
** Free the memory created from the call to SplitIntoList()
**/
FreeList( pathlist, numpaths);
/**
** If result still NULL, then we really never found it and we should
** return ERROR and clear the full_path array for cleanliness.
**/
if( !result) {
filename[0] = '\0';
goto unwind0;
}
} /** not a full path name **/
/**
** Free up what has been allocated and pass the result back to
** the caller and save the real module file name returned by
** GetModuleName
**/
strncpy( realname, result, MOD_BUFSIZE);
if ((char *) NULL == stringer( realname, MOD_BUFSIZE, result, NULL))
goto unwind1;
null_free((void *) &result);
#if WITH_DEBUGGING_LOCATE
ErrorLogger( NO_ERR_END, LOC, _proc_Locate_ModuleFile, NULL);
#endif
return( TCL_OK);
unwind1:
null_free((void *) &result);
unwind0:
return( TCL_ERROR);
}
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 Initialize_Tcl( Tcl_Interp **interp,
int argc,
char *argv[],
char *environ[])
{
int Result = TCL_ERROR;
char * tmp;
#if WITH_DEBUGGING_INIT
ErrorLogger( NO_ERR_START, LOC, _proc_Initialize_Tcl, NULL);
#endif
/**
** Check the command syntax. Since this is already done
** Less than 3 parameters isn't valid. Invocation should be
** 'modulecmd <shell> <command>'
**/
if(argc < 2)
if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], " shellname", NULL))
goto unwind0;
/**
** Check the first parameter to modulcmd for a known shell type
** and set the shell properties
**/
if( !set_shell_properties( argv[1]))
if( OK != ErrorLogger( ERR_SHELL, LOC, argv[1], NULL))
goto unwind0;
/**
** Create a Tcl interpreter in order to proceed the command. Initialize
** this interpreter and set up pointers to all Tcl Module commands
** (InitializeModuleCommands)
**/
#ifdef __CYGWIN__
/* ABr, 12/10/01: from Cygwin stuff */
Tcl_FindExecutable( argv[0] ) ;
#endif
*interp = EM_CreateInterp();
if( TCL_OK != (Result = InitializeModuleCommands( *interp)))
goto unwind0;
/**
** Now set up the hash-tables for shell environment modifications.
** For a description of these tables have a look at main.c, where
** they're defined. The tables have to be allocated and thereafter
** initialized. Exit from the whole program in case allocation fails.
**/
if( ( ! ( setenvHashTable =
(Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
( ! ( unsetenvHashTable =
(Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
( ! ( aliasSetHashTable =
(Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
( ! ( aliasUnsetHashTable =
(Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
( ! ( markVariableHashTable =
(Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
( ! ( markAliasHashTable =
(Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ) {
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
goto unwind0;
}
Tcl_InitHashTable( setenvHashTable, TCL_STRING_KEYS);
Tcl_InitHashTable( unsetenvHashTable, TCL_STRING_KEYS);
Tcl_InitHashTable( aliasSetHashTable, TCL_STRING_KEYS);
Tcl_InitHashTable( aliasUnsetHashTable, TCL_STRING_KEYS);
Tcl_InitHashTable( markVariableHashTable, TCL_STRING_KEYS);
Tcl_InitHashTable( markAliasHashTable, TCL_STRING_KEYS);
#ifdef BEGINENV
# if BEGINENV == 99
/**
** Check for the existence of the environment variable
** "MODULESBEGINENV". This signals that for this
** configuration that the user wants to record the initial
** environment as seen for the first time by the module
** command into the filename given in the MODULESBEGINENV
** environment variable (which can have one level of
** variable expansion). Whether it's the first time or not
** is moderated by the existence of environment variable
** _MODULESBEGINENV_ or not.
**
** The update command will use this information to reinitialize the
** environment and then reload every modulefile that has been loaded
** since as stored in the LOADEDMODULES environment variable in order.
**/
if( (tmp = xgetenv( "MODULESBEGINENV")) ) {
/* MODULESBEGINENV is set ... use it */
if( !getenv( "_MODULESBEGINENV_") ) {
FILE* file;
if( (file = fopen(tmp, "w+")) ) {
int i=0;
while( environ[i]) {
fprintf( file, "%s\n", environ[i++]);
}
moduleSetenv( *interp, "_MODULESBEGINENV_", tmp, 1);
fclose( file);
} else
if( OK != ErrorLogger( ERR_OPEN, LOC,
TCL_RESULT(*interp), "append", NULL))
goto unwind0;
null_free((void *) &tmp);
}
}
# else
/**
** Check for the existence of the
** environment variable "_MODULESBEGINENV_". If it is set, then
** do nothing, otherwise, Store every environment variable into
** ~/.modulesbeginenv. This will be used to store the environment
** variables exactly as it was when Modules saw it for the very first
** time.
**
** The update command will use this information to reinitialize the
** environment and then reload every modulefile that has been loaded
** since as stored in the LOADEDMODULES environment variable in order.
**/
if( !getenv( "_MODULESBEGINENV_") ) {
/* use .modulesbeginenv */
FILE* file;
char savefile[] = "/.modulesbeginenv";
char *buffer;
tmp = getenv("HOME");
if((char *) NULL == (tmp = getenv("HOME")))
if( OK != ErrorLogger( ERR_HOME, LOC, NULL))
goto unwind0;
if((char *) NULL == (buffer = stringer(NULL,0,tmp,savefile,NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind0;
if( file = fopen(buffer, "w+")) {
int i=0;
while( environ[i]) {
fprintf( file, "%s\n", environ[i++]);
}
moduleSetenv( *interp, "_MODULESBEGINENV_", buffer, 1);
fclose( file);
} else
if( OK != ErrorLogger( ERR_OPEN, LOC,
TCL_RESULT(*interp), "append", NULL))
goto unwind0;
null_free((void *) &buffer);
}
# endif
#endif
/**
** Exit to the main program
**/
return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
unwind0:
return( Result); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'Initialize_Tcl' **/
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 ModuleCmd_Apropos( Tcl_Interp *interp,
int argc,
char *argv[])
{
struct stat stats;
char *dirname;
char *modpath; /** Buffer for the contents of the **/
/** environment variable MODULEPATH **/
int i, done = 0;
char *c;
char *cache_file; /** Name of the cache file **/
FILE *cachefp = (FILE *) NULL; /** Cache file pointer **/
#if WITH_DEBUGGING_MODULECMD
ErrorLogger( NO_ERR_START, LOC, _proc_ModuleCmd_Apropos, NULL);
#endif
/**
** Ignore case ... convert all arguments to lower case
**/
if( sw_icase)
for( i=0; i<argc; i++)
for( c=argv[ i]; c && *c; c++)
*c = tolower( *c);
/**
** If there's no MODULEPATH defined, we cannot output anything
**/
if((char *) NULL == (modpath = xgetenv( "MODULEPATH")))
if( OK != ErrorLogger( ERR_MODULE_PATH, LOC, NULL))
goto unwind0;
/**
** Check whether there's a cache file. If it is, grep for the tokens
** in this file. Otherwise read all module files ...
**/
cache_file = apropos_cache();
if( !sw_create && cache_file && !stat( cache_file, &stats)) {
/**
** Open the cache file
**/
if((FILE *) NULL == (cachefp = fopen( cache_file, "r"))) {
if( OK != ErrorLogger( ERR_OPEN, LOC, cache_file, NULL))
goto unwind1;
} else {
/**
** Read the cache and close the file
**/
read_cache( argc, argv, cachefp, WHATIS_SOME);
if( EOF == fclose( cachefp))
if( OK != ErrorLogger( ERR_CLOSE, LOC, cache_file, NULL))
goto unwind1;
done = 1;
}
}
/**
** If we're not done now, we have to scan the files
**/
if( !done) {
/**
** Open the cache file if neccessary
**/
if( sw_create && cache_file)
if((FILE *) NULL == (cachefp = fopen( cache_file, "w")))
if( OK != ErrorLogger( ERR_OPEN, LOC, cache_file, NULL))
goto unwind1;
/**
** Tokenize the module path string and check all dirs
**/
for( dirname = xstrtok( modpath, ":");
dirname;
dirname = xstrtok( NULL, ":") ) {
if( !check_dir( dirname))
continue;
whatis_dir( dirname, argc, argv, cachefp, WHATIS_SOME);
} /** for **/
/**
** Close the cache file
**/
if( cachefp)
if( EOF == fclose( cachefp))
if( OK != ErrorLogger( ERR_CLOSE, LOC, cache_file, NULL))
goto unwind1;
}
/**
** Free up what has been allocated and exit from this procedure
**/
null_free((void *) &modpath);
#if WITH_DEBUGGING_MODULECMD
ErrorLogger( NO_ERR_END, LOC, _proc_ModuleCmd_Apropos, NULL);
#endif
return( TCL_OK);
unwind1:
null_free((void *) &modpath);
unwind0:
return( TCL_ERROR); /** ---- EXIT (FAILURE) ---> **/
} /** End of 'ModuleCmd_Apropos' **/
static int Remove_Path(Tcl_Interp *interp, char *variable, char *item,
char *sw_marker, const char *delim)
{
char *oldpath, /** current path **/
*olditem; /** item from path **/
int i = 0, /** counter **/
found = 0, /** flag to indicate item was found **/
pcount = 0, /** count of items in path **/
addsep = 0, /** flag to add separator **/
marked = 0, /** flag path contains sw_marker **/
oldpathlen = 0;
Tcl_DString _newpath;
Tcl_DString *newpath = &_newpath;
Tcl_DStringInit(newpath);
/**
** Get the current value of the "PATH" environment variable
**/
oldpath = (char *)EMGetEnv(interp, variable);
if (!oldpath || !*oldpath) {
null_free((void *)&oldpath);
_TCLCHK(interp);
goto success0; /** -------- EXIT (SUCCESS) -------> **/
}
/* copy oldpath to not mess with the TCL value of env(PATH) */
if (!(oldpath = stringer(NULL,0, oldpath, NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind0;
}
}
/* get length of oldpath before it gets modified by xstrtok */
oldpathlen = (int)strlen(oldpath);
/* determine if sw_marker is in the path */
olditem = xstrtok(oldpath, delim);
while (olditem) {
if (!strcmp(olditem, sw_marker)) {
marked = 1;
}
pcount++;
olditem = xstrtok(NULL, delim);
}
/** pointer arithmetic on oldpath
** if olditem starts at terminating null string of oldpath,
** it means the last character in oldpath was ":", meaning
** the last element was the empty string. use <= to catch
** this case and process the last empty element
*/
for (olditem = oldpath; olditem <= oldpath + oldpathlen;
olditem += strlen(olditem) + 1) {
if (strcmp(olditem, item)) {
/* not the droids we're looking for */
if (Tcl_DStringLength(newpath)) {
if (!Tcl_DStringAppend(newpath, delim, 1))
if (OK !=
ErrorLogger(ERR_STRING, LOC, NULL))
goto unwind1;
}
if (!Tcl_DStringAppend(newpath, olditem, -1))
if (OK != ErrorLogger(ERR_STRING, LOC, NULL))
goto unwind1;
} else {
/* bingo! Don't add it to new path */
found++;
if ((g_flags & M_SWSTATE1) && !marked) {
/**
** In state1, we're actually replacing old paths with
** the markers for future appends and prepends.
**
** We only want to do this once to mark the location
** the module was formed around.
**/
marked = 1;
if (Tcl_DStringLength(newpath)) {
if (!Tcl_DStringAppend
(newpath, delim, 1))
if (OK !=
ErrorLogger(ERR_STRING, LOC,
NULL))
goto unwind1;
}
if (!Tcl_DStringAppend(newpath, sw_marker, -1))
if (OK !=
ErrorLogger(ERR_STRING, LOC, NULL))
goto unwind1;
}
}
}
if (!found) {
goto success1;
}
if (Tcl_DStringLength(newpath)) {
/**
** Cache the set. Clear the variable from the unset table just
** in case it was previously unset.
**/
store_hash_value(setenvHashTable, variable,
Tcl_DStringValue(newpath));
clear_hash_value(unsetenvHashTable, variable);
/**
** Store the new PATH value into the environment.
**/
(void) EMSetEnv( interp, variable, Tcl_DStringValue(newpath));
_TCLCHK(interp);
} else {
/**
** In this case, I should go ahead and unset the variable
** from the environment because I'm removing the very last
** path.
**
** First I'm going to clear the variable from the
** setenvHashTable just in case its already been altered
** and had a significant value at the time. It's very
** possible that I'm removing the only two or three paths
** from this variable. If that's the case, then all the
** earlier paths were marked for output in this hashTable.
**
** Secondly, I actually mark the the environment variable
** to be unset when output.
**/
clear_hash_value(setenvHashTable, variable);
moduleUnsetenv(interp, variable);
/**
** moduleUnsetenv doesn't unset the variable in the Tcl
** space because the $env variable might need to be
** used again in the modulefile for locating other
** paths. BUT, since this was a path-type environment
** variable, the user is expecting this to be empty
** after removing the only remaining path. So, I set
** the variable empty here.
**/
(void) EMSetEnv( interp, variable, "");
_TCLCHK(interp);
}
/**
** Free what has been used and return on success
**/
success1:
null_free((void *)&oldpath);
success0:
Tcl_DStringFree(newpath);
return (TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
unwind1:
null_free((void *)&oldpath);
unwind0:
Tcl_DStringFree(newpath);
return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'Remove_Path' **/
int cmdSetPath(ClientData client_data, Tcl_Interp *interp, int argc,
CONST84 char *argv[])
{
Tcl_RegExp chkexpPtr; /** Regular expression for
* marker checking **/
char *oldpath, /** Old value of 'var' **/
*newpath, /** New value of 'var' **/
*sw_marker = APP_SW_MARKER, /** arbitrary default **/
*startp = NULL, *endp = NULL, /** regexp match endpts **/
*qualifiedpath, /** List of dirs which
* are NOT already in path **/
**pathlist; /** List of dirs **/
const char *delim = _colon; /** path delimiter **/
int append = 1, /** append or prepend **/
numpaths, /** number of dirs in path **/
qpathlen, /** qualifiedpath length **/
arg1 = 1, /** arg start **/
x; /** loop index **/
Tcl_Obj *np_obj; /** new path Tcl Obj **/
#if WITH_DEBUGGING_CALLBACK
ErrorLogger(NO_ERR_START, LOC, _proc_cmdSetPath, NULL);
#endif /* WITH_DEBUGGING_CALLBACK */
/**
** Whatis mode?
**/
if (g_flags & (M_WHATIS | M_HELP)) {
goto success0;
}
/**
** Check arguments. There should be at least 3 args:
** argv[0] - prepend/append
** ...
** argv[n-1]- varname
** argv[n] - value
**/
if(argc < 3) {
if (OK != ErrorLogger(ERR_USAGE, LOC, argv[0],
" path-variable directory", NULL)) {
goto unwind0;
}
}
/**
** Should this guy be removed from the variable(?)... If yes, then do so!
**/
if (g_flags & M_REMOVE) {
return (cmdRemovePath(client_data, interp, argc, argv)); /** ----> **/
}
/**
** prepend or append. The default is append.
**/
if (!(append = !!strncmp(argv[0], "pre", 3))) {
sw_marker = PRE_SW_MARKER;
}
/**
** Non-persist mode?
**/
if (g_flags & M_NONPERSIST) {
return (TCL_OK);
}
/**
** Display only ... ok, let us do so!
**/
if (g_flags & M_DISPLAY) {
fprintf(stderr, "%s\t ", argv[0]);
while (--argc) {
fprintf( stderr, "%s ", *++argv);
}
fprintf(stderr, "\n");
goto success0;
}
/**
** Check for the delimiter option
**/
if (*(argv[arg1]) == '-') {
if (!strcmp(argv[arg1], "-d")) {
delim = argv[(arg1 + 1)];
arg1 += 2;
} else if (!strcmp(argv[arg1], "--delim")) {
delim = argv[(arg1 + 1)];
arg1 += 2;
} else if (!strncmp(argv[arg1], "--delim=", 8)) {
delim = (argv[arg1] + 8);
arg1++;
}
}
/**
** Get the old value of the variable. MANPATH defaults to a configure
** generated value.
** Put a \ in front of each '.' and '+'.
** (this is an intentional memory leak)
**/
oldpath = EMGetEnv(interp, argv[arg1]);
_TCLCHK(interp)
if(!oldpath || !*oldpath) {
null_free((void *) &oldpath);
oldpath = ((!strcmp(argv[arg1], "MANPATH"))
? stringer(NULL, 0, DEFAULTMANPATH, NULL)
: stringer(NULL, 0, "", NULL));
}
/**
** Split the new path into its components directories so each
** directory can be checked to see whether it is already in the
** existing path.
**/
if (!(pathlist = SplitIntoList(interp, (char *)argv[(arg1 + 1)],
&numpaths, delim))) {
goto unwind0;
}
/**
** Some space for the list of paths which
** are not already in the existing path.
**/
if((char *) NULL == (qualifiedpath = stringer(NULL, 0, argv[(arg1 + 1)],
delim, NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind1;
}
}
qpathlen = (int)(strlen(qualifiedpath) + 1);
*qualifiedpath = '\0'; /** make sure null for later **/
for ((x = 0); (x < numpaths); x++) {
regex_quote(pathlist[x], buffer, PATH_BUFLEN);
/**
** Check to see if path is already in this path variable.
** It could be at the
** beginning ... ^path:
** middle ... :path:
** end ... :path$
** only one ... ^path$
**/
if ((char *)NULL == (newpath = stringer(NULL, 0, "(^", buffer, delim,
")|(", delim, buffer, delim,
")|(", delim, buffer, "$)|(^",
buffer, "$)", NULL))) {
if (OK != ErrorLogger( ERR_STRING, LOC, NULL)) {
goto unwind2;
}
}
np_obj = Tcl_NewStringObj(newpath, (int)strlen(newpath));
chkexpPtr = Tcl_GetRegExpFromObj(interp, np_obj, TCL_REG_ADVANCED);
_TCLCHK(interp)
null_free((void *)&newpath);
/**
** If the directory is not already in the path,
** add it to the qualified path.
**/
if (!Tcl_RegExpExec(interp, chkexpPtr, oldpath, oldpath)) {
if (!stringer((qualifiedpath + strlen(qualifiedpath)),
(int)((unsigned long)qpathlen - strlen(qualifiedpath)),
pathlist[x], delim, NULL)) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind2;
}
}
}
} /** End of loop that checks for
** already existent path
**/
/**
** If all of the directories in the new path already exist,
** exit doing nothing.
**/
if (! *qualifiedpath) {
goto success1;
}
/* remove trailing delimiter */
qualifiedpath[(strlen(qualifiedpath) - 1)] = '\0';
/**
** Some space for our newly created path.
** We size at the oldpath plus the addition.
**/
if (!(newpath = stringer(NULL, (int)(strlen(oldpath) + strlen(qualifiedpath) + 2), NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind2;
}
}
*newpath = '\0';
/**
** Easy job to do, if the old path has not been set up so far ...
**/
if (!strcmp(oldpath, "")) {
strcpy(newpath, qualifiedpath);
/**
** Otherwise we have to take care on prepending vs. appending ...
** If there is a append or prepend marker within the variable (see
** modules_def.h) the changes are made according to this markers. Other-
** wise append and prepend will be relative to the strings begin or end.
**/
} else {
Tcl_Obj *sw_obj = Tcl_NewStringObj(sw_marker, (int)strlen(sw_marker));
Tcl_RegExp markexpPtr = Tcl_GetRegExpFromObj(interp,
sw_obj,
TCL_REG_ADVANCED);
_TCLCHK(interp)
strcpy(newpath, oldpath);
if (Tcl_RegExpExec(interp, markexpPtr, oldpath, oldpath)) {
_TCLCHK(interp)
Tcl_RegExpRange(markexpPtr, 0,
(CONST84 char **)&startp, (CONST84 char **)&endp);
/**
** Append/Prepend marker found
**/
if (append) {
char ch = *startp;
*startp = '\0';
strcpy(newpath, oldpath);
/**
** check that newpath has a value before adding delim
**/
if ((strlen(newpath) > 0) &&
(newpath[(strlen(newpath) - 1)] != *delim)) {
strcat(newpath, delim);
}
strcat(newpath, qualifiedpath);
if (newpath[strlen(newpath)-1] != *delim) {
strcat(newpath, delim);
}
*startp = ch;
strcat(newpath, startp);
} else {
char ch = *endp;
*endp = '\0';
strcpy(newpath, oldpath);
if (newpath[strlen(newpath)-1] != *delim) {
strcat(newpath, delim);
}
strcat(newpath, qualifiedpath);
*endp = ch;
strcat(newpath, endp);
}
} else {
/**
** No marker set
**/
if (append) {
strcpy(newpath, oldpath);
if (newpath[strlen(newpath)-1] != *delim) {
strcat(newpath, delim);
}
strcat(newpath, qualifiedpath);
} else {
strcpy(newpath, qualifiedpath);
if (*oldpath != *delim) {
strcat(newpath, delim);
}
strcat(newpath, oldpath);
} /* end "if (append)" */
} /** end "if (marker)" **/
} /** end "if (strcmp)" **/
/**
** Now the new value to be set resides in 'newpath'. Set it up.
**/
moduleSetenv(interp, (char *)argv[arg1], newpath, 1);
_TCLCHK(interp)
#if WITH_DEBUGGING_CALLBACK
ErrorLogger(NO_ERR_END, LOC, _proc_cmdSetPath, NULL);
#endif /* WITH_DEBUGGING_CALLBACK */
/**
** Free resources
**/
null_free((void *)&newpath);
success1:
null_free((void *)&oldpath);
null_free((void *)&qualifiedpath);
FreeList(pathlist, numpaths);
success0:
return (TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
unwind2:
null_free((void *)&qualifiedpath);
unwind1:
FreeList(pathlist, numpaths);
unwind0:
null_free((void *)&oldpath);
return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'cmdSetPath' **/
int ModuleCmd_Switch( Tcl_Interp *interp,
int argc,
char *argv[])
{
char *oldmodule,
*newmodule,
*realname,
*oldfile,
*newfile,
*oldname,
*newname,
*oldmodule_buffer = (char *) NULL;
int ret_val = TCL_OK;
/**
** allocate buffer memory
**/
if (!(oldfile = stringer(NULL, MOD_BUFSIZE, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind0;
if (!(newfile = stringer(NULL, MOD_BUFSIZE, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind1;
if (!(oldname = stringer(NULL, MOD_BUFSIZE, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind2;
if (!(newname = stringer(NULL, MOD_BUFSIZE, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind3;
/**
** Parameter check. the required syntax is:
** module switch [ <old> ] <new>
** If <old> is not specified, then the pathname of <new> is assumed.
**/
if( argc == 1) {
newmodule = argv[0];
if(!(oldmodule_buffer = stringer(NULL,0,newmodule,NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind4;
/* starting from the end of the module name, find the first
* forward slash and replace with null
*/
if ((oldmodule = strrchr(oldmodule_buffer, *psep))) {
*oldmodule = 0;
}
oldmodule = oldmodule_buffer;
} else if( argc == 2) {
oldmodule = argv[0];
newmodule = argv[1];
} else {
if( OK != ErrorLogger( ERR_USAGE, LOC, "switch oldmodule newmodule",
NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
}
/**
** Set the name of the module specified on the command line
**/
g_specified_module = oldmodule;
/**
** First try to find a match for the modulefile out of the LOADEDMODULES.
**/
if( !IsLoaded( interp, oldmodule, &realname, oldfile))
if( OK != ErrorLogger( ERR_NOTLOADED, LOC, oldmodule, NULL))
goto unwind4;
/**
** If we have another name to try, try finding it on disk.
**/
if( realname)
ret_val = Locate_ModuleFile( interp, realname, oldname, oldfile);
/**
** If we've made it this far without finding a file, then look using the
** exact name the user gave me -- i.e. the old method.
**/
if( ret_val == TCL_ERROR) {
if( TCL_ERROR == (ret_val = Locate_ModuleFile( interp, oldmodule,
oldname, oldfile)))
if( OK != ErrorLogger( ERR_LOCATE, LOC, oldmodule, NULL))
goto unwind4;
/**
** OK, this one is known. Is it loaded, too?
**/
if( !IsLoaded( interp, oldname, NULL, oldfile))
if( OK != ErrorLogger( ERR_NOTLOADED, LOC, oldmodule, NULL))
goto unwind4;
}
/**
** Set the name of the module specified on the command line
**/
g_specified_module = newmodule;
/**
** Now try to find the new file to swap with.
**/
if( TCL_ERROR == (ret_val = Locate_ModuleFile( interp, newmodule, newname,
newfile)))
if( OK != ErrorLogger( ERR_LOCATE, LOC, newmodule, NULL))
goto unwind4;
ErrorLogger( NO_ERR_VERBOSE, LOC, "Switching '$1' to '$2'", oldmodule,
newmodule, NULL);
/**
** We'll remove the current modulefile with the SWITCH1 state set.
** This means that instead of really removing the paths, markers will
** be put in its place for later use.
**/
g_flags |= (M_REMOVE | M_SWSTATE1);
g_specified_module = oldmodule;
g_current_module = oldname;
if( Read_Modulefile( interp, oldfile) == 0)
Update_LoadedList( interp, oldname, oldfile);
else {
ErrorLogger( NO_ERR_VERBOSE, LOC, "failed", NULL);
goto unwind4;
}
g_flags &= ~(M_REMOVE | M_SWSTATE1);
/**
** Move on to state SWITCH2. This loads the modulefile at the append
** and prepend markers.
**/
g_flags |= M_SWSTATE2;
g_specified_module = newmodule;
g_current_module = newname;
if( Read_Modulefile( interp, newfile) == 0)
Update_LoadedList( interp, newname, newfile);
else {
ErrorLogger( NO_ERR_VERBOSE, LOC, "failed", NULL);
goto unwind4;
}
g_flags &= ~M_SWSTATE2;
/**
** This actually unsets environment variables and gets rid of the
** markers.
**/
g_flags |= (M_REMOVE | M_SWSTATE3);
g_specified_module = oldmodule;
g_current_module = oldname;
if( Read_Modulefile( interp, oldfile) == 0)
Update_LoadedList( interp, newname, newfile);
else {
ErrorLogger( NO_ERR_VERBOSE, LOC, "failed", NULL);
goto unwind4;
}
/**
** Return on success
**/
ErrorLogger( NO_ERR_VERBOSE, LOC, "done", NULL);
/**
** free space
** assume don't need what's pointed to by g_current_module
** and g_specified_module
**/
null_free((void *) &newname);
null_free((void *) &oldname);
null_free((void *) &newfile);
null_free((void *) &oldfile);
return( TCL_OK); /** ------- EXIT (SUCCESS) --------> **/
unwind4:
if (oldmodule == oldmodule_buffer)
null_free((void *) &oldmodule);
null_free((void *) &newname);
unwind3:
null_free((void *) &oldname);
unwind2:
null_free((void *) &newfile);
unwind1:
null_free((void *) &oldfile);
unwind0:
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
} /** End of 'ModuleCmd_Switch' **/
/* uvec_dealloc - deallocate the unitialized uvec */
int uvec_dealloc(uvec **uv) {
int retval = 0;
null_free ((void **) uv);
/* *uv = (uvec *) NULL; */
return retval;
}
int ModuleCmd_Whatis( Tcl_Interp *interp,
int argc,
char *argv[])
{
struct stat stats;
Tcl_Interp *whatis_interp;
Tcl_DString cmdbuf;
int i, result = TCL_OK, done = 0;
char modulefile[ MOD_BUFSIZE],
modulename[ MOD_BUFSIZE],
*modpath = (char *)NULL,/** Buffer for the contents of the **/
/** environment variable MODULEPATH **/
**wptr,
*dirname = (char *)NULL,
*cache_file = (char *) NULL; /** Name of the cache file **/
FILE *cachefp = (FILE *) NULL; /** Cache file pointer **/
#if WITH_DEBUGGING_MODULECMD
ErrorLogger( NO_ERR_START, LOC, _proc_ModuleCmd_Whatis, NULL);
#endif
/**
** Initialize the command buffer and set up the modules flag to
** 'whatisonly'
**/
Tcl_DStringInit( &cmdbuf);
g_flags |= M_WHATIS;
/**
** Handle each passed module file. Create a Tcl interpreter for each
** module file to be handled and initialize it with custom module commands
**/
if ( argc) {
/**
** User provided a list of modules for ``whatis'' info
**/
for(i=0; i<argc && argv[i]; i++) {
whatis_interp = EM_CreateInterp();
if( TCL_OK != (result = InitializeModuleCommands( whatis_interp))) {
EM_DeleteInterp( whatis_interp);
result = TCL_ERROR;
break;
}
/**
** locate the filename related to the passed module
**/
if( TCL_ERROR ==
Locate_ModuleFile(whatis_interp,argv[i],modulename,modulefile)){
EM_DeleteInterp( whatis_interp);
if( OK != ErrorLogger( ERR_LOCATE, LOC, argv[i], NULL))
break;
else
continue;
}
/**
** Print out everything that would happen if the module file were
** executed ...
**/
g_current_module = modulename;
cmdModuleWhatisInit();
result = CallModuleProcedure( whatis_interp, &cmdbuf, modulefile,
"ModulesWhatis", 0);
/**
** Print the result ...
**/
if( whatis) {
wptr = whatis;
while( *wptr)
fprintf( stderr, "%-21s: %s\n", argv[i], *wptr++);
}
/**
** Remove the Tcl interpreter that has been used for printing ...
**/
EM_DeleteInterp( whatis_interp);
cmdModuleWhatisShut();
} /** for **/
} else {
/**
** User wants all module ``whatis'' info
**/
/**
** If no MODULEPATH defined, we can not output anything
**/
if( !(modpath = (char *) xgetenv( "MODULEPATH")))
if( OK != ErrorLogger( ERR_MODULE_PATH, LOC, NULL))
goto unwind0;
/**
** Check whether a cache file exists then list all the ``whatis'' info
** Otherwise read all module files ...
**/
cache_file = apropos_cache();
if( !sw_create && cache_file && !stat( cache_file, &stats)) {
/**
** Open the cache file
**/
if((FILE *) NULL == (cachefp = fopen( cache_file, "r"))) {
if( OK != ErrorLogger( ERR_OPEN, LOC, cache_file, NULL))
goto unwind1;
} else {
/**
** Read the cache and close the file
**/
result = read_cache( argc, argv, cachefp, WHATIS_ALL);
if( EOF == fclose( cachefp))
if( OK != ErrorLogger( ERR_CLOSE, LOC, cache_file, NULL))
goto unwind1;
done = 1;
}
}
/**
** If we're not done now, we have to scan the files
**/
if( !done) {
/**
** Open the cache file if neccessary
**/
if( sw_create && cache_file)
if((FILE *) NULL == (cachefp = fopen( cache_file, "w")))
if( OK != ErrorLogger( ERR_OPEN, LOC, cache_file, NULL))
goto unwind1;
/**
** Tokenize the module path string and check all dirs
**/
for( dirname = xstrtok( modpath, ":");
dirname;
dirname = xstrtok( NULL, ":") ) {
if( !check_dir( dirname))
continue;
whatis_dir( dirname, argc, argv, cachefp, WHATIS_ALL);
} /** for **/
/**
** Close the cache file
**/
if( cachefp)
if( EOF == fclose( cachefp))
if( OK != ErrorLogger( ERR_CLOSE, LOC, cache_file, NULL))
goto unwind1;
}
}
/**
** Leave the 'whatis only mode', free up what has been used and return
**/
g_flags &= ~M_WHATIS;
fprintf( stderr, "\n");
Tcl_DStringFree( &cmdbuf);
/**
** Free up allocated resources
**/
null_free((void *) &cache_file);
null_free((void *) &modpath);
/**
** Return on success
**/
#if WITH_DEBUGGING_MODULECMD
ErrorLogger( NO_ERR_END, LOC, _proc_ModuleCmd_Whatis, NULL);
#endif
return( result); /** --- EXIT PROCEDURE (result) --> **/
unwind1:
null_free((void *) &cache_file);
null_free((void *) &modpath);
unwind0:
return( TCL_ERROR); /** --- EXIT PROCEDURE (FAILURE) --> **/
} /** End of 'ModuleCmd_Whatis' **/
static int stdc_free (char **str) {
/* fprintf(stderr, "stdc free\n"); */
null_free((void **) str);
return 0;
}
/* since when does 'main()' take three arguments? */
int main(int argc, char *argv[], char *environ[]) {
Tcl_Interp *interp;
int return_val = 0;
char *rc_name;
char *rc_path;
#if WITH_DEBUGGING
ErrorLogger(NO_ERR_START, LOC, _proc_main, NULL);
#endif /* WITH_DEBUGGING */
/**
** check if first argument is --version or -V then output the
** version to stdout. This is a special circumstance handled
** by the regular options.
**/
if ((argc > 1) && (*argv[1] == '-')) {
if ((!strcmp("-V", argv[1])) || (!strcmp("--version", argv[1]))) {
version(stdout);
return 0;
}
}
/**
** Initialization.
** Check the command line syntax. There will be no return from the
** initialization function in case of invalid command line arguments.
**/
if (TCL_OK != Initialize_Tcl(&interp, argc, argv, environ)) {
goto unwind0;
}
if (TCL_OK != Setup_Environment(interp)) {
goto unwind0;
}
/**
** Check for command line switches
**/
if (TCL_OK != Check_Switches(&argc, argv)) {
goto unwind0;
}
/**
** Figure out, which global RC file to use. This depends on the environ-
** ment variable 'MODULERCFILE', which can be set to one of the following:
**
** <filename> --> PREFIX/etc/<filename>
** <dir>/ --> <dir>/RC_FILE
** <dir>/<file> --> <dir>/<file>
** Use xgetenv to expand 1 level of env.vars.
**/
if ((rc_name = xgetenv("MODULERCFILE"))) {
/* found something in MODULERCFILE */
if ((char *)NULL == (rc_path = stringer(NULL, 0, rc_name, NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) {
goto unwind1;
} else {
null_free((void *)&rc_name);
}
} else {
null_free((void *)&rc_name);
if ((char *)NULL == (rc_name = strrchr(rc_path, '/'))) {
rc_name = rc_path;
rc_path = instpath;
} else {
*rc_name++ = '\0';
}
if (!*rc_name) {
rc_name = rc_file;
}
}
} else {
rc_path = instpath;
null_free((void *)&rc_name);
rc_name = rc_file;
}
/**
** Finally we have to change PREFIX -> PREFIX/etc
**/
if (rc_path == instpath) {
if ((char *)NULL == (rc_path = stringer(NULL, 0, instpath,
"/etc", NULL))) {
if (OK != ErrorLogger(ERR_ALLOC, LOC, NULL)) {
goto unwind1;
} else {
rc_path = NULL;
}
}
}
/**
** Source the global and the user defined RC file
**/
g_current_module = (char *)NULL;
if ((TCL_ERROR == SourceRC(interp, rc_path, rc_name)) ||
(TCL_ERROR == SourceRC(interp, getenv("HOME"), modulerc_file))) {
exit(1);
}
if (rc_path) {
null_free((void *)&rc_path);
}
/**
** Invocation of the module command as specified in the command line
**/
g_flags = 0;
return_val = cmdModule((ClientData)0, interp, (argc - 1),
(CONST84 char **)(argv + 1));
/**
** If we were doing some operation that has already flushed its output,
** then we do NOT need to re-flush the output here.
**
** Also, if we have had an error here, then the whole modulecmd failed
** and not just the values for a single modulefile. So, we shall pass in
** a NULL here to indicate that any error message should say that
** absolutely NO changes were made to the environment.
**/
if (TCL_OK == return_val) {
Output_Modulefile_Changes(interp);
#ifdef HAS_X11LIBS
xresourceFinish(1);
#endif /* HAS_X11LIBS */
} else {
Unwind_Modulefile_Changes(interp, NULL);
#ifdef HAS_X11LIBS
xresourceFinish(0);
#endif /* HAS_X11LIBS */
}
/**
** Finally clean up. Delete the required hash tables and conditionally
** allocated areas.
**/
Delete_Global_Hash_Tables();
if (line) {
null_free((void *)&line);
}
if (error_line) {
null_free((void *)&error_line);
}
/**
** This return value may be evaluated by the calling shell:
**/
#if WITH_DEBUGGING
ErrorLogger(NO_ERR_END, LOC, _proc_main, NULL);
#endif /* WITH_DEBUGGING */
OutputExit();
return (return_val ? return_val : g_retval);
unwind2:
null_free((void *)&rc_path);
unwind1:
null_free((void *)&rc_name);
unwind0:
/* an error occurred of some type */
g_retval = (g_retval ? g_retval : 1);
OutputExit();
return (g_retval);
} /** End of 'main' **/
int moduleSetenv( Tcl_Interp *interp,
char *variable,
char *value,
int force)
{
char *oldval; /** Old value of 'variable' **/
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_START, LOC, _proc_moduleSetenv, NULL);
#endif
oldval = EMGetEnv( interp, variable);
if (!oldval || !*oldval)
null_free((void *)&oldval);
/**
** Check to see if variable is already set correctly...
**/
if( !(g_flags & (M_REMOVE|M_DISPLAY|M_SWITCH|M_NONPERSIST)) && oldval) {
if( !strcmp( value, oldval)) {
return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
}
}
/**
** If I'm in SWSTATE1, I'm removing stuff from the old modulefile, so
** I'll just mark the variables that were used with the SWSTATE1 flag and
** return.
**
** When I come back through in SWSTATE2, I'm setting the variables that
** are in the new modulefile. So, I'll keep track of these by marking
** them as touched by SWSTATE2 and then actually setting their values in
** the environment down below.
**
** Finally, in SWSTATE3, I'll check to see if the variables in the old
** modulefiles that have been marked are still marked as SWSTATE1. If
** they are still the same, then I'll just unset them and return.
**
** And, if I'm not doing any switching, then just unset the variable if
** I'm in remove mode.
**/
if( g_flags & M_SWSTATE1) {
set_marked_entry( markVariableHashTable, variable, M_SWSTATE1);
return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
} else if( g_flags & M_SWSTATE2) {
set_marked_entry( markVariableHashTable, variable, M_SWSTATE2);
} else if( g_flags & M_SWSTATE3) {
intptr_t marked_val;
marked_val = chk_marked_entry( markVariableHashTable, variable);
if( marked_val) {
if( marked_val == M_SWSTATE1)
return( moduleUnsetenv(interp, variable)); /** -------> **/
else
return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
}
} else if( (g_flags & M_REMOVE) && !force) {
return( moduleUnsetenv( interp, variable)); /** -------> **/
}
/**
** Keep track of our changes just in case we have to bail out and restore
** the environment.
**/
if( !(g_flags & (M_NONPERSIST | M_DISPLAY | M_WHATIS | M_HELP))) {
store_hash_value( setenvHashTable, variable, value);
clear_hash_value( unsetenvHashTable, variable);
}
/**
** Store the value into the environment
**/
EMSetEnv( interp, variable, value);
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_END, LOC, _proc_moduleSetenv, NULL);
#endif
return( TCL_OK);
} /** End of 'moduleSetenv' **/
static int checkConflict(
Tcl_Interp * interp,
char *path,
char **modulelist,
unsigned int nummodules
) {
uvec *new_modulelist;
int new_nummodules, k;
is_Result fstate;
char *buffer;
memset(error_module, '\0', MOD_BUFSIZE);
/**
** Check all modules passed to me as parameter
** At first clarify if they really do exist ...
**/
for (k = 0; k < nummodules; k++) {
if (!(buffer = stringer(NULL,0,path,psep,modulelist[k],NULL)))
if (OK != ErrorLogger(ERR_STRING, LOC, NULL))
goto unwind0;
if (!(fstate = is_("what", buffer))) {
if (OK != ErrorLogger(ERR_FILEINDIR, LOC,
modulelist[k], path, NULL))
if (!stringer(error_module, MOD_BUFSIZE,
modulelist[k], NULL))
if (OK !=
ErrorLogger(ERR_STRING, LOC, NULL))
goto unwind1;
goto unwind1;
}
/**
** Is it a directory what has been passed? If it is, list the
** according directory and call myself recursively in order to
**/
if (fstate == IS_DIR) {
if (!(new_modulelist = SortedDirList(path,
modulelist[k], &new_nummodules)))
continue;
if (TCL_ERROR == checkConflict(interp, path,
uvec_vector(new_modulelist), new_nummodules)) {
FreeList(&new_modulelist);
goto unwind1;
}
FreeList(&new_modulelist);
/**
** If it isn't a directory, check the current one for to be the
** required module file
**/
} else {
if (IsLoaded_ExactMatch (interp,modulelist[k],NULL,NULL)
&& strcmp(g_current_module, modulelist[k])) {
/**
** Save the name of the offending module in a buffer
** for reporting purposes when we get back to the top.
**/
if (!stringer(error_module, MOD_BUFSIZE,
modulelist[k], NULL))
if (OK !=
ErrorLogger(ERR_STRING, LOC, NULL))
goto unwind1;
goto unwind1;
}
} /** if( directory) **/
} /** for **/
/**
** free resources
**/
null_free((void *)&buffer);
return (TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
unwind1:
null_free((void *)&buffer);
unwind0:
return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'checkConflict' **/
int main(
int argc,
char *argv[],
char *environ[]
) {
Tcl_Interp *interp;
int return_val = 0;
char *rc_name;
char *rc_path;
Tcl_Obj **objv; /** Tcl Object vector **/
int objc; /** Tcl Object vector count **/
#ifdef HAVE_SETLOCALE
/* set local via LC_ALL */
setlocale(LC_ALL, "");
#endif
#if ENABLE_NLS
/* the text message domain. */
bindtextdomain(PACKAGE, LOCALEDIR);
textdomain(PACKAGE);
#endif
/**
** check if first argument is --version or -V then output the
** version to stdout. This is a special circumstance handled
** by the regular options.
**/
if (argc > 1 && *argv[1] == '-') {
if (!strcmp("-V", argv[1]) || !strcmp("--version", argv[1])) {
version(stdout);
return 0;
}
}
/**
** Initialization.
**/
if (!(ModulePathVec = ModulePathList())) {
ModulePath = NULL;
/* goto unwind0; */
} else {
ModulePath = uvec_vector(ModulePathVec);
}
/**
** Check the command line syntax. There will be no return from the
** initialization function in case of invalid command line arguments.
**/
if (TCL_OK != Initialize_Module(&interp, argc, argv, environ))
goto unwind1;
if (TCL_OK != Setup_Environment(interp))
goto unwind1;
/**
** Check for command line switches
**/
if (TCL_OK != Check_Switches(&argc, argv))
goto unwind1;
/**
** Figure out, which global RC file to use. This depends on the environ-
** ment variable 'MODULERCFILE', which can be set to one of the following:
**
** <filename> --> SYSCONFDIR/<filename>
** <dir>/ --> <dir>/RC_FILE
** <dir>/<file> --> <dir>/<file>
** Use xgetenv to expand 1 level of env.vars.
**/
if ((rc_name = xgetenv("MODULERCFILE"))) {
/* found something in MODULERCFILE */
if (!(rc_path = stringer(NULL, 0, rc_name, NULL))) {
if (OK != ErrorLogger(ERR_STRING, LOC, NULL))
goto unwind2;
else
null_free((void *)&rc_name);
} else {
null_free((void *)&rc_name);
if (!(rc_name = strrchr(rc_path, *psep))) {
rc_name = rc_path;
rc_path = etcpath;
} else
*rc_name++ = '\0';
if (!*rc_name) {
rc_name = rc_file;
}
}
} else {
rc_path = stringer(NULL,0, etcpath, NULL);
null_free((void *)&rc_name);
rc_name = rc_file;
}
/**
** Source the global and the user defined RC file
**/
g_current_module = (char *)NULL;
if (TCL_ERROR == SourceRC(interp, rc_path, rc_name, Mod_Load) ||
TCL_ERROR == SourceRC(interp,getenv("HOME"),modulerc_file,Mod_Load))
exit(1);
if (rc_path)
null_free((void *)&rc_path);
/**
** Invocation of the module command as specified in the command line
**/
g_flags = 0;
Tcl_ArgvToObjv(&objc, &objv, argc - 1, argv + 1);
return_val = cmdModule((ClientData) 0, interp, objc, objv);
/**
** If we were doing some operation that has already flushed its output,
** then we don't need to re-flush the output here.
**
** Also, if we've had an error here, then the whole modulecmd failed
** and not just the values for a single modulefile. So, we'll pass in
** a NULL here to indicate that any error message should say that
** absolutely NO changes were made to the environment.
**/
if (TCL_OK == return_val) {
Output_Modulefile_Changes(interp);
#ifdef HAS_X11LIBS
xresourceFinish(1);
#endif
} else {
Unwind_Modulefile_Changes(interp, NULL);
#ifdef HAS_X11LIBS
xresourceFinish(0);
#endif
}
/**
** Finally clean up. Delete the required hash tables and conditionally
** allocated areas.
**/
Global_Hash_Tables(GHashDelete, NULL);
if (line)
null_free((void *)&line);
if (error_line)
null_free((void *)&error_line);
/**
** This return value may be evaluated by the calling shell
**/
OutputExit();
return (return_val ? return_val : g_retval);
/* unwind3:
null_free((void *) &rc_path); */
unwind2:
null_free((void *)&rc_name);
unwind1:
FreeList(&ModulePathVec);
unwind0:
/* and error occurred of some type */
g_retval = (g_retval ? g_retval : 1);
OutputExit();
return (g_retval);
} /** End of 'main' **/