#include <tcl.h>
#include <unistd.h>
#ifndef DEBUG_SCRIPT_DIR
#define DEBUG_SCRIPT_DIR ""
#endif
#define DEBUGSCRIPT DEBUG_SCRIPT_DIR "infodebug.tcl"
#define TESTDTCL_TCL DEBUG_SCRIPT_DIR "testdtcl.tcl"
#define ER1 "<h1> ERROR </h1><p><xmp>\n"
#define ER2 "</xmp><h1> ERROR </h1>\n"
#define STARTING_SEQUENCE "<+"
#define ENDING_SEQUENCE "+>"
void usage(char *);
int main(int argc, char *argv[])
{
const char *strstart = STARTING_SEQUENCE;
const char *strend = ENDING_SEQUENCE;
char *globalscript = NULL;
int infoflag = 0;
int globalscriptflag = 0;
int l = strlen(ENDING_SEQUENCE), l2 = strlen(STARTING_SEQUENCE), p = 0;
int c, ch;
int inside = 0;
FILE *f;
Tcl_Obj *outbuf;
Tcl_Obj *namespacePrologue;
Tcl_Interp *interp;
fprintf(stderr,
"Testdtcl is out of date, you should only "
"really be using it if you wish to improve it\n");
exit(0);
interp = Tcl_CreateInterp();
Tcl_Init(interp);
if (Tcl_EvalFile(interp, DEBUGSCRIPT) == TCL_ERROR)
{
fprintf(stderr, "Couldn't open %s\n", DEBUGSCRIPT);
exit(1);
}
while ((c = getopt (argc, argv, "ig:")) != -1)
{
switch (c)
{
case 'g':
globalscriptflag = 1;
globalscript = optarg;
break;
case 'i':
infoflag = 1;
break;
default:
usage(argv[0]);
}
}
if (argv[optind] != NULL)
{
f = fopen(argv[optind], "r");
if (f == NULL)
{
fprintf(stderr, "Couldn't open %s file to parse\n", argv[optind]);
perror("Error:");
exit(1);
}
} else {
fprintf(stderr, "Need file name to open\n");
exit(1);
}
if (globalscriptflag != 0)
{
if (infoflag == 1)
{
if (Tcl_VarEval(interp, "info_head ", globalscript, NULL) == TCL_ERROR)
{
fprintf(stderr, "Error: %s\n", interp->result);
exit(1);
}
}
if (Tcl_EvalFile(interp, globalscript) == TCL_ERROR)
{
fprintf(stderr, "Couldn't open GlobaScript file %s.\n", globalscript);
exit(1);
}
if (infoflag == 1)
{
if (Tcl_Eval(interp, "info_tail") == TCL_ERROR)
{
fprintf(stderr, "Error: %s\n", interp->result);
exit(1);
}
}
}
Tcl_EvalFile(interp, TESTDTCL_TCL);
namespacePrologue = Tcl_NewStringObj("namespace eval request { }", -1);
if (Tcl_EvalObj(interp, namespacePrologue) == TCL_ERROR)
{
fprintf(stderr, "Could not create request namespace\n");
exit(1);
}
#define INIT_OUTBUF "namespace eval request { hputs {\n"
outbuf = Tcl_NewStringObj(INIT_OUTBUF, -1);
while ((ch = getc(f)) != EOF)
{
if (!inside)
{
if (ch == -1)
if (ferror(f))
{
fprintf(stderr,
"Encountered error in mod_dtcl getchar routine while reading %s", argv[1]);
exit(1);
}
c = ch;
if (c == strstart[p])
{
if (( ++p ) == l)
{
Tcl_AppendToObj(outbuf, "}\n", 2);
inside = 1;
p = 0;
continue;
}
} else {
Tcl_AppendToObj(outbuf, (char *)strstart, p);
if (c == '}')
Tcl_AppendToObj(outbuf, "}", -1);
else if ( c == '{')
Tcl_AppendToObj(outbuf, "{", -1);
else
Tcl_AppendToObj(outbuf, (char *)&c, 1);
p = 0;
continue;
}
} else {
if (ch == -1)
if (ferror(f))
{
fprintf(stderr,
"Encountered error in mod_dtcl getchar routine while reading %s",
argv[1]);
exit(1);
}
c = ch;
if (c == strend[p])
{
if ((++p) == l2)
{
inside = 0;
Tcl_AppendToObj(outbuf, "\n hputs {", -1);
p = 0;
continue;
}
}
else
{
Tcl_AppendToObj(outbuf, (char *)strend, p);
Tcl_AppendToObj(outbuf, (char *)&c, 1);
p = 0;
}
}
}
if (!inside)
{
Tcl_AppendToObj(outbuf, "}", 1);
}
Tcl_AppendToObj(outbuf, "\n}\nnamespace delete request\n", -1);
if (infoflag == 1)
{
if (Tcl_VarEval(interp, "info_head ", argv[optind], NULL) == TCL_ERROR)
{
fprintf(stderr, "Error: %s\n", interp->result);
exit(1);
}
}
if (Tcl_EvalObj(interp, outbuf) == TCL_ERROR)
{
char *errorinfo;
errorinfo = Tcl_GetVar(interp, "errorInfo", 0);
fputs(ER1, stderr);
fputs(errorinfo, stderr);
fputs("</xmp><b>OUTPUT BUFFER</b><xmp>", stderr);
fputs(Tcl_GetStringFromObj(outbuf, (int *)NULL), stderr);
fputs(ER2, stderr);
}
if (infoflag == 1)
{
if (Tcl_Eval(interp, "info_tail ") == TCL_ERROR)
{
fprintf(stderr, "Error: %s\n", interp->result);
exit(1);
}
}
}
void usage(char *binname)
{
fprintf(stderr, "Usage: %s [-i] [-g globalscript] ttml_file\n", binname);
exit(1);
}