envmodules/modules
1
0
Fork 0
mirror of https://github.com/envmodules/modules.git synced 2026-06-18 00:06:53 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity
Files
ee8186f3e147f1bf4c55efd930cddc236d7420fa
modules/utility.c
rkowen 930e57ec98 A whole slew of changes progressing to deap modulefile directories. 
The current is not usuable, but will eventually be.
These changes are checked in for safe keeping while R.K.Owen is on
vacation.
2002-08-02 22:11:24 +00:00

2883 lines
85 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: 91/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 **
** ForceBasePath **
** ForceSacredPath **
** check_magic **
** cleanse_path **
** chk4spch **
** xdup **
** xgetenv **
** stringer **
** null_clean **
** **
** 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.11 2002/08/02 22:11:23 rkowen Exp $";
static void *UseId[] = { &UseId, Id };
/** ************************************************************************ **/
/** HEADERS **/
/** ************************************************************************ **/
#include "modules_def.h"
#include "uvec.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_ForcePath[] = "ForcePath";
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 alias_separator = ';'; /** Alias command separator **/
/** ************************************************************************ **/
/** 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 int ForcePath( Tcl_Interp*, char*, char*, int);
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: 92/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: 91/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 disalloc. **/
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: 92/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 unlonking 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: 92/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: 91/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: 91/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' **/
/*++++
** ** 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: 91/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 **/
int i; /** Loop counter **/
/**
** 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 table that are of interest for shell variables
**/
for(i = 0; i < 2; i++) {
if( hashEntry = Tcl_FirstHashEntry( table[i], &searchPtr)) {
do {
key = (char*) Tcl_GetHashKey( table[i], hashEntry);
/**
** 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 = Tcl_GetVar2( interp, "env", key, TCL_GLOBAL_ONLY))
output_set_variable( interp, (char*) key, val);
}
} while( hashEntry = Tcl_NextHashEntry( &searchPtr));
} /** if **/
} /** 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 now that the current contents have been
** flushed.
**/
Clear_Global_Hash_Tables();
return( TCL_OK);
} /* End of 'Output_Modulefile_Changes' */
/*++++
** ** 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: 91/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 **/
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];
#ifndef EVAL_ALIAS
/**
** 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.
**/
char* aliasfilename; /* this is malloc'ed by tmpfile_mod() below */
#endif /* not EVAL_ALIAS */
table[0] = aliasSetHashTable;
table[1] = aliasUnsetHashTable;
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_Output_Modulefile_Aliases, NULL);
#endif
#ifndef EVAL_ALIAS
/**
** 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 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) -------> **/
}
/**
** Open the file ...
**/
if( tmpfile_mod(&aliasfilename,&aliasfile)) {
if(OK != ErrorLogger( ERR_OPEN, LOC, aliasfilename, "append", NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
} else {
/**
** 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);
} /** if( fopen) **/
} /** if( alias to set) **/
/* null_free((void *) &aliasfilename); *//* generally not malloc'd space */
#endif /* EVAL_ALIAS */
/**
** 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 **/
#ifndef EVAL_ALIAS
if( EOF == fclose( aliasfile))
if( OK != ErrorLogger( ERR_CLOSE, LOC, aliasfile, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
#endif
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: 91/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 = Tcl_GetVar2( interp, "env", formatted, TCL_GLOBAL_ONLY);
if( cptr) {
fprintf(stdout, "unsetenv %s%s", formatted, shell_cmd_separator);
}
} while( cptr);
null_free(&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: 91/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: 91/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() {%c", var, alias_separator);
/**
** ... 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: 91/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 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_set_alias( const char *alias,
const char *val)
{
int nobackslash = 1; /** Controls wether 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 fot 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 terinator as
** defined in the according 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")) {
/**
** The bourne shell itsself
** need to write a function unless this sh doesn't support
** functions
**/
if( !strcmp( shell_name, "sh")) {
#ifdef HAS_BOURNE_FUNCS
output_function(alias, val);
#else
/** ??? Print an error message ??? **/
#endif
/**
** Shells supportig extended bourne shell syntax ....
**/
} else if( !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
** take arguments. This is the case if the value has somewhere
** a '$' in it without a '\' infront.
**/
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);
} /** if( bash, zsh, ksh) **/
/** ??? Unknwn derelict ??? **/
} /** if( !csh ) **/
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: 91/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")) {
fprintf( aliasfile, "unset -f %s%c", alias, alias_separator);
/**
** 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: 91/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 = 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 = 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 = 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: 91/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 = 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: 92/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: - **
** **
** ************************************************************************ **
++++*/
int 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((int) Tcl_GetHashValue( hentry));
else
return 0;
}
void set_marked_entry( Tcl_HashTable *table,
char *var,
int 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: 91/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: 91/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, argv);
} else {
argv[0] = "append-path";
cmdSetPath( 0, interp, 3, 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, argv);
} else {
argv[0] = "append-path";
cmdSetPath( 0, interp, 3, 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, argv);
}
null_free((void *) &module);
}
/**
** Return on success
**/
return( 1);
} /** End of 'Update_LoadedList' **/
/*++++
** ** Function-Header ***************************************************** **
** **
** Function: ForceBasePath **
** **
** Description: Remove and than add the passed value from/to the **
** passed variable. After removal, the module-path is **
** APPENDED to the passed variable if 'ForceBasePath' **
** has been called and PREPENDED if it was **
** 'ForceSacredPath' **
** **
** First Edition: 91/10/23 **
** **
** Parameters: Tcl_Interp *interp Attached Tcl interpr.**
** char *variable_name Attached variable **
** char *force_pathname Name of the path to **
** be removed/added **
** **
** Result: int 1 Successfull operation **
** **
** Attached Globals: - **
** **
** ************************************************************************ **
++++*/
int ForceSacredPath( Tcl_Interp *interp,
char *variable_name,
char *force_pathname)
{
return( ForcePath( interp, variable_name, force_pathname, 0));
}
int ForceBasePath( Tcl_Interp *interp,
char *variable_name,
char *force_pathname)
{
return( ForcePath( interp, variable_name, force_pathname, 1));
}
static int ForcePath( Tcl_Interp *interp,
char *variable_name,
char *force_pathname,
int append)
{
char *argv[4];
#if WITH_DEBUGGING_UTIL_2
ErrorLogger( NO_ERR_START, LOC, _proc_ForcePath, NULL);
#endif
/**
** If no pathname to be forced is specified, success is suggested
**/
if( force_pathname == NULL)
return( 1);
/**
** Set up an according environment and call the command functions
**/
argv[1] = variable_name;
argv[2] = force_pathname;
argv[3] = NULL;
/**
** First remove the pathname that we're forcing...
**/
argv[0] = "remove-path";
cmdRemovePath( 0, interp, 3, argv);
/**
** Next, add it back to the very end of the list
**/
argv[0] = append ? "append-path" : "prepend-path";
cmdSetPath( 0, interp, 3, argv);
/**
** Return on success
**/
return( 1);
} /** End of 'ForcePath' **/
/*++++
** ** 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: 91/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, "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: 91/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 '+':
*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: 91/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: 91/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: 91/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: 91/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} **/
/** 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 {
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 {
/** get env.var. value **/
envvar = getenv(dollarptr + 1 +brace);
/** cat env.var. 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 stringer(NULL,0,buffer,NULL);
}
} /** 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 == ')') {
*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 == ')') {
*out++ = '\\';
}
*out++ = *in;
}
*out = 0;
}
void EscapePerlString(const char* in,
char* out) {
for(;*in;in++) {
if (*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: module_uvec_fns **
** **
** Description: the default string functions for uvec. **
** **
** first edition: 2002/08/01 R.K.Owen <rk@owen.sj.ca.us> **
** **
** ************************************************************************ **
++++*/
static char *module_str_alloc(char const * str, size_t n) {
char* new;
if (((char *) NULL) == (new = stringer(NULL,n+1, str, NULL)))
if( OK != ErrorLogger( ERR_STRING, LOC, str, NULL))
return( (char*) NULL); /** -------- EXIT (FAILURE) -------> **/
return( new); /** -------- EXIT (SUCCESS) -------> **/
}
static int module_str_free(char **str) {
null_free((void *) str);
return 0;
}
uvec_str module_str_fns = {
UVEC_USER,
module_str_alloc,
module_str_free
};
Reference in New Issue View Git Blame Copy Permalink