You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by da...@apache.org on 2002/07/20 00:36:19 UTC
cvs commit: tcl-rivet/tests/apachetest apachetest.tcl
davidw 2002/07/19 15:36:19
Modified: . ChangeLog
src rivetCore.c
src/buildscripts aardvark.tcl
tests upload.rvt
tests/apachetest apachetest.tcl
Log:
* src/buildscripts/aardvark.tcl (aardvark::runbuildcommand): Attempt
to use 'open' to execute shell commands, in order to both catch the
output as well as the return code.
* doc/rivet.xml: New file. Removed directives.xml in favor of this,
which we will use to build individual HTML files and other forms of
documentation.
Revision Changes Path
1.62 +15 -0 tcl-rivet/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /home/cvs/tcl-rivet/ChangeLog,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- ChangeLog 15 Jul 2002 06:18:48 -0000 1.61
+++ ChangeLog 19 Jul 2002 22:36:19 -0000 1.62
@@ -1,3 +1,18 @@
+2002-07-19 David N. Welton <da...@dedasys.com>
+
+ * src/buildscripts/aardvark.tcl (aardvark::runbuildcommand):
+ Attempt to use 'open' to execute shell commands, in order to both
+ catch the output as well as the return code.
+
+ * doc/rivet.xml: New file. Removed directives.xml in favor of
+ this, which we will use to build individual HTML files and other
+ forms of documentation.
+
+2002-07-18 David N. Welton <da...@dedasys.com>
+
+ * src/rivetCore.c (Rivet_Upload): Changed format of 'upload'
+ command to be more like 'var'. Changed relevant tests.
+
2002-07-14 David N. Welton <da...@dedasys.com>
* doc/directives.xml: New file - XML version of directives.html.
1.25 +163 -146 tcl-rivet/src/rivetCore.c
Index: rivetCore.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivetCore.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- rivetCore.c 12 Jul 2002 17:40:37 -0000 1.24
+++ rivetCore.c 19 Jul 2002 22:36:19 -0000 1.25
@@ -75,11 +75,11 @@
filename = Tcl_GetStringFromObj( objv[1], (int *)NULL );
} else {
if( !STREQU( Tcl_GetStringFromObj(objv[1], (int *)NULL), "-virtual") ) {
- Tcl_WrongNumArgs( interp, 1, objv, "?-virtual? filename" );
- return TCL_ERROR;
+ Tcl_WrongNumArgs( interp, 1, objv, "?-virtual? filename" );
+ return TCL_ERROR;
}
filename = TclWeb_GetVirtualFile( globals->req,
- Tcl_GetStringFromObj(objv[2], (int *)NULL) );
+ Tcl_GetStringFromObj(objv[2], (int *)NULL) );
}
if (!strcmp(filename, globals->r->filename))
@@ -126,11 +126,11 @@
filename = Tcl_GetStringFromObj( objv[1], (int *)NULL );
} else {
if( !STREQU( Tcl_GetStringFromObj(objv[1], (int *)NULL), "-virtual") ) {
- Tcl_WrongNumArgs( interp, 1, objv, "?-virtual? filename" );
- return TCL_ERROR;
+ Tcl_WrongNumArgs( interp, 1, objv, "?-virtual? filename" );
+ return TCL_ERROR;
}
filename = TclWeb_GetVirtualFile( globals->req,
- Tcl_GetStringFromObj(objv[2], (int *)NULL) );
+ Tcl_GetStringFromObj(objv[2], (int *)NULL) );
}
fd = Tcl_OpenFileChannel(interp, filename, "r", 0664);
@@ -172,7 +172,7 @@
if (globals->req->headers_printed != 0)
{
Tcl_AddObjErrorInfo(interp,
- "Cannot manipulate headers - already sent", -1);
+ "Cannot manipulate headers - already sent", -1);
return TCL_ERROR;
}
opt = Tcl_GetStringFromObj(objv[1], NULL);
@@ -294,7 +294,7 @@
var names
var number
var all
- */
+*/
static int
Rivet_Var(
@@ -386,7 +386,7 @@
} else {
/* bad command */
Tcl_AddErrorInfo(interp, "bad option: must be one of "
- "'get, list, names, number, all'");
+ "'get, list, names, number, all'");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, result);
@@ -395,24 +395,14 @@
}
/*
-upload get XYZ
- channel # returns channel
- save (name) # returns name?
- data # returns data
-
-with the third one reporting an error if this hasn't been enabled, or
-the first two if it has.
-
-upload info XYZ
-
- exists
- size
- type
- filename
-
-upload names
-
-gets all the upload names.
+ upload channel uploadname
+ upload save name uploadname
+ upload data uploadname
+ upload exists uploadname
+ upload size uploadname
+ upload type uploadname
+ upload filename uploadname
+ upload names
*/
static int
@@ -422,105 +412,132 @@
int objc,
Tcl_Obj *CONST objv[])
{
+ char *varname = NULL;
char *command = NULL;
+
+ int subcommandindex;
+
Tcl_Obj *result = NULL;
- rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
- if (objc < 2 || objc > 5)
- {
- Tcl_WrongNumArgs(interp, 1, objv, "get ...|info ...|names");
- return TCL_ERROR;
- }
- command = Tcl_GetString(objv[1]);
+ static char *SubCommand[] = {
+ "channel",
+ "save",
+ "data",
+ "exists",
+ "size",
+ "type",
+ "filename",
+ "names",
+ NULL
+ };
+
+ enum subcommand {
+ CHANNEL,
+ SAVE,
+ DATA,
+ EXISTS,
+ SIZE,
+ TYPE,
+ FILENAME,
+ NAMES
+ };
- result = Tcl_NewObj();
- if (!strcmp(command, "get"))
+ rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
+ command = Tcl_GetString(objv[1]);
+ Tcl_GetIndexFromObj(interp, objv[1], SubCommand,
+ "channel|save|data|exists|size|type|filename|names",
+ 0, &subcommandindex);
+
+ /* If it's any of these, we need to find a specific name. */
+
+ /* Excluded cases are EXISTS and NAMES. */
+ if ((enum subcommand)subcommandindex == CHANNEL ||
+ (enum subcommand)subcommandindex == SAVE ||
+ (enum subcommand)subcommandindex == DATA ||
+ (enum subcommand)subcommandindex == EXISTS ||
+ (enum subcommand)subcommandindex == SIZE ||
+ (enum subcommand)subcommandindex == TYPE ||
+ (enum subcommand)subcommandindex == FILENAME)
{
- char *varname = NULL;
- if (objc < 4)
+ varname = Tcl_GetString(objv[2]);
+ if ((enum subcommand)subcommandindex != EXISTS)
{
- Tcl_WrongNumArgs(interp, 2, objv,
- "varname channel|save filename|var varname");
- return TCL_ERROR;
+ if (TclWeb_PrepareUpload(varname, globals->req) != TCL_OK)
+ {
+ Tcl_AddErrorInfo(interp, "Unable to find variable");
+ return TCL_ERROR;
+ }
}
- varname = Tcl_GetString(objv[2]);
- if (TclWeb_PrepareUpload(varname, globals->req) == TCL_OK)
+ /* If it's not the 'save' command, then it has to have an objc
+ of 3. */
+ if ((enum subcommand)subcommandindex != SAVE && objc != 3)
{
- Tcl_Channel chan;
- char *method = Tcl_GetString(objv[3]);
+ Tcl_WrongNumArgs(interp, 2, objv, "varname");
+ return TCL_ERROR;
+ }
+ }
- if (!strcmp(method, "channel"))
- {
- char *channelname = NULL;
+ result = Tcl_NewObj();
- if (TclWeb_UploadChannel(varname, &chan, globals->req) != TCL_OK) {
- return TCL_ERROR;
- }
- channelname = Tcl_GetChannelName(chan);
- Tcl_SetStringObj(result, channelname, -1);
- } else if (!strcmp(method, "save")) {
- /* save data to a specified filename */
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 4, objv, "filename");
- return TCL_ERROR;
- }
-
- if (TclWeb_UploadSave(varname, objv[4], globals->req) != TCL_OK) {
- return TCL_ERROR;
- }
- } else if (!strcmp(method, "data")) {
- if (TclWeb_UploadData(varname, result, globals->req) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- } else {
- Tcl_AddErrorInfo(interp, "variable doesn't exist");
+ switch ((enum subcommand)subcommandindex)
+ {
+ case CHANNEL: {
+ Tcl_Channel chan;
+ char *channelname = NULL;
+
+ if (TclWeb_UploadChannel(varname, &chan, globals->req) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ channelname = Tcl_GetChannelName(chan);
+ Tcl_SetStringObj(result, channelname, -1);
+ break;
+ }
+ case SAVE:
+ /* save data to a specified filename */
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "uploadname filename");
return TCL_ERROR;
}
- } else if (!strcmp(command, "info")) {
- char *varname = NULL;
- char *infotype = NULL;
- if (objc != 4)
+ if (TclWeb_UploadSave(varname, objv[4], globals->req) != TCL_OK)
{
- Tcl_WrongNumArgs(interp, 2, objv,
- "varname exists|size|type|filename");
return TCL_ERROR;
}
- varname = Tcl_GetString(objv[2]);
- infotype = Tcl_GetString(objv[3]);
-
- if (TclWeb_PrepareUpload(varname, globals->req) == TCL_OK)
+ break;
+ case DATA:
+ if (TclWeb_UploadData(varname, result, globals->req) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case EXISTS:
+ if (TclWeb_PrepareUpload(varname, globals->req) != TCL_OK)
{
- if (!strcmp(infotype, "exists"))
- {
- /* if we've made it this far, it must exist */
- Tcl_SetIntObj(result, 1);
- } else if (!strcmp(infotype, "size")) {
- TclWeb_UploadSize(result, globals->req);
- } else if (!strcmp(infotype, "type")) {
- TclWeb_UploadType(result, globals->req);
- } else if (!strcmp(infotype, "filename")) {
- TclWeb_UploadFilename(result, globals->req);
- } else {
- Tcl_AddErrorInfo(interp,"unknown upload info command, should "
- "be exists|size|type|filename");
- return TCL_ERROR;
- }
+ Tcl_SetIntObj(result, 0);
} else {
- if (!strcmp(infotype, "exists")) {
- Tcl_SetIntObj(result, 0);
- } else {
- Tcl_AddErrorInfo(interp, "variable doesn't exist");
- return TCL_ERROR;
- }
+ Tcl_SetIntObj(result, 1);
+ }
+ break;
+ case SIZE:
+ TclWeb_UploadSize(result, globals->req);
+ break;
+ case TYPE:
+ TclWeb_UploadType(result, globals->req);
+ break;
+ case FILENAME:
+ TclWeb_UploadFilename(result, globals->req);
+ break;
+ case NAMES:
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "names");
+ return TCL_ERROR;
}
- } else if (!strcmp(command, "names")) {
TclWeb_UploadNames(result, globals->req);
- } else {
- Tcl_WrongNumArgs(interp, 1, objv, "upload get|info|names");
- return TCL_ERROR;
+ break;
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "channel|save ?name?|data|exists|size|type|filename|names");
}
Tcl_SetObjResult(interp, result);
return TCL_OK;
@@ -605,55 +622,55 @@
Rivet_InitCore( Tcl_Interp *interp )
{
Tcl_CreateObjCommand(interp,
- "makeurl",
- Rivet_MakeURL,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "makeurl",
+ Rivet_MakeURL,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "headers",
- Rivet_Headers,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "headers",
+ Rivet_Headers,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "load_env",
- Rivet_LoadEnv,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "load_env",
+ Rivet_LoadEnv,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "load_headers",
- Rivet_LoadHeaders,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "load_headers",
+ Rivet_LoadHeaders,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "var",
- Rivet_Var,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "var",
+ Rivet_Var,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "upload",
- Rivet_Upload,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "upload",
+ Rivet_Upload,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "include",
- Rivet_Include,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "include",
+ Rivet_Include,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "parse",
- Rivet_Parse,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "parse",
+ Rivet_Parse,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "no_body",
- Rivet_NoBody,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "no_body",
+ Rivet_NoBody,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
- "env",
- Rivet_EnvCmd,
- NULL,
- (Tcl_CmdDeleteProc *)NULL);
+ "env",
+ Rivet_EnvCmd,
+ NULL,
+ (Tcl_CmdDeleteProc *)NULL);
TCL_OBJ_CMD( "abort_page", Rivet_AbortPageCmd );
TCL_OBJ_CMD( "virtual_filename", Rivet_VirtualFilenameCmd );
1.8 +7 -7 tcl-rivet/src/buildscripts/aardvark.tcl
Index: aardvark.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/src/buildscripts/aardvark.tcl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- aardvark.tcl 12 Jul 2002 17:40:37 -0000 1.7
+++ aardvark.tcl 19 Jul 2002 22:36:19 -0000 1.8
@@ -80,18 +80,18 @@
puts "This error occured: $err"
continue
}
- if { [info exists errorCode] } {
- unset errorCode
+ if { [info exists ::errorCode] } {
+ unset ::errorCode
}
+ set fd [eval [list open "| $sh" r]]
catch {
- eval exec $sh
+ close $fd
} err
if { $err != "" } {
puts "Output: $err"
}
- if { [info exists errorCode] && $::errorCode != "NONE" } {
- puts "\tFatal Error ($::errorCode)!"
- puts "\tError: $err"
+ if { [info exists ::errorCode] && $::errorCode != "NONE" } {
+ puts "\tFatal Error ($::errorCode) ($::errorInfo)!"
break
}
1.2 +1 -1 tcl-rivet/tests/upload.rvt
Index: upload.rvt
===================================================================
RCS file: /home/cvs/tcl-rivet/tests/upload.rvt,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- upload.rvt 23 Feb 2002 11:28:21 -0000 1.1
+++ upload.rvt 19 Jul 2002 22:36:19 -0000 1.2
@@ -1,5 +1,5 @@
<?
-puts "[ upload names ] [ upload info uploadtest exists ] [ upload info uploadtest size ] [ upload info uploadtest type ] [ upload info uploadtest filename ]"
+puts "[upload names] [upload exists uploadtest] [upload size uploadtest] [upload type uploadtest] [upload filename uploadtest]"
?>
1.4 +3 -3 tcl-rivet/tests/apachetest/apachetest.tcl
Index: apachetest.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/tests/apachetest/apachetest.tcl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- apachetest.tcl 3 May 2002 17:27:14 -0000 1.3
+++ apachetest.tcl 19 Jul 2002 22:36:19 -0000 1.4
@@ -65,11 +65,11 @@
# startserver - start the server with 'options'.
-proc apachetest::startserver { options } {
+proc apachetest::startserver { args } {
variable binname
if { [catch {
eval exec $binname -X -f \
- "[file join [pwd] server.conf]" $options
+ "[file join [pwd] server.conf]" [concat $args]
} err] } {
puts $err
}
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-dev-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-dev-help@tcl.apache.org