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

/*
    Licensed to the Apache Software Foundation (ASF) under one
    or more contributor license agreements.  See the NOTICE file
    distributed with this work for additional information
    regarding copyright ownership.  The ASF licenses this file
    to you 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 1733936 2016-03-07 15:01:09Z mxmanghi $ */

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

