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