1 | /*****
2 | ** ** Module Header ******************************************************* **
3 | ** **
4 | ** Modules Revision 3.0 **
5 | ** Providing a flexible user environment **
6 | ** **
7 | ** File: cmdModule.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 actual module command from the Tcl level. This **
14 | ** routines calls other ModuleCmd routines to carry out **
15 | ** the subcommand requested. **
16 | ** **
17 | ** Exports: cmdModule **
18 | ** Read_Modulefile **
19 | ** Execute_TclFile **
20 | ** CallModuleProcedure **
21 | ** **
22 | ** Notes: **
23 | ** **
24 | ** ************************************************************************ **
25 | ****/
26 |
27 | /** ** Copyright *********************************************************** **
28 | ** **
29 | ** Copyright 1991-1994 by John L. Furlan. **
30 | ** see LICENSE.GPL, which must be provided, for details **
31 | ** **
32 | ** ************************************************************************ **/
33 |
34 | static char Id[] = "@(#)$Id: cmdModule.c.src.html,v 1.2 2005/11/25 20:09:37 rkowen Exp $";
35 | static void *UseId[] = { &UseId, Id };
36 |
37 | /** ************************************************************************ **/
38 | /** HEADERS **/
39 | /** ************************************************************************ **/
40 |
41 | #include "modules_def.h"
42 |
43 | /** ************************************************************************ **/
44 | /** LOCAL DATATYPES **/
45 | /** ************************************************************************ **/
46 |
47 | /** not applicable **/
48 |
49 | /** ************************************************************************ **/
50 | /** CONSTANTS **/
51 | /** ************************************************************************ **/
52 |
53 | /** not applicable **/
54 |
55 | /** ************************************************************************ **/
56 | /** MACROS **/
57 | /** ************************************************************************ **/
58 |
59 | /** not applicable **/
60 |
61 | /** ************************************************************************ **/
62 | /** LOCAL DATA **/
63 | /** ************************************************************************ **/
64 |
65 | char _fil_stdin[] = "stdin";
66 | char _fil_stdout[] = "stdout";
67 | char _fil_stderr[] = "stderr";
68 | char _fil_devnull[] = "/dev/null";
69 |
70 | int linenum = 0;
71 |
72 | static char module_name[] = "cmdModule.c"; /** File name of this module **/
73 |
74 | #if WITH_DEBUGGING_CALLBACK
75 | static char _proc_cmdModule[] = "cmdModule";
76 | #endif
77 | #if WITH_DEBUGGING_UTIL
78 | static char _proc_Read_Modulefile[] = "Read_Modulefile";
79 | #endif
80 | #if WITH_DEBUGGING_UTIL_1
81 | static char _proc_Execute_TclFile[] = "Execute_TclFile";
82 | static char _proc_CallModuleProcedure[] = "CallModuleProcedure";
83 | #endif
84 |
85 | char *module_command;
86 |
87 | /** ************************************************************************ **/
88 | /** PROTOTYPES **/
89 | /** ************************************************************************ **/
90 |
91 | /** not applicable **/
92 |
93 |
94 | /*++++
95 | ** ** Function-Header ***************************************************** **
96 | ** **
97 | ** Function: cmdModule **
98 | ** **
99 | ** Description: Evaluation of the module command line and callup of **
100 | ** the according subroutine **
101 | ** **
102 | ** First Edition: 91/10/23 **
103 | ** **
104 | ** Parameters: ClientData client_data **
105 | ** Tcl_Interp *interp According Tcl interp.**
106 | ** int argc Number of arguments **
107 | ** char *argv[] Argument array **
108 | ** **
109 | ** Result: int TCL_OK Successfull completion **
110 | ** TCL_ERROR Any error **
111 | ** **
112 | ** Attached Globals: g_flags These are set up accordingly before **
113 | ** this function is called in order to **
114 | ** control everything **
115 | ** g_current_module The module which is handled **
116 | ** by the current command **
117 | ** **
118 | ** ************************************************************************ **
119 | ++++*/
120 |
121 | int cmdModule( ClientData client_data,
122 | Tcl_Interp *interp,
123 | int argc,
124 | char *argv[])
125 | {
126 | int return_val = -1, i;
127 | int store_flags = g_flags;
128 | char *store_curmodule = NULL;
129 | char *save_module_command = NULL;
130 | #ifdef FORCE_PATH
131 | char *base_path = NULL;
132 | char *sacred_path = NULL;
133 | #endif
134 | int match = 0;
135 |
136 | /**
137 | ** These skip the arguments past the shell and command.
138 | **/
139 |
140 | int num_modulefiles = argc - 2;
141 | char **modulefile_list = argv + 2;
142 |
143 | #if 0
144 | int x=0;
145 | # define _XD fprintf(stderr,":%d:",++x),
146 | #else
147 | # define _XD
148 | #endif
149 |
150 | #define _MTCH _XD match =
151 | #define _ISERR ((match == -1) && (*interp->result))
152 |
153 | #if WITH_DEBUGGING_CALLBACK
154 | ErrorLogger( NO_ERR_START, LOC, _proc_cmdModule, NULL);
155 | #endif
156 |
157 | /**
158 | ** Help or whatis mode?
159 | **/
160 |
161 | if( g_flags & (M_HELP | M_WHATIS))
162 | return( TCL_OK);
163 |
164 | /**
165 | ** Parameter check
166 | **/
167 |
168 | if( argc < 2) {
169 | (void) ErrorLogger( ERR_USAGE, LOC, "module", " command ",
170 | " [arguments ...] ", NULL);
171 | (void) ModuleCmd_Help( interp, 0, modulefile_list);
172 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
173 | }
174 |
175 | /**
176 | ** Non-persist mode?
177 | **/
178 |
179 | if (g_flags & M_NONPERSIST) {
180 | return (TCL_OK);
181 | }
182 |
183 | /**
184 | ** Display whatis mode?
185 | **/
186 |
187 | if( g_flags & M_DISPLAY) {
188 | fprintf( stderr, "%s\t\t ", argv[ 0]);
189 | for( i=1; i<argc; i++)
190 | fprintf( stderr, "%s ", argv[ i]);
191 | fprintf( stderr, "\n");
192 | return( TCL_OK);
193 | }
194 |
195 | /**
196 | ** For recursion. This can be called multiple times.
197 | **/
198 |
199 | save_module_command = module_command;
200 | module_command = strdup( argv[1]);
201 |
202 | if( g_current_module)
203 | store_curmodule = g_current_module;
204 |
205 | /**
206 | ** If the command is '-', we want to just start
207 | ** interpreting Tcl from stdin.
208 | **/
209 |
210 | if(_XD !strcmp( module_command, "-")) {
211 | return_val = Execute_TclFile( interp, _fil_stdin);
212 |
213 | /**
214 | ** Evaluate the module command and call the according subroutine
215 | ** --- module LOAD|ADD
216 | **/
217 |
218 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, addRE)) {
219 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
220 | return_val = ModuleCmd_Load( interp, 1,num_modulefiles,modulefile_list);
221 |
222 | #ifdef FORCE_PATH
223 | if( return_val) {
224 |
225 | /**
226 | ** return_val now indicates whether ANY modulefile was loaded
227 | ** Only if any modulefile was loaded do we need to worry
228 | ** about forcing paths.
229 | **/
230 |
231 | if( base_path = (char *) getenv( "MODULES_PATH_BASE") ||
232 | base_path = (char *) getenv( "BASE_PATH")) {
233 | ForceBasePath( interp, "PATH", base_path);
234 | } else {
235 | ForceBasePath( interp, "PATH", FORCE_PATH);
236 | }
237 |
238 | if( sacred_path = (char *) getenv( "MODULES_PATH_SACRED") ||
239 | sacred_path = (char *) getenv( "SACRED_PATH")) {
240 | ForceSacredPath( interp, "PATH", sacred_path);
241 | } else {
242 | ForceSacredPath( interp, "PATH", FORCE_PATH_SACRED);
243 | }
244 |
245 | if(sacred_path = (char *) getenv("MODULES_LD_LIBRARY_PATH_SACRED")){
246 | ForceSacredPath( interp, "LD_LIBRARY_PATH", sacred_path);
247 | } else {
248 | ForceSacredPath( interp, "LD_LIBRARY_PATH",
249 | FORCE_LD_LIBRARY_PATH_SACRED);
250 | }
251 |
252 | } /** if( return_val) **/
253 | #endif
254 |
255 | /**
256 | ** We always say the load succeeded. ModuleCmd_Load will
257 | ** output any necessary error messages.
258 | **/
259 |
260 | return_val = TCL_OK;
261 |
262 | /**
263 | ** --- module UNLOAD
264 | **/
265 |
266 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, rmRE)) {
267 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
268 | ModuleCmd_Load( interp, 0, num_modulefiles, modulefile_list);
269 | return_val = TCL_OK;
270 |
271 | /**
272 | ** --- module SWITCH
273 | **/
274 |
275 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, swRE)) {
276 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
277 | return_val = ModuleCmd_Switch( interp, num_modulefiles,modulefile_list);
278 |
279 | /**
280 | ** --- module DISPLAY
281 | **/
282 |
283 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, dispRE)) {
284 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
285 | return_val = ModuleCmd_Display( interp,num_modulefiles,modulefile_list);
286 |
287 | /**
288 | ** --- module LIST
289 | **/
290 |
291 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, listRE)) {
292 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
293 | if (! (sw_format & SW_SET) ) { /* default format options */
294 | sw_format |= (SW_HUMAN | SW_TERSE );
295 | sw_format &= ~(SW_PARSE | SW_LONG );
296 | }
297 | /* use SW_LIST to indicate LIST & not AVAIL */
298 | sw_format |= SW_LIST;
299 | return_val = ModuleCmd_List( interp, num_modulefiles, modulefile_list);
300 |
301 | /**
302 | ** --- module AVAIL
303 | **/
304 |
305 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command,availRE)) {
306 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
307 | if (! (sw_format & SW_SET) ) { /* default format options */
308 | sw_format |= (SW_HUMAN | SW_TERSE);
309 | sw_format &= ~(SW_PARSE | SW_LONG );
310 | }
311 | /* use SW_LIST to indicate LIST & not AVAIL */
312 | sw_format &= ~SW_LIST;
313 | return_val = ModuleCmd_Avail( interp, num_modulefiles, modulefile_list);
314 |
315 | /**
316 | ** --- module WHATIS and APROPOS
317 | **/
318 |
319 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command,whatisRE)) {
320 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
321 | return_val = ModuleCmd_Whatis(interp, num_modulefiles, modulefile_list);
322 |
323 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command,aproposRE)) {
324 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
325 | return_val = ModuleCmd_Apropos(interp, num_modulefiles,modulefile_list);
326 |
327 | /**
328 | ** --- module CLEAR
329 | **/
330 |
331 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command,clearRE)) {
332 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
333 | return_val = ModuleCmd_Clear( interp, num_modulefiles, modulefile_list);
334 |
335 | /**
336 | ** --- module UPDATE
337 | **/
338 |
339 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command,updateRE)) {
340 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
341 | return_val = ModuleCmd_Update(interp, num_modulefiles, modulefile_list);
342 |
343 | /**
344 | ** --- module PURGE
345 | **/
346 |
347 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command,purgeRE)) {
348 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
349 | return_val = ModuleCmd_Purge( interp, num_modulefiles, modulefile_list);
350 |
351 | /**
352 | ** --- module INIT
353 | **/
354 |
355 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command,initRE)) {
356 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
357 |
358 | if( Tcl_RegExpMatch(interp,module_command, "^inita|^ia")){/* initadd */
359 | if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL);
360 | g_flags |= M_LOAD;
361 | return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list);
362 | g_flags &= ~M_LOAD;
363 | }
364 |
365 | if( Tcl_RegExpMatch(interp,module_command, "^initr|^iw")){ /* initrm */
366 | if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL);
367 | g_flags |= M_REMOVE;
368 | return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list);
369 | g_flags &= ~M_REMOVE;
370 | }
371 |
372 | if( Tcl_RegExpMatch(interp,module_command, "^initl|^il")){/* initlist*/
373 | if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL);
374 | g_flags |= M_DISPLAY;
375 | return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list);
376 | g_flags &= ~M_DISPLAY;
377 | }
378 |
379 | if(Tcl_RegExpMatch(interp,module_command, "^inits|^is")){/* initswitch*/
380 | if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL);
381 | g_flags |= M_SWITCH;
382 | return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list);
383 | g_flags &= ~M_SWITCH;
384 | }
385 |
386 | if(Tcl_RegExpMatch(interp,module_command, "^initc|^ic")){/* initclear*/
387 | if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL);
388 | g_flags |= M_CLEAR;
389 | return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list);
390 | g_flags &= ~M_CLEAR;
391 | }
392 |
393 | if(Tcl_RegExpMatch(interp,module_command,"^initp|^ip")){/*initprepend*/
394 | if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL);
395 | g_flags |= (M_PREPEND | M_LOAD);
396 | return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list);
397 | g_flags &= ~(M_PREPEND | M_LOAD);
398 | }
399 |
400 | /**
401 | ** --- module USE
402 | **/
403 |
404 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, useRE)) {
405 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
406 | return_val = ModuleCmd_Use( interp, num_modulefiles, modulefile_list);
407 |
408 | /**
409 | ** --- module UNUSE
410 | **/
411 |
412 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, unuseRE)) {
413 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
414 | return_val = ModuleCmd_UnUse( interp, num_modulefiles, modulefile_list);
415 |
416 | /**
417 | ** --- module REFRESH
418 | **/
419 |
420 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, refreshRE)) {
421 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
422 | return_val = ModuleCmd_Refresh( interp, num_modulefiles, modulefile_list);
423 |
424 | /**
425 | ** --- module HELP
426 | **/
427 |
428 | } else if(_MTCH Tcl_RegExpMatch(interp,module_command, helpRE)) {
429 | if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL);
430 | return_val = ModuleCmd_Help( interp, num_modulefiles, modulefile_list);
431 | }
432 |
433 | /**
434 | ** Tracing
435 | **/
436 |
437 | if( CheckTracingList(interp, module_command,
438 | num_modulefiles, modulefile_list))
439 | Module_Tracing( return_val, argc, argv);
440 |
441 | /**
442 | ** Evaluate the subcommands return value in order to get rid of unrecog-
443 | ** nized commands
444 | **/
445 |
446 | if( return_val < 0)
447 | if( OK != ErrorLogger( ERR_COMMAND, LOC, module_command, NULL))
448 | return (TCL_ERROR);
449 |
450 | /**
451 | ** Clean up from recursion
452 | **/
453 |
454 | g_flags = store_flags;
455 | if( store_curmodule)
456 | g_current_module = store_curmodule;
457 |
458 | module_command = save_module_command;
459 |
460 | /**
461 | ** Return on success
462 | **/
463 |
464 | #if WITH_DEBUGGING_CALLBACK
465 | ErrorLogger( NO_ERR_END, LOC, _proc_cmdModule, NULL);
466 | #endif
467 |
468 | return( return_val);
469 |
470 | } /** End of 'cmdModule' **/
471 |
472 | /*++++
473 | ** ** Function-Header ***************************************************** **
474 | ** **
475 | ** Function: Read_Modulefile **
476 | ** **
477 | ** Description: Check the passed filename for to be a valid module **
478 | ** and execute the according command file **
479 | ** **
480 | ** First Edition: 91/10/23 **
481 | ** **
482 | ** Parameters: Tcl_Interp *interp According Tcl interp.**
483 | ** char *filename **
484 | ** **
485 | ** Result: int TCL_OK Successfull completion **
486 | ** TCL_ERROR Any error **
487 | ** **
488 | ** Attached Globals: **
489 | ** **
490 | ** ************************************************************************ **
491 | ++++*/
492 |
493 | int Read_Modulefile( Tcl_Interp *interp,
494 | char *filename)
495 | {
496 | int result;
497 | char *startp, *endp;
498 |
499 | #if WITH_DEBUGGING_UTIL
500 | ErrorLogger( NO_ERR_START, LOC, _proc_Read_Modulefile, NULL);
501 | #endif
502 |
503 | /**
504 | ** Parameter check. A valid filename is to be given.
505 | **/
506 |
507 | if( !filename) {
508 | if( OK != ErrorLogger( ERR_PARAM, LOC, "filename", NULL))
509 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
510 | }
511 |
512 | /**
513 | ** Check for the module 'magic cookie'
514 | ** Trust stdin as a valid module file ...
515 | **/
516 |
517 | if( !strcmp( filename, _fil_stdin) && !check_magic( filename,
518 | MODULES_MAGIC_COOKIE, MODULES_MAGIC_COOKIE_LENGTH)) {
519 | if( OK != ErrorLogger( ERR_MAGIC, LOC, filename, NULL))
520 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
521 | }
522 |
523 | /**
524 | ** Now do execute that module file and evaluate the result of the
525 | ** latest executed command
526 | **/
527 |
528 | if( TCL_ERROR == (result = Execute_TclFile(interp, filename))) {
529 |
530 | #if WITH_DEBUGGING_UTIL
531 | ErrorLogger( NO_ERR_DEBUG, LOC, "Execution of '",
532 | filename, "' failed", NULL);
533 | #endif
534 |
535 | if( *interp->result) {
536 | char *tstr = NULL;
537 | Tcl_RegExp retexpPtr;
538 |
539 | tstr = strdup(interp->result);
540 | retexpPtr = Tcl_RegExpCompile(interp, "^EXIT ([0-9]*)");
541 | if( Tcl_RegExpExec(interp, retexpPtr, tstr, tstr)) {
542 | Tcl_RegExpRange(retexpPtr, 1, &startp, &endp);
543 | if( startp != '\0')
544 | result = atoi( startp );
545 | }
546 | if (tstr)
547 | null_free((void *) &tstr);
548 | }
549 | }
550 |
551 | /**
552 | ** Return the result as derivered from the module file execution
553 | **/
554 |
555 | #if WITH_DEBUGGING_UTIL
556 | ErrorLogger( NO_ERR_END, LOC, _proc_Read_Modulefile, NULL);
557 | #endif
558 |
559 | return( result);
560 |
561 | } /** End of 'Read_Modulefile' **/
562 |
563 | /*++++
564 | ** ** Function-Header ***************************************************** **
565 | ** **
566 | ** Function: Execute_TclFile **
567 | ** **
568 | ** Description: Read in and execute all commands concerning the Tcl **
569 | ** file passed as parameter **
570 | ** **
571 | ** First Edition: 91/10/23 **
572 | ** **
573 | ** Parameters: Tcl_Interp *interp According Tcl interp.**
574 | ** char *filename **
575 | ** **
576 | ** Result: int TCL_OK Successfull completion **
577 | ** TCL_ERROR Any error **
578 | ** **
579 | ** Attached Globals: line Input read buffer **
580 | ** **
581 | ** ************************************************************************ **
582 | ++++*/
583 |
584 | int Execute_TclFile( Tcl_Interp *interp,
585 | char *filename)
586 | {
587 | FILE *infile;
588 | int gotPartial = 0;
589 | int result = 0;
590 | char *cmd;
591 | Tcl_DString cmdbuf;
592 |
593 | #if WITH_DEBUGGING_UTIL_1
594 | ErrorLogger( NO_ERR_START, LOC, _proc_Execute_TclFile, NULL);
595 | #endif
596 |
597 | /**
598 | ** If there isn't a line buffer allocated so far, do it now
599 | **/
600 |
601 | if( line == NULL) {
602 | if( NULL == (line = (char*) malloc( LINELENGTH * sizeof( char)))) {
603 | if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
604 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
605 | }
606 | }
607 |
608 | /**
609 | ** If we're supposed to be interpreting from stdin, set infile
610 | ** equal to stdin, otherwise, open the file and interpret
611 | **/
612 |
613 | if( !strcmp( filename, _fil_stdin)) {
614 | infile = stdin;
615 | } else {
616 | if( NULL == (infile = fopen( filename, "r"))) {
617 | if( OK != ErrorLogger( ERR_OPEN, LOC, filename, "reading", NULL))
618 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
619 | }
620 | }
621 |
622 | /**
623 | ** Allow access to which file is being loaded.
624 | **/
625 |
626 | linenum = 0;
627 | Tcl_SetVar( interp, "ModulesCurrentModulefile", filename, 0);
628 | Tcl_DStringInit( &cmdbuf);
629 |
630 | while( 1) {
631 |
632 | linenum++;
633 | if( fgets(line, LINELENGTH, infile) == NULL) {
634 | if( !gotPartial) {
635 | break; /** while **/
636 | }
637 | line[0] = '\0';
638 | }
639 |
640 | /**
641 | ** Put the whole command on the command buffer
642 | **/
643 |
644 | cmd = Tcl_DStringAppend( &cmdbuf, line, (-1));
645 |
646 | if( line[0] != 0 && !Tcl_CommandComplete(cmd)) {
647 | gotPartial++;
648 | continue;
649 | }
650 |
651 | /**
652 | ** Now evaluate the command and react on its result
653 | ** Reinitialize the command buffer
654 | **/
655 |
656 | #if WITH_DEBUGGING_UTIL_1
657 | ErrorLogger( NO_ERR_DEBUG, LOC, " Evaluating '", cmd, "'", NULL);
658 | #endif
659 |
660 | result = Tcl_Eval( interp, cmd);
661 |
662 | if( TCL_ERROR == result) {
663 | ErrorLogger( ERR_EXEC, LOC, cmd, NULL);
664 | }
665 |
666 | Tcl_DStringTrunc( &cmdbuf, 0);
667 |
668 | #if WITH_DEBUGGING_UTIL_1
669 | {
670 | char buffer[ 80];
671 |
672 | switch( result) {
673 | case TCL_OK: strcpy( buffer, "TCL_OK");
674 | break;
675 |
676 | case TCL_ERROR: strcpy( buffer, "TCL_ERROR");
677 | break;
678 |
679 | case TCL_LEVEL0_RETURN:
680 | strcpy( buffer, "TCL_LEVEL0_RETURN");
681 | break;
682 | }
683 |
684 | ErrorLogger( NO_ERR_DEBUG, LOC, " Result: '", buffer, "'", NULL);
685 | }
686 | #endif
687 |
688 | switch( result) {
689 |
690 | case TCL_OK: gotPartial = 0;
691 | continue; /** while **/
692 |
693 | case TCL_ERROR: interp->errorLine = ((linenum-1)-gotPartial) +
694 | interp->errorLine;
695 | /* FALLTHROUGH */
696 |
697 | case TCL_LEVEL0_RETURN:
698 | break; /** switch **/
699 | }
700 |
701 | /**
702 | ** If the while loop hasn't been continued so far, it is to be broken
703 | ** now
704 | **/
705 |
706 | break; /** while **/
707 |
708 | } /** while **/
709 |
710 | /**
711 | ** Free up what has been used, close the input file and return the result
712 | ** of the last command to the caller
713 | **/
714 |
715 | Tcl_DStringFree( &cmdbuf);
716 | if( EOF == fclose( infile))
717 | if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL))
718 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
719 |
720 | #if WITH_DEBUGGING_UTIL_1
721 | ErrorLogger( NO_ERR_END, LOC, _proc_Execute_TclFile, NULL);
722 | #endif
723 |
724 | return( result);
725 |
726 | } /** End of 'Execute_TclFile' **/
727 |
728 | /*++++
729 | ** ** Function-Header ***************************************************** **
730 | ** **
731 | ** Function: CallModuleProcedure **
732 | ** **
733 | ** Description: Call a Tcl Procedure **
734 | ** Executes the passed modulefile (conditionally hidden)**
735 | ** and then evaluates the passed Tcl procedure **
736 | ** **
737 | ** First Edition: 91/10/23 **
738 | ** **
739 | ** Parameters: Tcl_Interp *interp According Tcl interp.**
740 | ** Tcl_DString *cmdptr Buffer fot the Tcl **
741 | ** command **
742 | ** char *modulefile According module file**
743 | ** char *procname Name of the Tcl Proc.**
744 | ** int suppress_output Controlls redirect.**
745 | ** of stdout and stderr **
746 | ** **
747 | ** Result: int TCL_OK Successfull completion **
748 | ** TCL_ERROR Any error **
749 | ** **
750 | ** Attached Globals: - **
751 | ** **
752 | ** ************************************************************************ **
753 | ++++*/
754 |
755 | int CallModuleProcedure( Tcl_Interp *interp,
756 | Tcl_DString *cmdptr,
757 | char *modulefile,
758 | char *procname,
759 | int suppress_output)
760 | {
761 | char cmdline[ LINELENGTH];
762 | char *cmd;
763 | int result;
764 | int saved_stdout = 0, saved_stderr = 0, devnull;
765 |
766 | #if WITH_DEBUGGING_UTIL_1
767 | ErrorLogger( NO_ERR_START, LOC, _proc_CallModuleProcedure, NULL);
768 | #endif
769 |
770 | /**
771 | ** Must send stdout and stderr to /dev/null until the
772 | ** ModulesHelp procedure is called.
773 | **/
774 |
775 | if( suppress_output) {
776 | if( 0 > (devnull = open( _fil_devnull, O_RDWR))) {
777 | if( OK != ErrorLogger( ERR_OPEN, LOC, _fil_devnull, "changing", NULL))
778 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
779 | }
780 |
781 | /**
782 | ** Close STDOUT and reopen it as /dev/null
783 | **/
784 |
785 | if( -1 == ( saved_stdout = dup( 1)))
786 | if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
787 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
788 |
789 | if( -1 == close( 1))
790 | if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
791 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
792 |
793 | if( -1 == dup( devnull))
794 | if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL))
795 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
796 |
797 | /**
798 | ** Close STDERR and reopen it as /dev/null
799 | **/
800 |
801 | if( -1 == ( saved_stdout = dup( 2)))
802 | if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL))
803 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
804 |
805 | if( -1 == close( 2))
806 | if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL))
807 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
808 |
809 | if( -1 == dup( devnull))
810 | if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL))
811 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
812 | }
813 |
814 | /**
815 | ** Read the passed module file
816 | **/
817 |
818 | Read_Modulefile( interp, modulefile);
819 |
820 | /**
821 | ** Reinstall stdout and stderr
822 | **/
823 |
824 | if( suppress_output) {
825 |
826 | /**
827 | ** Reinstall STDOUT
828 | **/
829 |
830 | if( EOF == fflush( stdout))
831 | if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stdout, NULL))
832 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
833 |
834 | if( EOF == fflush( stderr))
835 | if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stderr, NULL))
836 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
837 |
838 | if( -1 == close( 1))
839 | if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
840 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
841 |
842 | /**
843 | ** Reinstall STDERR
844 | **/
845 |
846 | if( -1 == dup( saved_stdout))
847 | if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
848 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
849 |
850 | if( -1 == close( 2))
851 | if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL))
852 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
853 |
854 | if( -1 == dup( saved_stderr))
855 | if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL))
856 | return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
857 | }
858 |
859 | /**
860 | ** Now evaluate the Tcl Procedure
861 | **/
862 |
863 | /* sprintf( cmdline, "%s\n", procname); */
864 | strcpy( cmdline, procname);
865 | strcat( cmdline, "\n");
866 | cmd = Tcl_DStringAppend( cmdptr, cmdline, (-1));
867 |
868 | result = Tcl_Eval( interp, cmd);
869 | Tcl_DStringTrunc( cmdptr, 0);
870 |
871 | #if WITH_DEBUGGING_UTIL_1
872 | ErrorLogger( NO_ERR_END, LOC, _proc_CallModuleProcedure, NULL);
873 | #endif
874 |
875 | return( result);
876 |
877 | } /** End of 'CallModuleProcedure' **/