1 | /*****
2 | ** ** Module Header ******************************************************* **
3 | ** **
4 | ** Modules Revision 3.0 **
5 | ** Providing a flexible user environment **
6 | ** **
7 | ** File: cmdSetenv.c **
8 | ** First Edition: 91/10/23 **
9 | ** **
10 | ** Authors: John Furlan, jlf@behere.com **
11 | ** Jens Hamisch, jens@Strawberry.COM **
12 | ** **
13 | ** Description: The routines for setting and unsetting environment **
14 | ** variables from within modulefiles. **
15 | ** **
16 | ** Exports: cmdSetEnv **
17 | ** cmdUnsetEnv **
18 | ** moduleSetenv **
19 | ** moduleUnsetenv **
20 | ** **
21 | ** Notes: **
22 | ** **
23 | ** ************************************************************************ **
24 | ****/
25 |
26 | /** ** Copyright *********************************************************** **
27 | ** **
28 | ** Copyright 1991-1994 by John L. Furlan. **
29 | ** see LICENSE.GPL, which must be provided, for details **
30 | ** **
31 | ** ************************************************************************ **/
32 |
33 | static char Id[] = "@(#)$Id: cmdSetenv.c.src.html,v 1.1 2005/11/15 03:43:35 rkowen Exp $";
34 | static void *UseId[] = { &UseId, Id };
35 |
36 | /** ************************************************************************ **/
37 | /** HEADERS **/
38 | /** ************************************************************************ **/
39 |
40 | #include "modules_def.h"
41 |
42 | /** ************************************************************************ **/
43 | /** LOCAL DATATYPES **/
44 | /** ************************************************************************ **/
45 |
46 | /** not applicable **/
47 |
48 | /** ************************************************************************ **/
49 | /** CONSTANTS **/
50 | /** ************************************************************************ **/
51 |
52 | /** not applicable **/
53 |
54 | /** ************************************************************************ **/
55 | /** MACROS **/
56 | /** ************************************************************************ **/
57 |
58 | /** not applicable **/
59 |
60 | /** ************************************************************************ **/
61 | /** LOCAL DATA **/
62 | /** ************************************************************************ **/
63 |
64 | static char module_name[] = "cmdSetenv.c"; /** File name of this module **/
65 |
66 | #if WITH_DEBUGGING_CALLBACK
67 | static char _proc_cmdSetEnv[] = "cmdSetEnv";
68 | static char _proc_cmdUnsetEnv[] = "cmdUnsetEnv";
69 | #endif
70 | #if WITH_DEBUGGING_UTIL_1
71 | static char _proc_moduleSetenv[] = "moduleSetenv";
72 | static char _proc_moduleUnsetenv[] = "moduleUnsetenv";
73 | #endif
74 |
75 | /** ************************************************************************ **/
76 | /** PROTOTYPES **/
77 | /** ************************************************************************ **/
78 |
79 | /** not applicable **/
80 |
81 |
82 | /*++++
83 | ** ** Function-Header ***************************************************** **
84 | ** **
85 | ** Function: cmdSetEnv **
86 | ** **
87 | ** Description: Callback function for the 'setenv' command **
88 | ** **
89 | ** First Edition: 91/10/23 **
90 | ** **
91 | ** Parameters: ClientData client_data **
92 | ** Tcl_Interp *interp According Tcl interp.**
93 | ** int argc Number of arguments **
94 | ** char *argv[] Argument array **
95 | ** **
96 | ** Result: int TCL_OK Successfull completion **
97 | ** TCL_ERROR Any error **
98 | ** **
99 | ** Attached Globals: g_flags These are set up accordingly before **
100 | ** this function is called in order to **
101 | ** control everything **
102 | ** **
103 | ** ************************************************************************ **
104 | ++++*/
105 |
106 | int cmdSetEnv( ClientData client_data,
107 | Tcl_Interp *interp,
108 | int argc,
109 | char *argv[])
110 | {
111 | int force; /** Force removale of variables **/
112 | char *var; /** Varibales name **/
113 | char *val; /** Varibales value **/
114 |
115 | #if WITH_DEBUGGING_CALLBACK
116 | ErrorLogger( NO_ERR_START, LOC, _proc_cmdSetEnv, NULL);
117 | #endif
118 |
119 | /**
120 | ** Check parameters. Usage is: [-force] variable value
121 | **/
122 |
123 | if( argc < 3 || argc > 4) {
124 | if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], "[-force] variable value",
125 | NULL))
126 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
127 | }
128 |
129 | /**
130 | ** Get variables name and value from the argument array
131 | **/
132 |
133 | if( *argv[1] == '-') {
134 | if( !strncmp( argv[1], "-force", 6)) {
135 | force = 1;
136 | var = argv[2];
137 | val = argv[3];
138 | } else {
139 | if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], "[-force] variable value",
140 | NULL))
141 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
142 | }
143 | } else {
144 | force = 0;
145 | var = argv[1];
146 | val = argv[2];
147 | }
148 |
149 | moduleSetenv( interp, var, val, force);
150 |
151 | /**
152 | ** This has to be done after everything has been set because the
153 | ** variables may be needed later in the modulefile.
154 | **/
155 |
156 | if( g_flags & M_DISPLAY) {
157 | fprintf( stderr, "%s\t\t ", argv[ 0]);
158 | while( --argc)
159 | fprintf( stderr, "%s ", *++argv);
160 | fprintf( stderr, "\n");
161 | }
162 |
163 | #if WITH_DEBUGGING_CALLBACK
164 | ErrorLogger( NO_ERR_END, LOC, _proc_cmdSetEnv, NULL);
165 | #endif
166 |
167 | return( TCL_OK);
168 |
169 | } /** End of 'cmdSetEnv' **/
170 |
171 | /*++++
172 | ** ** Function-Header ***************************************************** **
173 | ** **
174 | ** Function: moduleSetenv **
175 | ** **
176 | ** Description: Set or unset environment variables **
177 | ** **
178 | ** First Edition: 91/10/23 **
179 | ** **
180 | ** Parameters: Tcl_Interp *interp According Tcl interp.**
181 | ** char *variable Name of the variable **
182 | ** char *value Value to be set **
183 | ** int force Force removal **
184 | ** **
185 | ** Result: int TCL_OK Successfull completion **
186 | ** TCL_ERROR Any error **
187 | ** **
188 | ** Attached Globals: g_flags These are set up accordingly before **
189 | ** this function is called in order to **
190 | ** control everything **
191 | ** **
192 | ** ************************************************************************ **
193 | ++++*/
194 |
195 | int moduleSetenv( Tcl_Interp *interp,
196 | char *variable,
197 | char *value,
198 | int force)
199 | {
200 | char *oldval; /** Old value of 'variable' **/
201 |
202 | #if WITH_DEBUGGING_UTIL_1
203 | ErrorLogger( NO_ERR_START, LOC, _proc_moduleSetenv, NULL);
204 | #endif
205 |
206 | oldval = Tcl_GetVar2( interp, "env", variable, TCL_GLOBAL_ONLY);
207 |
208 | /**
209 | ** Check to see if variable is already set correctly...
210 | **/
211 |
212 | if( !(g_flags & (M_REMOVE | M_DISPLAY | M_SWITCH)) && oldval) {
213 | if( !strcmp( value, oldval)) {
214 | return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
215 | }
216 | }
217 |
218 | /**
219 | ** If I'm in SWSTATE1, I'm removing stuff from the old modulefile, so
220 | ** I'll just mark the variables that were used with the SWSTATE1 flag and
221 | ** return.
222 | **
223 | ** When I come back through in SWSTATE2, I'm setting the variables that
224 | ** are in the new modulefile. So, I'll keep track of these by marking
225 | ** them as touched by SWSTATE2 and then actually setting their values in
226 | ** the environment down below.
227 | **
228 | ** Finally, in SWSTATE3, I'll check to see if the variables in the old
229 | ** modulefiles that have been marked are still marked as SWSTATE1. If
230 | ** they are still the same, then I'll just unset them and return.
231 | **
232 | ** And, if I'm not doing any switching, then just unset the variable if
233 | ** I'm in remove mode.
234 | **/
235 |
236 | if( g_flags & M_SWSTATE1) {
237 | set_marked_entry( markVariableHashTable, variable, M_SWSTATE1);
238 | return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
239 | } else if( g_flags & M_SWSTATE2) {
240 | set_marked_entry( markVariableHashTable, variable, M_SWSTATE2);
241 | } else if( g_flags & M_SWSTATE3) {
242 | int marked_val;
243 | marked_val = chk_marked_entry( markVariableHashTable, variable);
244 | if( marked_val) {
245 | if( marked_val == M_SWSTATE1)
246 | return( moduleUnsetenv(interp, variable)); /** -------> **/
247 | else
248 | return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
249 | }
250 | } else if( (g_flags & M_REMOVE) && !force) {
251 | return( moduleUnsetenv( interp, variable)); /** -------> **/
252 | }
253 |
254 | /**
255 | ** Keep track of our changes just in case we have to bail out and restore
256 | ** the environment.
257 | **/
258 |
259 | if( !(g_flags & (M_DISPLAY | M_WHATIS | M_HELP))) {
260 | store_hash_value( setenvHashTable, variable, value);
261 | clear_hash_value( unsetenvHashTable, variable);
262 | }
263 |
264 | /**
265 | ** Store the value into the environment
266 | **/
267 |
268 | Tcl_SetVar2( interp, "env", variable, value, TCL_GLOBAL_ONLY);
269 |
270 | #if WITH_DEBUGGING_UTIL_1
271 | ErrorLogger( NO_ERR_END, LOC, _proc_moduleSetenv, NULL);
272 | #endif
273 |
274 | return( TCL_OK);
275 |
276 | } /** End of 'moduleSetenv' **/
277 |
278 | /*++++
279 | ** ** Function-Header ***************************************************** **
280 | ** **
281 | ** Function: cmdUnsetEnv **
282 | ** **
283 | ** Description: Callback function for the 'unset' command **
284 | ** **
285 | ** First Edition: 91/10/23 **
286 | ** **
287 | ** Parameters: ClientData client_data **
288 | ** Tcl_Interp *interp According Tcl interp.**
289 | ** int argc Number of arguments **
290 | ** char *argv[] Argument array **
291 | ** **
292 | ** Result: int TCL_OK Successfull completion **
293 | ** TCL_ERROR Any error **
294 | ** **
295 | ** Attached Globals: g_flags These are set up accordingly before **
296 | ** this function is called in order to **
297 | ** control everything **
298 | ** **
299 | ** ************************************************************************ **
300 | ++++*/
301 |
302 | int cmdUnsetEnv( ClientData client_data,
303 | Tcl_Interp *interp,
304 | int argc,
305 | char *argv[])
306 | {
307 | /**
308 | ** Parameter check. The name of the variable has to be specified
309 | **/
310 |
311 | #if WITH_DEBUGGING_CALLBACK
312 | ErrorLogger( NO_ERR_START, LOC, _proc_cmdUnsetEnv, NULL);
313 | #endif
314 |
315 | if( argc < 2 || argc > 3) {
316 | if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], "variable [value]",
317 | NULL))
318 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
319 | }
320 |
321 | /**
322 | ** Unset the variable or just display what to do ...
323 | **/
324 |
325 | if( g_flags & M_DISPLAY) {
326 | fprintf( stderr, "%s\t ", argv[ 0]);
327 | while( --argc)
328 | fprintf( stderr, "%s ", *++argv);
329 | fprintf( stderr, "\n");
330 | } else if( g_flags & M_REMOVE && argc == 3) {
331 | int save_flags = g_flags;
332 | /** allow an optional 3rd argument to set the env.var. to on removal **/
333 | g_flags = (g_flags & ~M_REMOVE) | M_LOAD;
334 | moduleSetenv( interp, argv[1], argv[2], 0);
335 | g_flags = save_flags;
336 | } else {
337 | moduleUnsetenv( interp, argv[1]);
338 | }
339 |
340 | /**
341 | ** Return on success
342 | **/
343 |
344 | #if WITH_DEBUGGING_CALLBACK
345 | ErrorLogger( NO_ERR_END, LOC, _proc_cmdUnsetEnv, NULL);
346 | #endif
347 |
348 | return( TCL_OK);
349 |
350 | } /** End of 'cmdUnsetEnv' **/
351 |
352 | /*++++
353 | ** ** Function-Header ***************************************************** **
354 | ** **
355 | ** Function: moduleUnsetenv **
356 | ** **
357 | ** Description: Unset environment variables **
358 | ** **
359 | ** First Edition: 91/10/23 **
360 | ** **
361 | ** Parameters: Tcl_Interp *interp According Tcl interp.**
362 | ** char *variable Name of the variable **
363 | ** **
364 | ** Result: int TCL_OK Successfull completion **
365 | ** TCL_ERROR Any error **
366 | ** **
367 | ** Attached Globals: g_flags These are set up accordingly before **
368 | ** this function is called in order to **
369 | ** control everything **
370 | ** **
371 | ** ************************************************************************ **
372 | ++++*/
373 |
374 | int moduleUnsetenv( Tcl_Interp *interp,
375 | char *variable)
376 | {
377 |
378 | #if WITH_DEBUGGING_UTIL_1
379 | ErrorLogger( NO_ERR_START, LOC, _proc_moduleUnsetenv, NULL);
380 | #endif
381 |
382 | /**
383 | ** Don't unset the variable in Tcl Space.
384 | ** If module writer *REALLY* wants it gone, use $env
385 | **/
386 |
387 | if( !(g_flags & (M_DISPLAY | M_WHATIS | M_HELP))) {
388 | store_hash_value( unsetenvHashTable, variable, NULL);
389 | clear_hash_value( setenvHashTable, variable);
390 | }
391 |
392 | #if WITH_DEBUGGING_UTIL_1
393 | ErrorLogger( NO_ERR_END, LOC, _proc_moduleUnsetenv, NULL);
394 | #endif
395 |
396 | return( TCL_OK);
397 |
398 | } /** end of 'moduleUnsetenv' **/
399 |