envmodules/modules
1
0
Fork 0
mirror of https://github.com/envmodules/modules.git synced 2026-06-14 00:42:43 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity
Files
fc26ce4bc439fbd04347c08094dca9fdfcbac975
modules/utility.c
rkowen f2586debea [ 730293 ] remove-path won't remove paths with a $ in it. 
Made the change and the tests ran fine.  I'm not sure what cleanse_path()
is supposed to do.
2006-02-04 17:04:48 +00:00

2896 lines
86 KiB
C
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
/*****
** ** Module Header ******************************************************* **
** **
** Modules Revision 3.0 **
** Providing a flexible user environment **
** **
** File: utility.c **
** First Edition: 1991/10/23 **
** **
** Authors: John Furlan, jlf@behere.com **
** Jens Hamisch, jens@Strawberry.COM **
** **
** Description: General routines that are called throughout Modules **
** which are not necessarily specific to any single **
** block of functionality. **
** **
** Exports: store_hash_value **
** clear_hash_value **
** Delete_Global_Hash_Tables **
** Delete_Hash_Tables **
** Copy_Hash_Tables **
** Unwind_Modulefile_Changes **
** Output_Modulefile_Changes **
** IsLoaded_ExactMatch **
** IsLoaded **
** chk_marked_entry **
** set_marked_entry **
** Update_LoadedList **
** check_magic **
** cleanse_path **
** chk4spch **
** xdup **
** xgetenv **
** stringer **
** null_free **
** countTclHash **
** **
** strdup if not defined by the system libs. **
** strtok if not defined by the system libs. **
** **
** Notes: **
** **
** ************************************************************************ **
****/
/** ** Copyright *********************************************************** **
** **
** Copyright 1991-1994 by John L. Furlan. **
** see LICENSE.GPL, which must be provided, for details **
** **
** ************************************************************************ **/
static char Id[] = "@(#)$Id: utility.c,v 1.22 2006/02/04 17:04:48 rkowen Exp $";
static void *UseId[] = { &UseId, Id };
/** ************************************************************************ **/
/** HEADERS **/
/** ************************************************************************ **/
#include "modules_def.h"
/** ************************************************************************ **/
/** LOCAL DATATYPES **/
/** ************************************************************************ **/
/** not applicable **/
/** ************************************************************************ **/
/** CONSTANTS **/
/** ************************************************************************ **/
/** not applicable **/
/** ************************************************************************ **/
/** MACROS **/
/** ************************************************************************ **/
/** not applicable **/
/** ************************************************************************ **/
/** LOCAL DATA **/
/** ************************************************************************ **/
static char module_name[] = "utility.c"; /** File name of this module **/
#if WITH_DEBUGGING_UTIL_2
static char _proc_store_hash_value[] = "store_hash_value";
static char _proc_clear_hash_value[] = "clear_hash_value";
static char _proc_Clear_Global_Hash_Tables[] = "Clear_Global_Hash_Tables";
static char _proc_Delete_Global_Hash_Tables[] = "Delete_Global_Hash_Tables";
static char _proc_Delete_Hash_Tables[] = "Delete_Hash_Tables";
static char _proc_Copy_Hash_Tables[] = "Copy_Hash_Tables";
static char _proc_Unwind_Modulefile_Changes[] = "Unwind_Modulefile_Changes";
static char _proc_Output_Modulefile_Changes[] = "Output_Modulefile_Changes";
static char _proc_Output_Modulefile_Aliases[] = "Output_Modulefile_Aliases";
static char _proc_output_set_variable[] = "output_set_variable";
static char _proc_output_unset_variable[] = "output_unset_variable";
static char _proc_output_function[] = "output_function";
static char _proc_output_set_alias[] = "output_set_alias";
static char _proc_output_unset_alias[] = "output_unset_alias";
static char _proc_getLMFILES[] = "getLMFILES";
static char _proc___IsLoaded[] = "__IsLoaded";
static char _proc_chk_marked_entry[] = "chk_marked_entry";
static char _proc_set_marked_entry[] = "set_marked_entry";
static char _proc_get_module_basename[] = "get_module_basename";
static char _proc_Update_LoadedList[] = "Update_LoadedList";
static char _proc_check_magic[] = "check_magic";
static char _proc_cleanse_path[] = "cleanse_path";
static char _proc_chop[] = "chop";
#endif
static FILE *aliasfile; /** Temporary file to write aliases **/
static char *aliasfilename; /** Temporary file name **/
static char alias_separator = ';'; /** Alias command separator **/
static const int eval_alias = /** EVAL_ALIAS macro **/
#ifdef EVAL_ALIAS
1
#else
0
#endif
;
static const int bourne_funcs = /** HAS_BOURNE_FUNCS macro **/
#ifdef HAS_BOURNE_FUNCS
1
#else
0
#endif
;
static const int bourne_alias = /** HAS_BOURNE_FUNCS macro **/
#ifdef HAS_BOURNE_ALIAS
1
#else
0
#endif
;
/** ************************************************************************ **/
/** PROTOTYPES **/
/** ************************************************************************ **/
static void Clear_Global_Hash_Tables( void);
static int Output_Modulefile_Aliases( Tcl_Interp *interp);
static int output_set_variable( Tcl_Interp *interp, const char*,
const char*);
static int output_unset_variable( const char* var);
static void output_function( const char*, const char*);
static int output_set_alias( const char*, const char*);
static int output_unset_alias( const char*, const char*);
static int __IsLoaded( Tcl_Interp*, char*, char**, char*, int);
static char *get_module_basename( char*);
static char *chop( const char*);
static void EscapeCshString(const char* in,
char* out);
static void EscapeShString(const char* in,
char* out);
static void EscapePerlString(const char* in,
char* out);
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: store_hash_value **
** **
** Description: Keeps the old value of the variable around if it is **
** touched in the modulefile to enable undoing a **
** modulefile by resetting the evironment to it started.**
** **
** This is the same for unset_shell_variable() **
** **
** First Edition: 1992/10/14 **
** **
** Parameters: Tcl_HashTable *htable Hash table to be used**
** const char *key Attached key **
** const char *value Alias value **
** **
** Result: int TCL_OK Successfull completion **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
int store_hash_value( Tcl_HashTable* htable,
const char* key,
const char* value)
{
int new; /** Return from Tcl_CreateHashEntry **/
/** which indicates creation or ref- **/
/** ference to an existing entry **/
char *tmp; /** Temp pointer used for disalloc. **/
Tcl_HashEntry *hentry; /** Hash entry reference **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_store_hash_value, NULL);
#endif
/**
** Create a hash entry for the key to be stored. If there exists one
** so far, its value has to be unlinked.
** All values in this hash are pointers to allocated memory areas.
**/
hentry = Tcl_CreateHashEntry( htable, (char*) key, &new);
if( !new) {
tmp = (char *) Tcl_GetHashValue( hentry);
if( tmp)
null_free((void *) &tmp);
}
/**
** Set up the new value. strdup allocates!
**/
if( value)
Tcl_SetHashValue( hentry, (char*) strdup((char*) value));
else
Tcl_SetHashValue( hentry, (char*) NULL);
return( TCL_OK);
} /** End of 'store_hash_value' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: clear_hash_value **
** **
** Description: Remove the specified shell variable from the passed **
** hash table **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_HashTable *htable Hash table to be used**
** const char *key Attached key **
** **
** Result: int TCL_OK Successfull completion **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
int clear_hash_value( Tcl_HashTable *htable,
const char *key)
{
char *tmp; /** Temp pointer used for dealloc. **/
Tcl_HashEntry *hentry; /** Hash entry reference **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_clear_hash_value, NULL);
#endif
/**
** If I haven't already created an entry for keeping this environment
** variable's value, then just leave.
** Otherwise, remove this entry from the hash table.
**/
if( hentry = Tcl_FindHashEntry( htable, (char*) key) ) {
tmp = (char*) Tcl_GetHashValue( hentry);
if( tmp)
null_free((void *) &tmp);
Tcl_DeleteHashEntry( hentry);
}
return( TCL_OK);
} /** End of 'clear_hash_value' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: Clear_Global_Hash_Tables **
** **
** Description: Deletes and reinitializes our env. hash tables. **
** **
** First Edition: 1992/10/14 **
** **
** Parameters: - **
** Result: - **
** **
** Attached Globals: setenvHashTable, **
** unsetenvHashTable, **
** aliasSetHashTable, **
** aliasUnsetHashTable **
** **
** ************************************************************************ **
++++*/
static void Clear_Global_Hash_Tables( void)
{
Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
char *val = NULL; /** Stored value (is a pointer!) **/
/**
** The following hash tables are to be initialized
**/
Tcl_HashTable *table[5],
**table_ptr = table;
table[0] = setenvHashTable;
table[1] = unsetenvHashTable;
table[2] = aliasSetHashTable;
table[3] = aliasUnsetHashTable;
table[4] = NULL;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Clear_Global_Hash_Tables, NULL);
#endif
/**
** Loop for all the hash tables named above. If there's no value stored
** in a hash table, skip to the next one.
**/
for( ; *table_ptr; table_ptr++) {
if( ( hashEntry = Tcl_FirstHashEntry( *table_ptr, &searchPtr)) == NULL)
continue;
/**
** Otherwise remove all values stored in the table
**/
do {
val = (char*) Tcl_GetHashValue( hashEntry);
if( val)
null_free((void *) &val);
} while( hashEntry = Tcl_NextHashEntry( &searchPtr));
/**
** Reinitialize the hash table by unlocking it from memory and
** thereafter initializing it again.
**/
Tcl_DeleteHashTable( *table_ptr);
Tcl_InitHashTable( *table_ptr, TCL_STRING_KEYS);
} /** for **/
} /** End of 'Clear_Global_Hash_Tables' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: Delete_Global_Hash_Tables **
** Delete_Hash_Tables **
** **
** Description: Deletes our environment hash tables. **
** **
** First Edition: 1992/10/14 **
** **
** Parameters: Tcl_HashTable **table_ptr NULL-Terminated list **
** of hash tables to be **
** deleted **
** Result: - **
** **
** Attached Globals: setenvHashTable, **
** unsetenvHashTable, **
** aliasSetHashTable, **
** aliasUnsetHashTable **
** **
** ************************************************************************ **
++++*/
void Delete_Global_Hash_Tables( void) {
/**
** The following hash tables are to be initialized
**/
Tcl_HashTable *table[5];
table[0] = setenvHashTable;
table[1] = unsetenvHashTable;
table[2] = aliasSetHashTable;
table[3] = aliasUnsetHashTable;
table[4] = NULL;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Delete_Global_Hash_Tables, NULL);
#endif
Delete_Hash_Tables( table);
} /** End of 'Delete_Global_Hash_Tables' **/
void Delete_Hash_Tables( Tcl_HashTable **table_ptr)
{
Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
char *val = NULL; /** Stored value (is a pointer!) **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Delete_Hash_Tables, NULL);
#endif
/**
** Loop for all the hash tables named above. Remove all values stored in
** the table and then free up the whole table
**/
for( ; *table_ptr; table_ptr++) {
if( ( hashEntry = Tcl_FirstHashEntry( *table_ptr, &searchPtr))) {
/**
** Remove all values stored in the table
**/
do {
val = (char*) Tcl_GetHashValue( hashEntry);
if( val)
null_free((void *) &val);
} while( hashEntry = Tcl_NextHashEntry( &searchPtr));
/**
** Remove internal hash control structures
**/
Tcl_DeleteHashTable( *table_ptr);
}
null_free((void *) table_ptr);
} /** for **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_END, LOC, _proc_Delete_Hash_Tables, NULL);
#endif
} /** End of 'Delete_Hash_Tables' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: Copy_Hash_Tables **
** **
** Description: Allocate new hash tables for the global environment, **
** initialize them and copy the contents of the current **
** tables into them. **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: - **
** Result: Tcl_HashTable** Pointer to the new list of **
** hash tables **
** Attached Globals: setenvHashTable, **
** unsetenvHashTable, **
** aliasSetHashTable, **
** aliasUnsetHashTable **
** **
** ************************************************************************ **
++++*/
Tcl_HashTable **Copy_Hash_Tables( void)
{
Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
Tcl_HashEntry *oldHashEntry, /** Hash entries to be copied **/
*newHashEntry;
char *val = NULL, /** Stored value (is a pointer!) **/
*key = NULL; /** Hash key **/
int new; /** Tcl inidicator, if the new hash **/
/** entry has been created or ref. **/
Tcl_HashTable *oldTable[5],
**o_ptr, **n_ptr,
**newTable; /** Destination hash table **/
oldTable[0] = setenvHashTable;
oldTable[1] = unsetenvHashTable;
oldTable[2] = aliasSetHashTable;
oldTable[3] = aliasUnsetHashTable;
oldTable[4] = NULL;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Copy_Hash_Tables, NULL);
#endif
/**
** Allocate storage for the new list of hash tables
**/
if( !(newTable = (Tcl_HashTable**) malloc( sizeof( oldTable))))
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
goto unwind0;
/**
** Now copy each hashtable out of the list
**/
for( o_ptr = oldTable, n_ptr = newTable; *o_ptr; o_ptr++, n_ptr++) {
/**
** Allocate memory for a single hash table
**/
if( !(*n_ptr = (Tcl_HashTable*) malloc( sizeof( Tcl_HashTable))))
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
goto unwind1;
/**
** Initialize that guy and copy it from the old table
**/
Tcl_InitHashTable( *n_ptr, TCL_STRING_KEYS);
if( oldHashEntry = Tcl_FirstHashEntry( *o_ptr, &searchPtr)) {
/**
** Copy all entries if there are any
**/
do {
key = (char*) Tcl_GetHashKey( *o_ptr, oldHashEntry);
val = (char*) Tcl_GetHashValue( oldHashEntry);
newHashEntry = Tcl_CreateHashEntry( *n_ptr, key, &new);
if(val)
Tcl_SetHashValue(newHashEntry, strdup(val));
else
Tcl_SetHashValue(newHashEntry, (char *) NULL);
} while( oldHashEntry = Tcl_NextHashEntry( &searchPtr));
} /** if **/
} /** for **/
/**
** Put a terminator at the end of the new table
**/
*n_ptr = NULL;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_END, LOC, _proc_Copy_Hash_Tables, NULL);
#endif
return( newTable);
unwind1:
null_free((void *) &newTable);
unwind0:
return( NULL); /** -------- EXIT (FAILURE) -------> **/
} /** End of 'Copy_Hash_Tables' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: **
** **
** Description: Once a the loading or unloading of a modulefile **
** fails, any changes it has made to the environment **
** must be undone and reset to its previous state. This **
** function is responsible for unwinding any changes a **
** modulefile has made. **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_Interp *interp According TCL interp.**
** Tcl_HashTable **oldTables Hash tables storing **
** the former environm. **
** Result: **
** Attached Globals: **
** **
** ************************************************************************ **
++++*/
int Unwind_Modulefile_Changes( Tcl_Interp *interp,
Tcl_HashTable **oldTables )
{
Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
char *val = NULL, /** Stored value (is a pointer!) **/
*key; /** Tcl hash key **/
int i; /** Loop counter **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Unwind_Modulefile_Changes, NULL);
#endif
if( oldTables) {
/**
** Use only entries 0 and 1 which do contain all changes to the
** shell varibles (setenv and unsetenv)
**/
/** ??? What about the aliases (table 2 and 3) ??? **/
for( i = 0; i < 2; i++) {
if( hashEntry = Tcl_FirstHashEntry( oldTables[i], &searchPtr)) {
do {
key = (char*) Tcl_GetHashKey( oldTables[i], hashEntry);
/**
** The hashEntry will contain the appropriate value for the
** specified 'key' because it will have been aquired depending
** upon whether the unset or set table was used.
**/
val = (char*) Tcl_GetHashValue( hashEntry);
if( val)
Tcl_SetVar2( interp, "env", key, val, TCL_GLOBAL_ONLY);
} while( hashEntry = Tcl_NextHashEntry( &searchPtr) );
} /** if **/
} /** for **/
/**
** Delete and reset the hash tables now that the current contents have been
** flushed.
**/
Delete_Global_Hash_Tables();
setenvHashTable = oldTables[0];
unsetenvHashTable = oldTables[1];
aliasSetHashTable = oldTables[2];
aliasUnsetHashTable = oldTables[3];
} else {
Clear_Global_Hash_Tables();
}
return( TCL_OK);
} /** End of 'Unwind_Modulefile_Changes' **/
static int keycmp(const void *a, const void *b) {
return strcmp(*(const char **) a, *(const char **) b);
}
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: Output_Modulefile_Changes **
** **
** Description: Is used to flush out the changes of the current **
** modulefile in a manner depending upon whether the **
** modulefile was successfull or unsuccessfull. **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_Interp *interp The attached Tcl in- **
** terpreter **
** **
** Result: int TCL_OK Successful operation **
** **
** Attached Globals: setenvHashTable, **
** unsetenvHashTable, **
** aliasSetHashTable, via Output_Modulefile_Aliases**
** aliasUnsetHashTable via Output_Modulefile_Aliases**
** **
** ************************************************************************ **
++++*/
int Output_Modulefile_Changes( Tcl_Interp *interp)
{
Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
char *val = NULL, /** Stored value (is a pointer!) **/
*key, /** Tcl hash key **/
**list; /** list of keys **/
int i,k; /** Loop counter **/
size_t hcnt; /** count of hash entries **/
/**
** The following hash tables do contain all changes to be made on
** shell variables
**/
Tcl_HashTable *table[2];
table[0] = setenvHashTable;
table[1] = unsetenvHashTable;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Output_Modulefile_Changes, NULL);
#endif
aliasfile = stdout;
/**
** Scan both tables that are of interest for shell variables
**/
for(i = 0; i < 2; i++) {
/* count hash */
hcnt = countTclHash(table[i]);
/* allocate array for keys */
if( !(list = (char **) malloc(hcnt * sizeof(char *)))) {
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
return(TCL_ERROR);/** ------- EXIT (FAILURE) ------> **/
}
/* collect keys */
k = 0;
if( hashEntry = Tcl_FirstHashEntry( table[i], &searchPtr))
do {
key = (char*) Tcl_GetHashKey( table[i], hashEntry);
list[k++] = strdup(key);
} while( hashEntry = Tcl_NextHashEntry( &searchPtr));
/* sort hash */
if (hcnt > 1)
qsort((void *) list, hcnt, sizeof(char *), keycmp);
/* output key/values */
for (k = 0; k < hcnt; ++k) {
key = list[k];
hashEntry = Tcl_FindHashEntry( table[i], key);
/**
** The table list indicator is used in order to differ
** between the setenv and unsetenv operation
**/
if( i == 1) {
output_unset_variable( (char*) key);
} else {
if(val=(char *) Tcl_GetVar2(interp,"env",
key,TCL_GLOBAL_ONLY))
output_set_variable(interp, (char*) key, val);
}
} /** for **/
/* delloc list */
for (k = 0; k < hcnt; ++k)
free(list[k]);
free(list);
} /** for **/
if( EOF == fflush( stdout))
if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stdout, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
Output_Modulefile_Aliases( interp);
/**
** Delete and reset the hash tables since the current contents have been
** flushed.
**/
Clear_Global_Hash_Tables();
return( TCL_OK);
} /* End of 'Output_Modulefile_Changes' */
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: Open_Aliasfile **
** **
** Description: Creates/opens or closes temporary file for sourcing **
** or aliases. **
** Passes back the filehandle and filename in global **
** variables. **
** **
** First Edition: 2005/09/26 R.K.Owen <rk@owen.sj.ca.us> **
** **
** Parameters: int action if != 0 to open else close **
** **
** Result: int TCL_OK Successful operation **
** **
** Attached Globals: aliasfile **
** aliasfilename **
** **
** ************************************************************************ **
++++*/
static int Open_Aliasfile(int action)
{
if (action) {
/**
** Open the file ...
**/
if( tmpfile_mod(&aliasfilename,&aliasfile))
if(OK != ErrorLogger( ERR_OPEN, LOC, aliasfilename,
_(em_appending), NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
} else {
if( EOF == fclose( aliasfile))
if( OK != ErrorLogger( ERR_CLOSE, LOC, aliasfile, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
return( TCL_OK);
} /** End of 'Open_Aliasfile' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: Output_Modulefile_Aliases **
** **
** Description: Is used to flush out the changes to the aliases of **
** the current modulefile. But, some shells don't work **
** well with having their alias information set via the **
** 'eval' command. So, what we'll do now is output the **
** aliases into a /tmp dotfile, have the shell source **
** the /tmp dotfile and then have the shell remove the **
** /tmp dotfile. **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_Interp *interp The attached Tcl in- **
** terpreter **
** **
** Result: int TCL_OK Successful operation **
** **
** Attached Globals: aliasSetHashTable, via Output_Modulefile_Aliases**
** aliasUnsetHashTable via Output_Modulefile_Aliases**
** **
** ************************************************************************ **
++++*/
static int Output_Modulefile_Aliases( Tcl_Interp *interp)
{
Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
char *val = NULL, /** Stored value (is a pointer!) **/
*key; /** Tcl hash key **/
int i, /** Loop counter **/
openfile = 0; /** whether using a file or not **/
char *sourceCommand; /** Command used to source the alias **/
/**
** The following hash tables do contain all changes to be made on
** shell aliases
**/
Tcl_HashTable *table[2];
table[0] = aliasSetHashTable;
table[1] = aliasUnsetHashTable;
/**
** If configured so, all changes to aliases are written into a temporary
** file which is sourced by the invoking shell ...
** In this case a temporary filename has to be assigned for the alias
** source file. The file has to be opened as 'aliasfile'.
** The default for aliasfile, if no shell sourcing is used, is stdout.
**/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Output_Modulefile_Aliases, NULL);
#endif
/**
** We only need to output stuff into a temporary file if we're setting
** stuff. We can unset variables and aliases by just using eval.
**/
if( hashEntry = Tcl_FirstHashEntry( aliasSetHashTable, &searchPtr)) {
/**
** We must use an aliasfile if EVAL_ALIAS is not defined
** or the sh shell does not do aliases (HAS_BOURNE_ALIAS)
** and that the sh shell does do functions (HAS_BOURNE_FUNCS)
**/
if (!eval_alias
|| (!strcmp(shell_name,"sh") && !bourne_alias && bourne_funcs)) {
if (OK != Open_Aliasfile(1))
if(OK != ErrorLogger(ERR_OPEN,LOC,aliasfilename,
_(em_appending),NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
openfile = 1;
}
/**
** We only support sh and csh variants for aliases. If not either
** sh or csh print warning message and return
**/
if( !strcmp( shell_derelict, "csh")) {
sourceCommand = "source %s%s";
} else if( !strcmp( shell_derelict, "sh")) {
sourceCommand = ". %s%s";
} else {
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
if (openfile) {
/**
** Only the source command has to be flushed to stdout. After
** sourcing the alias definition (temporary) file, the source
** file is to be removed.
**/
alias_separator = '\n';
fprintf( stdout, sourceCommand, aliasfilename, shell_cmd_separator);
fprintf( stdout, "/bin/rm -f %s%s",
aliasfilename, shell_cmd_separator);
} /** openfile **/
} /** if( alias to set) **/
/**
** Scan the hash tables involved in changing aliases
**/
for( i=0; i<2; i++) {
if( hashEntry = Tcl_FirstHashEntry( table[i], &searchPtr)) {
do {
key = (char*) Tcl_GetHashKey( table[i], hashEntry);
val = (char*) Tcl_GetHashValue( hashEntry);
/**
** The hashtable list index is used to differ between aliases
** to be set and aliases to be reset
**/
if(i == 1) {
output_unset_alias( key, val);
} else {
output_set_alias( key, val);
}
} while( hashEntry = Tcl_NextHashEntry( &searchPtr));
} /** if **/
} /** for **/
if(openfile) {
if( OK == Open_Aliasfile(0))
if( OK != ErrorLogger( ERR_CLOSE, LOC, aliasfile, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
null_free((void *) &aliasfilename);
}
return( TCL_OK);
} /** End of 'Output_Modulefile_Aliases' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: output_set_variable **
** **
** Description: Outputs the command required to set a shell variable **
** according to the current shell **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_Interp *interp The attached Tcl interpreter **
** const char *var Name of the variable to be **
** set **
** const char *val Value to be assigned **
** **
** Result: int TCL_OK Finished successfull **
** TCL_ERROR Unknown shell type **
** **
** Attached Globals: shell_derelict **
** **
** ************************************************************************ **
++++*/
static int output_set_variable( Tcl_Interp *interp,
const char *var,
const char *val)
{
/**
** Differ between the different kinds od shells at first
**
** CSH
**/
chop( val);
chop( var);
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_output_set_variable, " var='", var,
"' val= '", val, "'", NULL);
#endif
if( !strcmp((char*) shell_derelict, "csh")) {
#ifdef LMSPLIT_SIZE
/**
** Many C Shells (specifically the Sun one) has a hard limit on
** the size of the environment variables around 1k. The
** _LMFILES_ variable can grow beyond 1000 characters. So, I'm
** going to break it up here since I can put it back together
** again when I use it.
**
** You can set the split size using --with-split-size=<number>
** it should probably be <1000. I don't count the size of
** "setenv _LMFILES_xxx" so subtract this from your limit.
**/
if( !strcmp( var, "_LMFILES_")) {
char formatted[ MOD_BUFSIZE];
char *cptr;
int lmfiles_len;
int count = 0;
char* escaped = stringer(NULL,strlen(val)*2+1,NULL);
EscapeCshString(val,escaped);
if(( lmfiles_len = strlen(escaped)) > LMSPLIT_SIZE) {
char buffer[ LMSPLIT_SIZE + 1];
/**
** Break up the _LMFILES_ variable...
**/
while( lmfiles_len > LMSPLIT_SIZE) {
strncpy( buffer, ( escaped + count*LMSPLIT_SIZE ),
LMSPLIT_SIZE);
buffer[ LMSPLIT_SIZE] = '\0';
fprintf( stdout, "setenv %s%03d %s%s", var, count, buffer,
shell_cmd_separator);
lmfiles_len -= LMSPLIT_SIZE;
count++;
}
if( lmfiles_len) {
fprintf( stdout, "setenv %s%03d %s%s", var, count,
(escaped + count*LMSPLIT_SIZE), shell_cmd_separator);
count++;
}
/**
** Unset _LMFILES_ as indicator to use the multi-variable
** _LMFILES_
**/
fprintf(stdout, "unsetenv %s%s", var, shell_cmd_separator);
} else { /** if ( lmfiles_len = strlen(val)) > LMSPLIT_SIZE) **/
fprintf(stdout, "setenv %s %s%s", var, escaped, shell_cmd_separator);
}
/**
** Unset the extra _LMFILES_%03d variables that may be set
**/
do {
sprintf( formatted, "_LMFILES_%03d", count++);
cptr = (char *) Tcl_GetVar2( interp, "env", formatted, TCL_GLOBAL_ONLY);
if( cptr) {
fprintf(stdout, "unsetenv %s%s", formatted, shell_cmd_separator);
}
} while( cptr);
null_free((void *) &escaped);
} else { /** if( var == "_LMFILES_") **/
#endif /* not LMSPLIT_SIZE */
char* escaped = stringer(NULL,strlen(val)*2+1,NULL);
EscapeCshString(val,escaped);
fprintf(stdout, "setenv %s %s %s", var, escaped, shell_cmd_separator);
null_free((void *) &escaped);
#ifdef LMSPLIT_SIZE
}
#endif /* not LMSPLIT_SIZE */
/**
** SH
**/
} else if( !strcmp((char*) shell_derelict, "sh")) {
char* escaped = (char*)malloc(strlen(val)*2+1);
EscapeShString(val,escaped);
fprintf( stdout, "%s=%s %sexport %s%s", var, escaped, shell_cmd_separator,
var, shell_cmd_separator);
free(escaped);
/**
** EMACS
**/
} else if( !strcmp((char*) shell_derelict, "emacs")) {
fprintf( stdout, "(setenv \"%s\" \'%s\')\n", var, val);
/**
** PERL
**/
} else if( !strcmp((char*) shell_derelict, "perl")) {
char* escaped = stringer(NULL,strlen(val)*2+1,NULL);
EscapePerlString(val,escaped);
fprintf(stdout, "$ENV{'%s'} = '%s'%s", var, escaped,
shell_cmd_separator);
null_free((void *) &escaped);
/**
** PYTHON
**/
} else if( !strcmp((char*) shell_derelict, "python")) {
fprintf( stdout, "os.environ['%s'] = '%s'\n", var, val);
/**
** SCM
**/
} else if ( !strcmp((char*) shell_derelict, "scm")) {
fprintf( stdout, "(putenv \"%s=%s\")\n", var, val);
/**
** MEL (Maya Extension Language)
**/
} else if ( !strcmp((char*) shell_derelict, "mel")) {
fprintf( stdout, "putenv \"%s\" \"%s\";", var, val);
/**
** Unknown shell type - print an error message and
** return on error
**/
} else {
if( OK != ErrorLogger( ERR_DERELICT, LOC, shell_derelict, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
/**
** Return and acknowldge success
**/
return( TCL_ERROR);
} /** End of 'output_set_variable' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: output_unset_variable **
** **
** Description: Outputs the command required to unset a shell **
** variable according to the current shell **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: const char *var Name of the variable to be **
** unset **
** **
** Result: int TCL_OK Finished successfull **
** TCL_ERROR Unknown shell type **
** **
** Attached Globals: shell_derelict **
** **
** ************************************************************************ **
++++*/
static int output_unset_variable( const char* var)
{
chop( var);
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_output_unset_variable, NULL);
#endif
/**
** Display the 'unsetenv' command according to the current invoking shell.
**/
if( !strcmp( shell_derelict, "csh")) {
fprintf( stdout, "unsetenv %s%s", var, shell_cmd_separator);
} else if( !strcmp( shell_derelict, "sh")) {
fprintf( stdout, "unset %s%s", var, shell_cmd_separator);
} else if( !strcmp( shell_derelict, "emacs")) {
fprintf( stdout, "(setenv \"%s\" nil)\n", var);
} else if( !strcmp( shell_derelict, "perl")) {
fprintf( stdout, "delete $ENV{'%s'}%s", var, shell_cmd_separator);
} else if( !strcmp( shell_derelict, "python")) {
fprintf( stdout, "os.environ['%s'] = ''\ndel os.environ['%s']\n",var,var);
} else if( !strcmp( shell_derelict, "scm")) {
fprintf( stdout, "(putenv \"%s\")\n", var);
} else if( !strcmp( shell_derelict, "mel")) {
fprintf( stdout, "putenv \"%s\" \"\";", var);
} else {
if( OK != ErrorLogger( ERR_DERELICT, LOC, shell_derelict, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
/**
** Return and acknowldge success
**/
return( TCL_OK);
} /** End of 'output_unset_variable' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: output_function **
** **
** Description: Actually turns the Modules set-alias information **
** into a string that a shell can source. Previously, **
** this routine just output the alias information to be **
** eval'd by the shell. **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: const char *var Name of the alias to be set **
** const char *val Value to be assigned **
** **
** Result: - **
** **
** Attached Globals: aliasfile, The output file for alias commands. **
** see 'Output_Modulefile_Aliases' **
** alias_separator **
** **
** ************************************************************************ **
++++*/
static void output_function( const char *var,
const char *val)
{
const char *cptr = val;
int nobackslash = 1;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_output_function, NULL);
#endif
/**
** This opens a function ...
**/
fprintf( aliasfile, "%s() { ", var);
/**
** ... now print the value. Print it as a single line and remove any
** backslash
**/
while( *cptr) {
if( *cptr == '\\') {
if( !nobackslash)
putc( *cptr, aliasfile);
else
nobackslash = 0;
cptr++;
continue;
} else
nobackslash = 1;
putc(*cptr++, aliasfile);
} /** while **/
/**
** Finally close the function
**/
fprintf( aliasfile, "%c}%c", alias_separator,alias_separator);
} /** End of 'output_function' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: output_set_alias **
** **
** Description: Flush the commands required to set shell aliases de- **
** pending on the current invoking shell **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: const char *alias Name of the alias **
** const char *val Value to be assigned **
** **
** Result: int TCL_OK Operation successfull **
** **
** Attached Globals: aliasfile, The alias command is written out to **
** alias_separator Defined the command separator **
** shell_derelict to determine the shell family **
** shell_name to determine the real shell type **
** **
** ************************************************************************ **
++++*/
static int output_set_alias( const char *alias,
const char *val)
{
int nobackslash = 1; /** Controls whether backslashes are **/
/** to be print **/
const char *cptr = val; /** Scan the value char by char **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_output_set_alias, NULL);
#endif
/**
** Check for the shell family
** CSHs need to switch $* to \!* and $n to \!\!:n unless the $ has a
** backslash before it
**/
if( !strcmp( shell_derelict, "csh")) {
/**
** On CSHs the command is 'alias <name> <value>'. Print the beginning
** of the command and then print the value char by char.
**/
fprintf( aliasfile, "alias %s '", alias);
while( *cptr) {
/**
** Convert $n to \!\!:n
**/
if( *cptr == '$' && nobackslash) {
cptr++;
if( *cptr == '*')
fprintf( aliasfile, "\\!");
else
fprintf( aliasfile, "\\!\\!:");
}
/**
** Recognize backslashes
**/
if( *cptr == '\\') {
if( !nobackslash)
putc( *cptr, aliasfile);
else
nobackslash = 0;
cptr++;
continue;
} else
nobackslash = 1;
/**
** print the read character
**/
putc( *cptr++, aliasfile);
} /** while **/
/**
** Now close up the command using the alias command terminator as
** defined in the global variable
**/
fprintf( aliasfile, "'%c", alias_separator);
/**
** Bourne shell family: The alias has to be translated into a
** function using the function call 'output_function'
**/
} else if( !strcmp(shell_derelict, "sh")) {
/**
** Shells supporting extended bourne shell syntax ....
**/
if( (!strcmp( shell_name, "sh") && bourne_alias)
|| !strcmp( shell_name, "bash")
|| !strcmp( shell_name, "zsh" )
|| !strcmp( shell_name, "ksh")) {
/**
** in this case we only have to write a function if the alias
** takes arguments. This is the case if the value has '$'
** somewhere in it without a '\' in front.
**/
while( *cptr) {
if( *cptr == '\\') {
if( nobackslash) {
nobackslash = 0;
}
} else {
if( *cptr == '$') {
if( nobackslash) {
output_function( alias, val);
return TCL_OK;
}
}
nobackslash = 1;
}
cptr++;
}
/**
** So, we can just output an alias with '\$' translated to '$'...
**/
fprintf( aliasfile, "alias %s='", alias);
nobackslash = 1;
cptr = val;
while( *cptr) {
if( *cptr == '\\') {
if( nobackslash) {
nobackslash = 0;
cptr++;
continue;
}
}
nobackslash = 1;
putc(*cptr++, aliasfile);
} /** while **/
fprintf( aliasfile, "'%c", alias_separator);
} else if( !strcmp( shell_name, "sh")
&& bourne_funcs) {
/**
** The bourne shell itself
** need to write a function unless this sh doesn't support
** functions (then just punt)
**/
output_function(alias, val);
}
/** ??? Unknown derelict ??? **/
} /** if( sh ) **/
return( TCL_OK);
} /** End of 'output_set_alias' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: output_unset_alias **
** **
** Description: Flush the commands required to reset shell aliases **
** depending on the current invoking shell **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: const char *alias Name of the alias **
** const char *val Value which has been **
** assigned **
** **
** Result: int TCL_OK Operation successfull **
** **
** Attached Globals: aliasfile, The alias command is writte out to **
** alias_separator Defined the command separator **
** shell_derelict to determine the shell family **
** shell_name to determine the real shell type **
** **
** ************************************************************************ **
++++*/
static int output_unset_alias( const char *alias,
const char *val)
{
int nobackslash = 1; /** Controls wether backslashes are **/
/** to be print **/
const char *cptr = val; /** Need to read the value char by char **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_output_unset_alias, NULL);
#endif
/**
** Check for the shell family at first
** Ahh! CSHs ... ;-)
**/
if( !strcmp( shell_derelict, "csh")) {
fprintf( aliasfile, "unalias %s%c", alias, alias_separator);
/**
** Hmmm ... bourne shell types ;-(
** Need to unset a function in case of sh or if the alias took parameters
**/
} else if( !strcmp( shell_derelict, "sh")) {
if( !strcmp( shell_name, "sh")) {
if (bourne_alias) {
fprintf(aliasfile, "unalias %s%c", alias, alias_separator);
} else if (bourne_funcs) {
fprintf(aliasfile,"unset -f %s%c", alias, alias_separator);
} /* else do nothing */
/**
** BASH
**/
} else if( !strcmp( shell_name, "bash")) {
/**
** If we have what the old value should have been, then look to
** see if it was a function or an alias because bash spits out an
** error if you try to unalias a non-existent alias.
**/
if(val) {
/**
** Was it a function?
** Yes, if it has arguments...
**/
while( *cptr) {
if( *cptr == '\\') {
if( nobackslash) {
nobackslash = 0;
}
} else {
if(*cptr == '$') {
if( nobackslash) {
fprintf(aliasfile, "unset -f %s%c", alias,
alias_separator);
return TCL_OK;
}
}
nobackslash = 1;
}
cptr++;
}
/**
** Well, it wasn't a function, so we'll put out an unalias...
**/
fprintf( aliasfile, "unalias %s%c", alias, alias_separator);
} else { /** No value known (any more?) **/
/**
** We'll assume it was a function because the unalias command
** in bash produces an error. It's possible that the alias
** will not be cleared properly here because it was an
** unset-alias command.
**/
fprintf( aliasfile, "unset -f %s%c", alias, alias_separator);
}
/**
** ZSH or KSH
** Put out both because we it could be either a function or an
** alias. This will catch both.
**/
} else if( !strcmp( shell_name, "zsh")){
fprintf(aliasfile, "unalias %s%c", alias, alias_separator);
} else if( !strcmp( shell_name, "ksh")) {
fprintf(aliasfile, "unalias %s%c", alias, alias_separator);
fprintf(aliasfile, "unset -f %s%c", alias, alias_separator);
} /** if( bash, zsh, ksh) **/
/** ??? Unknown derelict ??? **/
} /** if( sh-family) **/
return( TCL_OK);
} /** End of 'output_unset_alias' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: getLMFILES **
** **
** Description: Read in the _LMFILES_ environment variable. This one **
** may be split into several variables cause by limited **
** variable space of some shells (esp. the SUN csh) **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_Interp *interp Attached Tcl interpreter **
** **
** Result: char* Value of the environment varibale _LMFILES_ **
** **
** Attached Globals: **
** **
** ************************************************************************ **
++++*/
char *getLMFILES( Tcl_Interp *interp)
{
static char *lmfiles = NULL; /** Buffer pointer for the value **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_getLMFILES, NULL);
#endif
/**
** Try to read the variable _LMFILES_. If the according buffer pointer
** contains a value, disallocate it before.
**/
if( lmfiles)
null_free((void *) &lmfiles);
lmfiles = (char *) Tcl_GetVar2( interp, "env","_LMFILES_",TCL_GLOBAL_ONLY);
/**
** Now the pointer is NULL in case of the variable has not been defined.
** In this case try to read in the splitted variable from _LMFILES_xxx
**/
if( !lmfiles) {
char buffer[ MOD_BUFSIZE]; /** Used to set up the split variab- **/
/** les name **/
int count = 0; /** Split part count **/
int lmsize = 0; /** Total size of _LMFILES_ content **/
int old_lmsize; /** Size save buffer **/
int cptr_len; /** Size of the current split part **/
char *cptr; /** Split part read pointer **/
/**
** Set up the split part environment variable name and try to read it
** in
**/
sprintf( buffer, "_LMFILES_%03d", count++);
cptr = (char *) Tcl_GetVar2( interp, "env", buffer, TCL_GLOBAL_ONLY);
while( cptr) { /** Something available **/
/**
** Count up the variables length
**/
cptr_len = strlen( cptr);
old_lmsize = lmsize;
lmsize += cptr_len;
/**
** Reallocate the value's buffer and copy the current split
** part at its end
**/
if((char *) NULL == (lmfiles =
(char*) realloc( lmfiles, lmsize * sizeof(char) + 1))) {
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
return( NULL); /** ---- EXIT (FAILURE) ---> **/
}
strncpy( lmfiles + old_lmsize, cptr, cptr_len);
*(lmfiles + old_lmsize + cptr_len) = '\0';
/**
** Read the next split part variable
**/
sprintf( buffer, "_LMFILES_%03d", count++);
cptr = (char *) Tcl_GetVar2( interp,"env",buffer, TCL_GLOBAL_ONLY);
}
} else { /** if( lmfiles) **/
/**
** If the environvariable _LMFILES_ has been set, copy the contents
** of the returned buffer into a free allocated one in order to
** avoid side effects.
**/
char *tmp = strdup(lmfiles);
if( !tmp)
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
return( NULL); /** -------- EXIT (FAILURE) -------> **/
/**
** Set up lmfiles pointing to the new buffer in order to be able to
** disallocate when invoked next time.
**/
lmfiles = tmp;
} /** if( lmfiles) **/
/**
** Return the received value to the caller
**/
return( lmfiles);
} /** end of 'getLMFILES' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: IsLoaded **
** **
** Description: Check wether the passed modulefile is cirrently **
** loaded **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_Interp *interp According Tcl interp.**
** char *modulename Name of the module to**
** be searched for **
** char **realname Buffer for the name **
** and version of the **
** module that has mat- **
** ched the query **
** char *filename Buffer to store the **
** whole filename of a **
** found loaded module **
** **
** Result: int 0 Requested module not loaded **
** 1 module is loaded **
** **
** realname points to the name of the module that**
** has matched the query. If this poin- **
** differs form 'modulename' after this **
** function has finished, the buffer for**
** to store the module name in has been **
** allocated here. **
** if (char **) NULL is passed, no buf- **
** fer will be allocated **
** ??? Is this freed correctly by the caller ???**
** **
** filename will be filled with the full module **
** file path of the module that has **
** matched the query **
** **
** Attached Globals: **
** **
** ************************************************************************ **
++++*/
/**
** Check all possibilities of module-versions
**/
int IsLoaded( Tcl_Interp *interp,
char *modulename,
char **realname,
char *filename )
{
return( __IsLoaded( interp, modulename, realname, filename, 0));
}
/**
** Check only an exact match of the passed module and version
**/
int IsLoaded_ExactMatch( Tcl_Interp *interp,
char *modulename,
char **realname,
char *filename )
{
return( __IsLoaded( interp, modulename, realname, filename, 1));
}
/**
** The subroutine __IsLoaded finally checks for the requested module being
** loaded or not.
**/
static int __IsLoaded( Tcl_Interp *interp,
char *modulename,
char **realname,
char *filename,
int exact)
{
char *l_modules = NULL; /** Internal module list buffer **/
char *l_modulefiles = NULL; /** Internal module file list buffer **/
char *loaded = NULL; /** Buffer for the module **/
char *basename = NULL; /** Pointer to module basename **/
char *loadedmodule_path = NULL; /** Pointer to one loaded module out **/
/** of the loaded modules list **/
int count = 0;
/**
** Get a list of loaded modules (environment variable 'LOADEDMODULES')
** and the list of loaded module-files (env. var. __LMFILES__)
**/
char *loaded_modules = (char *) Tcl_GetVar2( interp, "env",
"LOADEDMODULES", TCL_GLOBAL_ONLY);
char *loaded_modulefiles = getLMFILES( interp);
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc___IsLoaded, NULL);
#endif
/**
** If no module is currently loaded ... the requested module is surely
** not loaded, too ;-)
**/
if( !loaded_modules)
goto unwind0;
/**
** Copy the list of currently loaded modules into a new allocated array
** for further handling. If this fails it will be assumed, that the
** module is *NOT* loaded.
**/
if((char *) NULL == (l_modules = stringer(NULL,0,loaded_modules,NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind0;
/**
** Copy the list of currently loaded modulefiles into a new allocated
** array for further handling. If this failes it will be assumed, that
** the module is *NOT* loaded.
**/
if(loaded_modulefiles)
if((char *) NULL == (l_modulefiles = stringer(NULL,0,
loaded_modulefiles,NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind1;
/**
** Assume the modulename given was an exact match so there is no
** difference to return -- this will change in the case it wasn't an
** exact match below
**/
if( realname)
*realname = modulename;
if( *l_modules) {
/**
** Get each single module which is loaded by splitting up at colons
** The variable LOADEDMODULES contains a list of modulefile like the
** following:
** gnu/2.0:openwin/3.0
**/
loadedmodule_path = strtok( l_modules, ":");
while( loadedmodule_path) {
if((char *) NULL == (loaded = stringer(NULL,0,
loadedmodule_path,NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind2;
/**
** Get a modulefile without a version and check if this is the
** requested one.
**/
if( !strcmp( loaded, modulename)) { /** FOUND **/
null_free ((void *) &loaded);
break; /** leave the while loop **/
} else if( !exact) { /** NOT FOUND **/
/**
** Try to more and more simplify the modulename by removing
** all detail (version) information
**/
basename = get_module_basename( loaded);
while( basename && strcmp( basename, modulename)) {
basename = get_module_basename( basename);
}
/**
** Something left after splitting again? If yes the requested
** module is found!
** Since the name given was a basename, return the fully
** loaded path
**/
if( basename) {
null_free ((void *) &loaded);
if( realname)
if((char *) NULL == (*realname = stringer(NULL,0,
loadedmodule_path,NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
goto unwind2;
break; /** leave the while loop **/
} /** if( basename) **/
} /** if not found with single basename **/
/**
** Get the next entry from the loaded modules list
**/
loadedmodule_path = strtok( NULL, ":");
count++;
null_free ((void *) &loaded); /** Free what has been alloc. **/
} /** while **/
} /** if( *l_modules) **/
/**
** If we found something locate it's associated modulefile
**/
if( loadedmodule_path) {
if( filename && l_modulefiles && *l_modulefiles) {
/**
** The position of the loaded module within the list of loaded
** modules has been counted in 'count'. The position of the
** associated modulefile should be the same. So tokenize the
** list of modulefiles by the colon until the wanted position
** is reached.
**/
char* modulefile_path = strtok(l_modulefiles, ":");
while( count) {
if( !( modulefile_path = strtok( NULL, ":"))) {
/**
** Oops! Fewer entries in the list of loaded modulefiles
** than in the list of loaded modules. This will
** generally suggest that _LMFILES_ has become corrupted,
** but it may just mean we're working intermittantly with
** an old version. So, I'll just not touch filename which
** means the search will continue using the old method of
** looking through MODULEPATH.
*/
goto success0;
}
count--;
} /** while **/
/**
** Copy the result into the buffer passed from the caller
**/
strcpy( filename, modulefile_path);
}
/**
** FOUND.
** free up everything which has been allocated and return on success
**/
goto success0;
}
/**
** NOT FOUND. Free up everything which has been alloc'd and return on
** failure
**/
unwind2:
if( l_modulefiles)
null_free((void *) &l_modulefiles);
unwind1:
null_free((void *) &l_modules);
unwind0:
return( 0); /** -------- EXIT (FAILURE) -------> **/
success0:
if( l_modulefiles)
null_free((void *) &l_modulefiles);
null_free((void *) &l_modules);
return( 1); /** -------- EXIT (SUCCESS) -------> **/
} /** End of '__IsLoaded' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: chk_marked_entry, set_marked_entry **
** **
** Description: When switching, the variables are marked with a mar- **
** ker that is tested to see if the variable was changed**
** in the second modulefile. If it was not, then the **
** variable is unset. **
** **
** First Edition: 1992/10/25 **
** **
** Parameters: Tcl_HashTable *table Attached hash table **
** char *var According variable name **
** int val Value to be set. **
** **
** Result: int 0 Mark not set (or the value of the **
** mark was 0 ;-) **
** else Value of the mark that has been set **
** with set_marked_entry. **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
intptr_t chk_marked_entry( Tcl_HashTable *table,
char *var)
{
Tcl_HashEntry *hentry;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_chk_marked_entry, NULL);
#endif
if( hentry = Tcl_FindHashEntry( table, var))
return((intptr_t) Tcl_GetHashValue( hentry));
else
return 0;
}
void set_marked_entry( Tcl_HashTable *table,
char *var,
intptr_t val)
{
Tcl_HashEntry *hentry;
int new;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_set_marked_entry, NULL);
#endif
if( hentry = Tcl_CreateHashEntry( table, var, &new)) {
if( val)
Tcl_SetHashValue( hentry, val);
}
/** ??? Shouldn't there be an error return in case of hash creation
failing ??? **/
}
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: get_module_basename **
** **
** Description: Get the name of a module without its version. **
** This function modifies the string passed in. **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: char *modulename Full module name **
** **
** Result: char* Module name without version **
** **
** Attached Globals: **
** **
** ************************************************************************ **
++++*/
static char *get_module_basename( char *modulename)
{
char *version; /** Used to locate the version sep. **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_get_module_basename, NULL);
#endif
/**
** Use strrchr to locate the very last version string on the module
** name.
**/
if((version = strrchr( modulename, '/'))) {
*version = '\0';
} else {
modulename = NULL;
}
/**
** Return the *COPIED* string
**/
return( modulename);
} /** End of 'get_module_basename' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: Update_LoadedList **
** **
** Description: Add or remove the passed modulename and filename to/ **
** from LOADEDMODULES and _LMFILES_ **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: Tcl_Interp *interp Attached Tcl Interp. **
** char *modulename Name of the module **
** char *filename Full path name of the**
** related modulefile **
** **
** Result: int 1 Successfull operation **
** **
** Attached Globals: g_flags Controls whether the modulename **
** should be added (M_XXXX) or removed **
** (M_REMOVE) from the list of loaded **
** modules **
** **
** ************************************************************************ **
++++*/
int Update_LoadedList( Tcl_Interp *interp,
char *modulename,
char *filename)
{
char *argv[4];
char *basename;
char *module;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Update_LoadedList, NULL);
#endif
/**
** Apply changes to LOADEDMODULES first
**/
argv[1] = "LOADEDMODULES";
argv[2] = modulename;
argv[3] = NULL;
if(g_flags & M_REMOVE) {
argv[0] = "remove-path";
cmdRemovePath( 0, interp, 3, (CONST84 char **) argv);
} else {
argv[0] = "append-path";
cmdSetPath( 0, interp, 3, (CONST84 char **) argv);
}
/**
** Apply changes to _LMFILES_ now
**/
argv[1] = "_LMFILES_";
argv[2] = filename;
argv[3] = NULL;
if(g_flags & M_REMOVE) {
argv[0] = "remove-path";
cmdRemovePath( 0, interp, 3, (CONST84 char **) argv);
} else {
argv[0] = "append-path";
cmdSetPath( 0, interp, 3, (CONST84 char **) argv);
}
/**
** A module with just the basename might have been added and now we're
** removing one of its versions. We'll want to look for the basename in
** the path too.
**/
if( g_flags & M_REMOVE) {
module = strdup( modulename);
basename = module;
if( basename = get_module_basename( basename)) {
argv[2] = basename;
argv[0] = "remove-path";
cmdRemovePath( 0, interp, 3, (CONST84 char **) argv);
}
null_free((void *) &module);
}
/**
** Return on success
**/
return( 1);
} /** End of 'Update_LoadedList' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: check_magic **
** **
** Description: Check the magic cookie of the file passed as para- **
** meter if it is a valid module file **
** Based on check_magic in Richard Elling's **
** find_by_magic <Richard.Elling"@eng.auburn.edu> **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: char *filename Name of the file to check **
** char *magic_name Magic cookie **
** int magic_len Length of the magic cookie **
** **
** Result: int 0 Magic cookie doesn't match or any **
** I/O error **
** 1 Success - Magic cookie has matched **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
int check_magic( char *filename,
char *magic_name,
int magic_len)
{
int fd; /** File descriptor for reading in **/
int read_len; /** Number of bytes read **/
char buf[BUFSIZ]; /** Read buffer **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_check_magic, NULL);
#endif
/**
** Parameter check. The length of the magic cookie shouldn't exceed the
** length of out read buffer
**/
if( magic_len > BUFSIZ)
return 0;
/**
** Open the file and read in as many bytes as required for checking the
** magic cookie. If there's an I/O error (Unable to open the file or
** less than magic_len have been read) return on failure.
**/
if( 0 > (fd = open( filename, O_RDONLY)))
if( OK != ErrorLogger( ERR_OPEN, LOC, filename, _(em_reading), NULL))
return( 0); /** -------- EXIT (FAILURE) -------> **/
read_len = read( fd, buf, magic_len);
if( 0 > close(fd))
if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL))
return( 0); /** -------- EXIT (FAILURE) -------> **/
if( read_len < magic_len)
return( 0);
/**
** Check the magic cookie now
**/
return( !strncmp( buf, magic_name, magic_len));
} /** end of 'check_magic' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: cleanse_path **
** **
** Description: Copy the passed path into the new path buffer and **
** devalue '.' and '+' **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: const char *path Original path **
** char *newpath Buffer for to copy the new **
** path in **
** int len Max length of the new path **
** **
** Result: newpath will be filled up with the new, de- **
** valuated path **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
void cleanse_path( const char *path,
char *newpath,
int len)
{
unsigned int path_len = strlen( path); /** Length of the orig. path **/
int i, /** Read index **/
j; /** Write index **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_cleanse_path, NULL);
#endif
/**
** Stopping at (len - 1) ensures that the newpath string can be
** null-terminated below.
**/
for( i=0, j=0; i<path_len && j<(len - 1); i++, j++) {
switch(*path) {
case '.':
case '+':
case '$':
*newpath++ = '\\'; /** devalue '.' and '+' **/
j++;
break;
}
/**
** Flush the current character into the newpath buffer
**/
*newpath++ = *path++;
} /** for **/
/**
** Put a string terminator at the newpaths end
**/
*newpath = '\0';
} /** End of 'cleanse_path' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: chop **
** **
** Description: Remove '\n' characters from the passed string **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: char *string String to be chopped **
** **
** Result: string The chopped string **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
static char *chop( const char *string)
{
char *s, *t; /** source and target pointers **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_chop, NULL);
#endif
/**
** Remove '\n'
**/
s = t = (char *) string;
while( *s) {
if( '\n' == *s)
s++;
else
*t++ = *s++;
}
/**
** Copy the trailing terminator and return
**/
*t++ = '\0';
return( (char *) string);
} /** End of 'chop' **/
#ifndef HAVE_STRDUP
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: strdup **
** **
** Description: Makes new space to put a copy of the given string **
** into and then copies the string into the new space. **
** Just like the "standard" strdup(3). **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: **
** Result: **
** Attached Globals: **
** **
** ************************************************************************ **
++++*/
char *strdup( char *str)
{
char* new;
if ((char *) NULL) == (new = stringer(NULL,0, str, NULL))
if( OK != ErrorLogger( ERR_STRING, LOC, filename, NULL))
return( (char*) NULL); /** -------- EXIT (FAILURE) -------> **/
return( new); /** -------- EXIT (SUCCESS) -------> **/
}
#endif /* HAVE_STRDUP */
#ifndef HAVE_STRTOK
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: strtok **
** **
** Description: Considers the string s1 to consist of a sequence of **
** zero or more text tokens separated by spans of one **
** or more characters from the separator string s2. **
** Just like the "standard" strtok(3). **
** **
** Note: This function is from the Berkeley BSD distribution. **
** It was modified to fit our needs! **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: **
** Result: **
** Attached Globals: **
** **
** ************************************************************************ **
++++*/
/*
* Copyright (c) 1988 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
char *strtok( char *s,
const char *delim)
{
register char *spanp;
register int c, sc;
char *tok;
static char *last;
if( s == NULL && (s = last) == NULL)
return (NULL);
/*
* Skip (span) leading delimiters (s += strspn(s, delim), sort of).
*/
cont:
c = *s++;
for( spanp = (char *)delim; (sc = *spanp++) != 0;) {
if (c == sc)
goto cont;
}
if( !c) { /* no non-delimiter characters */
last = NULL;
return (NULL);
}
tok = s - 1;
/*
* Scan token (scan for delimiters: s += strcspn(s, delim), sort of).
* Note that delim must have one NUL; we stop if we see that, too.
*/
for (;;) {
c = *s++;
spanp = (char *)delim;
do {
if ((sc = *spanp++) == c) {
if (c == 0)
s = NULL;
else
s[-1] = 0;
last = s;
return (tok);
}
} while (sc != 0);
}
/* NOTREACHED */
} /** End of 'strtok' **/
#endif
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: chk4spch **
** **
** Description: goes through the given string and changes any non- **
** printable characters to question marks. **
** **
** First Edition: 1991/10/23 **
** **
** Parameters: char *s String to be checke **
** **
** Result: *s Will be changed accordingly **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
void chk4spch(char* s)
{
for( ; *s; s++)
if( !isgraph( *s)) *s = '?';
} /** End of 'chk4spch' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: xdup **
** **
** Description: will return a string with 1 level of environment **
** variables expanded. The limit is MOD_BUFSIZE. **
** An env.var. is denoted with either $name or ${name} **
** \$ escapes the expansion and substitutes a '$' in **
** its place. **
** **
** First Edition: 2000/01/21 R.K.Owen <rk@owen.sj.ca.us> **
** **
** Parameters: char *string Environment variable **
** **
** Result: char * An allocated string **
** **
** ************************************************************************ **
++++*/
char *xdup(char const *string) {
char *result = NULL;
char *dollarptr;
if (string == (char *)NULL) return result;
/** need to work from copy of string **/
if (((char *) NULL) == (result = stringer(NULL,0, string, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
return( (char*) NULL); /** -------- EXIT (FAILURE) -------> **/
/** check for '$' else just pass strdup of it **/
if ((dollarptr = strchr(result, '$')) == (char *) NULL) {
return result;
} else {
/** found something **/
char const *envvar;
char buffer[MOD_BUFSIZE];
char oldbuffer[MOD_BUFSIZE];
size_t blen = 0; /** running buffer length **/
char *slashptr = result;/** where to continue parsing **/
char slashchr; /** store slash char **/
int brace; /** flag if ${name} **/
pid_t pid; /** the process id **/
/** zero out buffers */
memset( buffer, '\0', MOD_BUFSIZE);
memset(oldbuffer, '\0', MOD_BUFSIZE);
/** copy everything upto $ into old buffer **/
*dollarptr = '\0';
strncpy(oldbuffer, slashptr, MOD_BUFSIZE);
*dollarptr = '$';
while (dollarptr) {
if (*oldbuffer) strncpy(buffer, oldbuffer, MOD_BUFSIZE);
blen = strlen(buffer);
/** get the env.var. name **/
if (*(dollarptr + 1) == '{') {
brace = 1;
slashptr = strchr(dollarptr + 1, '}');
} else if (*(dollarptr + 1) == '$') {
slashptr = dollarptr + 2;
} else {
slashptr = dollarptr + 1
+ strcspn(dollarptr + 1,"/:$\\");
brace = 0;
}
if (*slashptr) {
slashchr = *slashptr;
*slashptr = '\0';
} else slashptr = (char *)NULL;
/** see if escaped **/
if ((result != dollarptr) && *(dollarptr - 1) == '\\') {
/** replace \ with 0 and copy rest of name **/
buffer[blen - 1] = '\0';
strncat(buffer, dollarptr, MOD_BUFSIZE-blen);
blen = strlen(buffer);
if(brace)
strncat(buffer,"}",MOD_BUFSIZE-blen-1);
} else {
if (! strcmp(dollarptr + 1 + brace, "$")) {
/** put in the process pid **/
pid = getpid();
sprintf(buffer + blen,"%ld",(long)pid);
} else {
/** get env.var. value **/
envvar = getenv(dollarptr + 1 + brace);
/** cat value to rest of string **/
if (envvar) strncat(buffer,envvar,
MOD_BUFSIZE-blen-1);
}
}
blen = strlen(buffer);
/** start at slashptr and find next $ **/
if (slashptr) {
*slashptr = slashchr;
dollarptr = strchr(slashptr, '$');
/** copy everything upto $ **/
if (dollarptr) *dollarptr = '\0';
strncat(buffer, slashptr + brace,
MOD_BUFSIZE -blen -1);
if (dollarptr) {
*dollarptr = '$';
strncpy(oldbuffer, buffer, MOD_BUFSIZE);
}
} else { /** no more to show **/
dollarptr = (char *)NULL;
}
}
null_free((void *) &result);
return strdup(buffer);
}
} /** End of 'xdup' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: xgetenv **
** **
** Description: will return an expanded environment variable. **
** However, it will only expand 1 level. **
** See xdup() for details. **
** **
** First Edition: 2000/01/18 R.K.Owen <rk@owen.sj.ca.us> **
** **
** Parameters: char *var Environment variable **
** **
** Result: char * An allocated string **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
char *xgetenv(char const * var) {
char *result = NULL;
if (var == (char *)NULL) return result;
return xdup(getenv(var));
} /** End of 'xgetenv' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: EscapeCshString(char* in,char* out) **
** **
** Description: will translate input string to escaped output string **
** out must be allocated first **
** **
** First Edition: 2002/04/10 **
** **
** Parameters: char *in input **
** char *out output **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
void EscapeCshString(const char* in,
char* out) {
for(;*in;in++) {
if (*in == ' ' ||
*in == '\t'||
*in == '\\'||
*in == '{' ||
*in == '}' ||
*in == '|' ||
*in == '<' ||
*in == '>' ||
*in == '!' ||
*in == ';' ||
*in == '#' ||
*in == '$' ||
*in == '^' ||
*in == '&' ||
*in == '*' ||
*in == '\''||
*in == '"' ||
*in == '(' ||
*in == ')') {
*out++ = '\\';
}
*out++ = *in;
}
*out = 0;
}
void EscapeShString(const char* in,
char* out) {
for(;*in;in++) {
if (*in == ' ' ||
*in == '\t'||
*in == '\\'||
*in == '{' ||
*in == '}' ||
*in == '|' ||
*in == '<' ||
*in == '>' ||
*in == '!' ||
*in == ';' ||
*in == '#' ||
*in == '$' ||
*in == '^' ||
*in == '&' ||
*in == '*' ||
*in == '\''||
*in == '"' ||
*in == '(' ||
*in == ')') {
*out++ = '\\';
}
*out++ = *in;
}
*out = 0;
}
void EscapePerlString(const char* in,
char* out) {
for(;*in;in++) {
if (*in == '\\'||
*in == ';' ||
*in == '\'') {
*out++ = '\\';
}
*out++ = *in;
}
*out = 0;
}
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: tmpfile_mod **
** **
** Description: emulates tempnam and tmpnam and mktemp **
** Atomically creates a unique temp file and opens it **
** for writing. returns 0 on success, 1 on failure **
** Filename and file handle are returned through **
** argument pointers **
** **
** First Edition: 2002/04/22 **
** **
** Parameters: char **filename pointer to char* **
** char **file pointer to FILE* **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
int tmpfile_mod(char** filename, FILE** file) {
char* filename2;
FILE* f = NULL;
int trial = 0;
if ((char *) NULL == (filename2 =
stringer(NULL, strlen(TMP_DIR)+strlen("modulesource")+20, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
return 1;
do {
int fildes;
sprintf(filename2,"%s/modulesource_%d",TMP_DIR,trial++);
fildes = open(filename2,O_WRONLY | O_CREAT | O_EXCL | O_TRUNC,0755);
#if 0
fprintf(stderr,"DEBUG: filename=%s fildes=%d\n",
filename2,fildes);
#endif
if (fildes >=0) {
*file = fdopen(fildes,"w");
*filename = filename2;
return 0;
}
} while (trial < 1000);
null_free((void *) &filename2);
fprintf(stderr,
_("FATAL: could not get a temp file! at %s(%d)"),__FILE__,__LINE__);
return 1;
}
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: stringer **
** **
** Description: Safely copies and concats series of strings **
** until it hits a NULL argument. **
** Either a buffer & length are given or if the buffer **
** pointer is NULL then it will allocate memory to the **
** given length. If the length is 0 then get the length **
** from the series of strings. **
** The resultant buffer is returned unless there **
** is an error then NULL is returned. **
** (Therefore, one of the main uses of stringer is to **
** allocate string memory.) **
** **
** **
** First Edition: 2001/08/08 R.K.Owen <rk@owen.sj.ca.us> **
** **
** Parameters: char *buffer string buffer (if not NULL) **
** int len maximum length of buffer **
** const char *str1 1st string to copy to buffer **
** const char *str2 2nd string to cat to buffer **
** ... **
** const char *strN Nth string to cat to buffer **
** const char *NULL end of arguments **
** **
** Result: char *buffer if successfull completion **
** else NULL **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
char *stringer( char * buffer,
int len,
... )
{
va_list argptr; /** stdarg argument ptr **/
char *ptr; /** argument string ptr **/
char *tbuf = buffer; /** tempory buffer ptr **/
int sumlen = 0; /** length of all the concat strings **/
char *(*strfn)(char*,const char*) = strcpy;
/** ptr to 1st string function **/
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_stringer, NULL);
#endif
/* get start of optional arguments and sum string lengths */
va_start(argptr, len);
while ((ptr = va_arg(argptr, char *))) {
sumlen += strlen(ptr);
}
va_end(argptr);
/* can we even proceed? */
if (tbuf && (sumlen >= len || len < 0)) {
return (char *) NULL;
}
/* do we need to allocate memory? */
if (tbuf == (char *) NULL) {
if (len == 0) {
len = sumlen + 1;
}
if ((char *) NULL == (tbuf = (char*) malloc(len))) {
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
return (char *) NULL;
}
}
/* concat all the strings to buffer */
va_start(argptr, len);
while ((ptr = va_arg(argptr, char *))) {
strfn(tbuf, ptr);
strfn = strcat;
}
va_end(argptr);
/* got here successfully - return buffer */
return tbuf;
} /** End of 'stringer' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: null_free **
** **
** Description: does a free and then nulls the pointer. **
** **
** first edition: 2000/08/24 r.k.owen <rk@owen.sj.ca.us> **
** **
** parameters: void **var allocated memory **
** **
** result: void (nothing) **
** **
** attached globals: - **
** **
** ************************************************************************ **
++++*/
void null_free(void ** var) {
if (! *var) return; /* passed in a NULL ptr */
#ifdef USE_FREE
free( *var);
#endif
*var = NULL;
} /** End of 'null_free' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: countTclHash **
** **
** Description: returns the number of hash entries in a TclHash **
** **
** first edition: 2005/09/01 R.K.Owen <rk@owen.sj.ca.us> **
** **
** Parameters: Tcl_HashTable *table Hash to count **
** **
** Result: size_t Count of Hash Entries **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
size_t countTclHash(Tcl_HashTable *table) {
size_t result = 0;
Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
if(Tcl_FirstHashEntry(table, &searchPtr)) {
do {
result++;
} while(Tcl_NextHashEntry( &searchPtr));
} /** if **/
return result;
} /** End of 'countHashTable' **/
Reference in New Issue View Git Blame Copy Permalink