You are viewing a plain text version of this content. The canonical link for it is here.
Posted to mod_dtcl@tcl.apache.org by Valerio Gionco <va...@most.it> on 2001/06/04 12:16:59 UTC
Tcl error control - patch for mod_dtcl - replay (sorry)
Here are the patches for mod_dtcl.c and mod_dtcl.h,
against mod_dtcl 0.11.0. (with diff -u)
--
Valerio Gionco [valerio@most.it]
MOST s.r.l. Via Bezzecca, 9 - 10131 Torino
************************************************************************
"Life's not fair, but the root password helps."
-----------------diff -u mod_dtcl.h mod_dtcl_patched.h
------------------------------
--- mod_dtcl.h Mon Jun 4 12:11:33 2001
+++ mod_dtcl_patched.h Mon Jun 4 11:42:46 2001
@@ -57,13 +57,13 @@
int memwrite(obuff *, char *, int);
int send_content(request_rec *);
int send_parsed_file(request_rec *, char *, struct stat*, int);
+int execute_and_check(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec
*r);
int send_tcl_file(request_rec *, char *, struct stat*);
int set_header_type(request_rec *, char *);
int print_headers(request_rec *);
int print_error(request_rec *, int, char *);
int flush_output_buffer(request_rec *);
void tcl_init_stuff(server_rec *s, pool *p);
-
char *StringToUtf(char *input);
/* Macro to Tcl Objectify StringToUtf stuff */
-----------------diff -u mod_dtcl.c
mod_dtcl_patched.c------------------------------
--- mod_dtcl.c Mon Jun 4 12:11:33 2001
+++ mod_dtcl_patched.c Mon Jun 4 11:31:52 2001
@@ -425,9 +425,9 @@
return TCL_ERROR;
end:
- Tcl_EvalObj(interp, (cmdObjPtr));
+ execute_and_check(interp, (cmdObjPtr), r);
} else {
- Tcl_EvalObj(interp, (Tcl_Obj *)Tcl_GetHashValue(entry));
+ execute_and_check(interp, (cmdObjPtr), r);
}
#else
Tcl_EvalFile(interp, r->filename);
@@ -639,30 +639,43 @@
return OK;
#endif
+ return(execute_and_check(interp, outbuf, r));
+}
+
+/* Calls Tcl_EvalObj() and checks for errors; prints the error buffer
if any. */
+int execute_and_check(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec
*r)
+{
+ char *errorinfo;
+ dtcl_server_conf *dsc = NULL;
+
+ dsc = (dtcl_server_conf *)
ap_get_module_config(r->server->module_config, &dtcl_module);
+
if (Tcl_EvalObj(interp, outbuf) == TCL_ERROR)
- {
- print_headers(global_rr);
- flush_output_buffer(global_rr);
- if (dsc->dtcl_error_script)
- {
- if (Tcl_EvalObj(interp, dsc->dtcl_error_script) ==
TCL_ERROR)
- print_error(r, 1, "<b>Tcl_ErrorScript failed!</b>");
- } else {
- /* default action */
- errorinfo = Tcl_GetVar(interp, "errorInfo", 0);
- print_error(r, 0, errorinfo);
- print_error(r, 1, "<p><b>OUTPUT BUFFER:</b></p>");
- print_error(r, 0, Tcl_GetStringFromObj(outbuf, (int
*)NULL));
- }
-/* "</pre><b>OUTPUT BUFFER</b><pre>\n",
- Tcl_GetStringFromObj(outbuf, (int *)NULL)); */
+ {
+ print_headers(global_rr);
+ flush_output_buffer(global_rr);
+ if (dsc->dtcl_error_script)
+ {
+ if (Tcl_EvalObj(interp, dsc->dtcl_error_script) ==
TCL_ERROR)
+ print_error(r, 1, "<b>Tcl_ErrorScript failed!</b>");
+ } else {
+ /* default action */
+ errorinfo = Tcl_GetVar(interp, "errorInfo", 0);
+ print_error(r, 0, errorinfo);
+ print_error(r, 1, "<p><b>OUTPUT BUFFER:</b></p>");
+ print_error(r, 0, Tcl_GetStringFromObj(outbuf, (int
*)NULL));
+ }
+/* "</pre><b>OUTPUT BUFFER</b><pre>\n",
+ Tcl_GetStringFromObj(outbuf, (int *)NULL)); */
} else {
- /* We make sure to flush the output if buffer_add was the only
output */
- print_headers(global_rr);
- flush_output_buffer(global_rr);
+ /* We make sure to flush the output if buffer_add was the only
output */
+ print_headers(global_rr);
+ flush_output_buffer(global_rr);
}
return OK;
}
+
+
/* Set things up to execute a file, then execute */