1 | /*****
2 | ** ** Module Header ******************************************************* **
3 | ** **
4 | ** Modules Revision 3.0 **
5 | ** Providing a flexible user environment **
6 | ** **
7 | ** File: ModuleCmd_Use.c **
8 | ** First Edition: 1991/10/23 **
9 | ** **
10 | ** Authors: John Furlan, jlf@behere.com **
11 | ** Jens Hamisch, jens@Strawberry.COM **
12 | ** **
13 | ** Description: Prepends (and appends) directories to the MODULEPATH **
14 | ** environment variable to enable access to more **
15 | ** modulefiles. **
16 | ** **
17 | ** Exports: ModuleCmd_Use **
18 | ** ModuleCmd_UnUse **
19 | ** **
20 | ** Notes: **
21 | ** **
22 | ** ************************************************************************ **
23 | ****/
24 |
25 | /** ** Copyright *********************************************************** **
26 | ** **
27 | ** Copyright 1991-1994 by John L. Furlan. **
28 | ** see LICENSE.GPL, which must be provided, for details **
29 | ** **
30 | ** ************************************************************************ **/
31 |
32 | static char Id[] = "@(#)$Id: ModuleCmd_Use.c.src.html,v 1.6 2006/01/18 05:35:11 rkowen Exp $";
33 | static void *UseId[] = { &UseId, Id };
34 |
35 | /** ************************************************************************ **/
36 | /** HEADERS **/
37 | /** ************************************************************************ **/
38 |
39 | #include "modules_def.h"
40 |
41 | /** ************************************************************************ **/
42 | /** LOCAL DATATYPES **/
43 | /** ************************************************************************ **/
44 |
45 | /** not applicable **/
46 |
47 | /** ************************************************************************ **/
48 | /** CONSTANTS **/
49 | /** ************************************************************************ **/
50 |
51 | /** not applicable **/
52 |
53 | /** ************************************************************************ **/
54 | /** MACROS **/
55 | /** ************************************************************************ **/
56 |
57 | /** not applicable **/
58 |
59 | /** ************************************************************************ **/
60 | /** LOCAL DATA **/
61 | /** ************************************************************************ **/
62 |
63 | static char module_name[] = "ModuleCmd_Use.c"; /** File name of this module **/
64 | #if WITH_DEBUGGING_UTIL_1
65 | static char _proc_append_to_modulesbeginenv[] = "append_to_modulesbeginenv";
66 | #endif
67 | #if WITH_DEBUGGING_MODULECMD
68 | static char _proc_ModuleCmd_Use[] = "ModuleCmd_Use";
69 | static char _proc_ModuleCmd_UnUse[] = "ModuleCmd_UnUse";
70 | #endif
71 |
72 | /** ************************************************************************ **/
73 | /** PROTOTYPES **/
74 | /** ************************************************************************ **/
75 |
76 |
77 | #ifdef BEGINENV
78 | /*++++
79 | ** ** Function-Header ***************************************************** **
80 | ** **
81 | ** Function: append_to_modulesbeginenv **
82 | ** **
83 | ** Description: Append the passed variable (with value) to the begin-**
84 | ** ning environment **
85 | ** **
86 | ** First Edition: 1991/10/23 **
87 | ** **
88 | ** Parameters: Tcl_Interp *interp Attached Tcl Interp. **
89 | ** char *var Name of the variable **
90 | ** **
91 | ** Result: - **
92 | ** **
93 | ** Attached Globals: - **
94 | ** **
95 | ** ************************************************************************ **
96 | ++++*/
97 |
98 | static void append_to_modulesbeginenv( Tcl_Interp *interp,
99 | char *var)
100 | {
101 | char *filename, /** The filename, where the begin- **/
102 | /** ning environment resides **/
103 | *val; /** Value of the passed variable **/
104 | FILE *file; /** File read handle **/
105 |
106 | #if WITH_DEBUGGING_UTIL_1
107 | ErrorLogger( NO_ERR_START, LOC, _proc_append_to_modulesbeginenv, NULL);
108 | #endif
109 |
110 | if( var
111 | #if BEGINENV == 99
112 | && Tcl_GetVar2( interp,"env","MODULESBEGINENV", TCL_GLOBAL_ONLY)
113 | #endif
114 | ) {
115 |
116 | #if WITH_DEBUGGING_UTIL_1
117 | ErrorLogger( NO_ERR_DEBUG, LOC, "Adding '", var, "'");
118 | #endif
119 |
120 | /**
121 | ** Get filename and the value of the passed variable
122 | **/
123 |
124 | if( filename = (char *) Tcl_GetVar2( interp, "env","_MODULESBEGINENV_",
125 | TCL_GLOBAL_ONLY)) {
126 | val = (char *) Tcl_GetVar2( interp, "env", var, TCL_GLOBAL_ONLY);
127 |
128 | /**
129 | ** Append the string <var>=<value>
130 | **/
131 |
132 | if( NULL != (file = fopen( filename, "a+"))) {
133 | fprintf( file, "%s=%s\n", var, val);
134 | if( EOF == fclose( file))
135 | ErrorLogger( ERR_CLOSE, LOC, filename, NULL);
136 | } else {
137 | ErrorLogger( ERR_OPEN, LOC, filename, "appending", NULL);
138 | }
139 |
140 | } /** if( get filename) **/
141 | } /** if( var passed) **/
142 |
143 | } /** End of 'append_to_modulesbeginenv' **/
144 | #else
145 | # define append_to_modulesbeginenv( a, b) {}
146 | #endif
147 |
148 | /*++++
149 | ** ** Function-Header ***************************************************** **
150 | ** **
151 | ** Function: ModuleCmd_Use **
152 | ** **
153 | ** Description: Execution of the module-command 'use' **
154 | ** **
155 | ** First Edition: 1991/10/23 **
156 | ** **
157 | ** Parameters: Tcl_Interp *interp Attached Tcl Interp. **
158 | ** int argc Number of arguments **
159 | ** char *argv[] Argument list **
160 | ** **
161 | ** Result: int TCL_ERROR Failure **
162 | ** TCL_OK Successfull operation **
163 | ** **
164 | ** Attached Globals: g_flags Controllig the callback functions **
165 | ** **
166 | ** ************************************************************************ **
167 | ++++*/
168 |
169 | int ModuleCmd_Use( Tcl_Interp *interp,
170 | int argc,
171 | char *argv[])
172 | {
173 | struct stat stats; /** Buffer for the stat() systemcall **/
174 | char *pathargv[4]; /** Argument buffer for Tcl calls **/
175 | int i;
176 |
177 | /**
178 | ** Parameter check. Usage is 'module use <path> [ <path> ... ]'
179 | **/
180 |
181 | #if WITH_DEBUGGING_MODULECMD
182 | ErrorLogger( NO_ERR_START, LOC, _proc_ModuleCmd_Use, NULL);
183 | #endif
184 |
185 | if( argc < 1) {
186 | if( OK != ErrorLogger( ERR_USAGE, LOC, "use [-a|--append] dir [dir ...]", NULL))
187 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
188 | }
189 |
190 | /**
191 | ** Remove is done by another subroutine
192 | **/
193 |
194 | if( g_flags & M_REMOVE)
195 | return( ModuleCmd_UnUse( interp, argc, argv));
196 |
197 | /**
198 | ** Append or prepend the new module path
199 | **/
200 |
201 | if( append_flag ) {
202 | pathargv[0] = "append-path";
203 | } else {
204 | pathargv[0] = "prepend-path";
205 | }
206 |
207 | /**
208 | ** Append (prepend) all passed paths to MODULEPATH in case they do exist,
209 | ** and are readable directories
210 | **/
211 |
212 | pathargv[1] = "MODULEPATH";
213 | pathargv[3] = NULL;
214 |
215 | for( i=0; i < argc; i++) {
216 | /**
217 | ** Check for -a|--append flag (if in modulefile - it's not parsed
218 | ** by getoptlong) (keep -append for backward compatibility)
219 | **/
220 | if( (!strcmp("-a",argv[i])) || (!strcmp("--append",argv[i]))
221 | || (!strcmp("-append",argv[i]))) {
222 |
223 | pathargv[0] = "append-path";
224 | continue;
225 |
226 | } else if( stat( argv[i], &stats) < 0) {
227 | /**
228 | ** Check for existing, readable directories
229 | **/
230 | if( OK != ErrorLogger( ERR_DIRNOTFOUND, LOC, argv[i], NULL))
231 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
232 | } else if( !S_ISDIR( stats.st_mode)) {
233 | if( OK != ErrorLogger( ERR_NODIR, LOC, argv[i], NULL))
234 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
235 | }
236 |
237 | /**
238 | ** Used the 'cmdSetPath' callback function to modify the MODULEPATH
239 | **/
240 |
241 | pathargv[2] = argv[i];
242 |
243 | if( cmdSetPath((ClientData) 0, interp, 3, (CONST84 char **) pathargv)
244 | == TCL_ERROR)
245 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
246 |
247 | } /** for **/
248 |
249 | /**
250 | ** Add the new value of MODULESPATH to the end
251 | ** of the beginenvcache so that update will be able to find its
252 | ** modulefiles.
253 | **/
254 |
255 | append_to_modulesbeginenv( interp, "MODULEPATH");
256 |
257 | #if WITH_DEBUGGING_MODULECMD
258 | ErrorLogger( NO_ERR_END, LOC, _proc_ModuleCmd_Use, NULL);
259 | #endif
260 |
261 | return( TCL_OK);
262 |
263 | } /** End of 'ModuleCmd_Use' **/
264 |
265 | /*++++
266 | ** ** Function-Header ***************************************************** **
267 | ** **
268 | ** Function: ModuleCmd_UnUse **
269 | ** **
270 | ** Description: Execution of the module-command 'unuse' **
271 | ** **
272 | ** First Edition: 1991/10/23 **
273 | ** **
274 | ** Parameters: Tcl_Interp *interp Attached Tcl Interp. **
275 | ** int argc Number of arguments **
276 | ** char *argv[] Argument list **
277 | ** **
278 | ** Result: int TCL_ERROR Failure **
279 | ** TCL_OK Successfull operation **
280 | ** **
281 | ** Attached Globals: - **
282 | ** **
283 | ** ************************************************************************ **
284 | ++++*/
285 |
286 | int ModuleCmd_UnUse( Tcl_Interp *interp,
287 | int argc,
288 | char *argv[])
289 | {
290 | char *pathargv[4];
291 | int i = 0;
292 |
293 | #if WITH_DEBUGGING_MODULECMD
294 | ErrorLogger( NO_ERR_START, LOC, _proc_ModuleCmd_UnUse, NULL);
295 | #endif
296 |
297 | /**
298 | ** Parameter check. Usage is 'module use <path> [ <path> ... ]'
299 | **/
300 |
301 | if( argc < 1) {
302 | if( OK != ErrorLogger( ERR_USAGE, LOC, "unuse dir [dir ...]", NULL))
303 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
304 | }
305 |
306 | /**
307 | ** Remove all passed paths from MODULEPATH
308 | ** Use the 'cmdSetPath' callback function to modify the MODULEPATH
309 | **/
310 |
311 | pathargv[0] = "remove-path";
312 | pathargv[1] = "MODULEPATH";
313 | pathargv[3] = NULL;
314 |
315 | for(i = 0; i < argc; i++) {
316 | pathargv[2] = argv[i];
317 | if(cmdRemovePath((ClientData) 0, interp, 3, (CONST84 char **) pathargv)
318 | == TCL_ERROR)
319 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
320 | } /** for **/
321 |
322 | /**
323 | ** Add the new value of MODULESPATH to the end
324 | ** of the beginenvcache so that update will be able to find its
325 | ** modulefiles.
326 | **/
327 |
328 | append_to_modulesbeginenv( interp, "MODULEPATH");
329 |
330 | #if WITH_DEBUGGING_MODULECMD
331 | ErrorLogger( NO_ERR_END, LOC, _proc_ModuleCmd_UnUse, NULL);
332 | #endif
333 |
334 | return( TCL_OK);
335 |
336 | } /** End of 'ModuleCmd_UnUse' **/
337 |
338 |