/*
 * Rivet parser.
 *
 * Contains functions for loading up Tcl scripts either in flat Tcl
 * files, or in Rivet .rvt files.
 *
 */

/* Copyright 2002-2004 The Apache Software Foundation

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

        http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
*/

/* $Id: rivetParser.c 1518826 2013-08-29 21:20:38Z mxmanghi $ */

/* Rivet config */
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#include <string.h>
#include <tcl.h>
#include "rivetParser.h"

int Rivet_Parser(Tcl_Obj *outbuf, Tcl_Obj *inbuf);

/*
 *-----------------------------------------------------------------------------
 *
 * Rivet_GetTclFile --
 *
 * Takes a filename, an outbuf to fill in with a Tcl script, and a
 * TclWebRequest.  Fills in outbuf with a Tcl script.
 *
 *-----------------------------------------------------------------------------
 */

int
Rivet_GetTclFile(char *filename, Tcl_Obj *outbuf, Tcl_Interp *interp)
{
    int result = 0;

    /* Taken, in part, from tclIOUtil.c out of the Tcl distribution,
     * and modified.
     */

    Tcl_Channel chan = Tcl_OpenFileChannel(interp, filename, "r", 0644);
    if (chan == (Tcl_Channel) NULL)
    {
        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, "couldn't read file \"", filename,
                         "\": ", Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
    result = Tcl_ReadChars(chan, outbuf, -1, 1);
    if (result < 0)
    {
        Tcl_Close(interp, chan);
        Tcl_AppendResult(interp, "couldn't read file \"", filename,
                         "\": ", Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }

    if (Tcl_Close(interp, chan) != TCL_OK)
        return TCL_ERROR;

    return TCL_OK;
}


/*
 *-----------------------------------------------------------------------------
 *
 * Rivet_GetRivetFile --
 *
 * Takes a filename, a flag to indicate whether we are operating at
 * the top level (not from within the "parse" command), a buffer to
 * fill in, and a TclWebRequest.  Fills in outbuf with a parsed Rivet
 * .rvt file, creating a Tcl script ready for execution.
 *
 *-----------------------------------------------------------------------------
 */

int
Rivet_GetRivetFile(char *filename, int toplevel,
        Tcl_Obj *outbuf, Tcl_Interp *interp)
{
    int sz = 0;
    Tcl_Obj *inbuf;
    Tcl_Channel rivetfile;

    /*
     * TODO There is much switching between Tcl and APR for calling
     * utility routines. We should make up our minds and keep
     * a coherent attitude deciding when Tcl should be called upon
     * and when APR should be invoked instead for a certain class of
     * tasks
     */

    rivetfile = Tcl_OpenFileChannel(interp, filename, "r", 0664);
    if (rivetfile == NULL) {
        /* Don't need to adderrorinfo - Tcl_OpenFileChannel takes care
           of that for us. */
        return TCL_ERROR;
    }

    if (toplevel) {
        Tcl_AppendToObj(outbuf, "namespace eval request {\n", -1);
    } else {
        Tcl_SetStringObj(outbuf, "", -1);
    }
    Tcl_AppendToObj(outbuf, "puts -nonewline \"", -1);

    inbuf = Tcl_NewObj();
    Tcl_IncrRefCount(inbuf);
    sz = Tcl_ReadChars(rivetfile, inbuf, -1, 0);

    Tcl_Close(interp, rivetfile);
    if (sz == -1)
    {
        Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
        Tcl_DecrRefCount(inbuf);
        return TCL_ERROR;
    }

    /* If we are not inside a <? ?> section, add the closing ". */
    if (Rivet_Parser(outbuf, inbuf) == 0)
    {
        Tcl_AppendToObj(outbuf, "\"\n", 2);
    }

    if (toplevel)
    {
        Tcl_AppendToObj(outbuf, "\n}", -1);
    }
    Tcl_AppendToObj(outbuf, "\n", -1);

    Tcl_DecrRefCount(inbuf);
    /* END PARSER  */
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * Rivet_Parser --
 *
 * Parses data (from .rvt file) in inbuf and creates resulting script
 * in outbuf.
 *
 * Results:
 *
 * Returns 'inside' - whether we were still inside a block of Tcl code
 * or not, when the parser hit the end of the data.
 *
 *-----------------------------------------------------------------------------
 */

int
Rivet_Parser(Tcl_Obj *outbuf, Tcl_Obj *inbuf)
{
    char *next;
    char *cur;
    const char *strstart = START_TAG;
    const char *strend = END_TAG;

    int endseqlen = strlen(END_TAG);
    int startseqlen = strlen(START_TAG);
    int inside = 0, p = 0, check_echo = 0;
    int inLen = 0;

    next = Tcl_GetStringFromObj(inbuf, &inLen);

    if (inLen == 0)
        return 0;

    while (*next != 0)
    {
        cur = next;
        next = (char *)Tcl_UtfNext(cur);
        if (!inside)
        {
            /* Outside the delimiting tags. */
            if (*cur == strstart[p])
            {
                if ((++p) == startseqlen)
                {
                    /* We have matched the whole ending sequence. */
                    Tcl_AppendToObj(outbuf, "\"\n", 2);
                    inside = 1;
                    check_echo = 1;
                    p = 0;
                    continue;
                }
            } else {
                if (p > 0) {
                    Tcl_AppendToObj(outbuf, (char *)strstart, p);
                    p = 0;
                }
                /* or else just put the char in outbuf  */
                switch (*cur)
                {
                    case '{':
                        Tcl_AppendToObj(outbuf, "\\{", 2);
                        break;
                    case '}':
                        Tcl_AppendToObj(outbuf, "\\}", 2);
                        break;
                    case '$':
                        Tcl_AppendToObj(outbuf, "\\$", 2);
                        break;
                    case '[':
                        Tcl_AppendToObj(outbuf, "\\[", 2);
                        break;
                    case ']':
                        Tcl_AppendToObj(outbuf, "\\]", 2);
                        break;
                    case '"':
                        Tcl_AppendToObj(outbuf, "\\\"", 2);
                        break;
                    case '\\':
                        Tcl_AppendToObj(outbuf, "\\\\", 2);
                        break;
                    default:
                        Tcl_AppendToObj(outbuf, cur, next - cur);
                        break;
                }
                continue;
            }
        } else {
            /* Inside the delimiting tags. */

            if (check_echo)
            {
                check_echo = 0;
                if (*cur == '=') {
                    Tcl_AppendToObj(outbuf, "\nputs -nonewline ", -1);
                    continue;
                }
            }

            if (*cur == strend[p])
            {
                if ((++p) == endseqlen)
                {
                    Tcl_AppendToObj(outbuf, "\nputs -nonewline \"", -1);
                    inside = 0;
                    p = 0;
                }
            } else {
                /* Plop stuff into outbuf, which we will then eval. */
                if (p > 0) {
                    Tcl_AppendToObj(outbuf, (char *)strend, p);
                    p = 0;
                }
                Tcl_AppendToObj(outbuf, cur, next - cur);
            }
        }
    }

    //fprintf (stderr, "content:\n%s\n", Tcl_GetString(outbuf));
    //fflush (stderr);

    return inside;
}

