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