/* * 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$ */ /* Rivet config */ #ifdef HAVE_CONFIG_H #include #endif #include #include #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; 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; 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; 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 (*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; }