/* testdtcl.c - test a dtcl script */
/* Copyright David Welton 1999 */
/* This software may be used and distributed under the terms of the
   GNU GPL */

/* $Id: testdtcl.c,v 1.4.2.1 1999/12/06 05:26:28 davidw Exp $ */

/* This program is out of date as of Jul 29 1999 - davidw

   Ideally, mod_dtcl.c will be pulled apart so that code can be
   shared.
*/

#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);
    }

    /* we delay this so that we can do "debugging" (look at globals, procs, etc) */
    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)
    {
	/* ok, if we find the string, then we start on another loop    */
	/*            if (!find_string(f, STARTING_SEQUENCE, r))  */
	if (!inside)
	{
	    /* OUTSIDE  */
	    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)
		{
		    /* ok, we have matched the whole ending sequence - do something  */
		    Tcl_AppendToObj(outbuf, "}\n", 2);
		    inside = 1;
		    p = 0;
		    continue;
		}
	    } else {
		Tcl_AppendToObj(outbuf, (char *)strstart, p);
		/* or else just put the char in outbuf  */
		if (c == '}')
		    Tcl_AppendToObj(outbuf, "&#125;", -1);
		else if ( c == '{')
		    Tcl_AppendToObj(outbuf, "&#123;", -1);
		else
		    Tcl_AppendToObj(outbuf, (char *)&c, 1);

		p = 0;
		continue;
	    }
	} else {
	    /* 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 == strend[p])
	    {
		if ((++p) == l2)
		{
		    inside = 0;
		    Tcl_AppendToObj(outbuf, "\n hputs {", -1);
		    p = 0;
		    continue;
		}
	    }
	    else
	    {
		/*  plop stuff into outbuf, which we will then eval   */
		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);
}