X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fwtcl.c;h=7ee01ddd37805abd7829991becf509d8ca15d1e5;hb=9f5629c93687790acce8ef189cfac986f3c2d2e6;hp=f8273cbdab1c6d7aec7317146c8003b51433f2a9;hpb=4a4288c5b72d694c1ca2c1c08926d1e10f01cc48;p=egate.git diff --git a/www/wtcl.c b/www/wtcl.c index f8273cb..7ee01dd 100644 --- a/www/wtcl.c +++ b/www/wtcl.c @@ -41,7 +41,35 @@ * USE OR PERFORMANCE OF THIS SOFTWARE. * * $Log: wtcl.c,v $ - * Revision 1.6 1995/10/31 10:03:54 adam + * Revision 1.14 1996/05/21 14:53:04 adam + * Tcl command wform extented; options -raw and -exists added. + * + * Revision 1.13 1996/03/14 11:48:40 adam + * New function egw_prog that returns name of shell. + * + * Revision 1.12 1996/03/07 12:45:34 adam + * New Tcl calls egw_enc/egw_dec to encode/decode binary URL info. + * + * Revision 1.11 1996/01/24 08:26:56 adam + * All tcl commands prefixed with egw_ (except the html command). + * + * Revision 1.10 1995/11/08 16:14:35 adam + * Many improvements and bug fixes. + * First version that ran on dtbsun. + * + * Revision 1.9 1995/11/07 14:57:00 adam + * Work on search in multiple targets. + * New wtcl command: wlog. + * Optional timeout parameter to zwait. + * + * Revision 1.8 1995/11/06 17:44:23 adam + * State reestablised when shell restarts. History of previous + * result sets. + * + * Revision 1.7 1995/10/31 16:56:25 adam + * Record presentation. + * + * Revision 1.6 1995/10/31 10:03:54 adam * Work on queries. * New command implemented - aborts script. * @@ -75,11 +103,15 @@ static void *do_create (WCLIENT wcl, void *args); static int do_exec (const char *fname, char *parms, void *mydata); +static int do_load (char *parms, void *mydata); +static int do_save (char *parms, void *mydata); static struct w_interp_type w_interp_t = { "tcl", do_create, - do_exec + do_exec, + do_load, + do_save }; W_Interp_Type w_interp_tcl = &w_interp_t; @@ -115,43 +147,75 @@ static int proc_wabort_invoke (ClientData clientData, Tcl_Interp *interp, struct tcl_info *p = (struct tcl_info*) clientData; p->wabort = 1; + if (argc > 1) + Tcl_AppendResult (interp, argv[1], NULL); return TCL_RETURN; } -static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +static int proc_wflush_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) { struct tcl_info *p = (struct tcl_info*) clientData; - int i; - for (i = 1; iwcl, argv[i]); + wo_flush (p->wcl); return TCL_OK; } -static int proc_htmlr_invoke (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) { struct tcl_info *p = (struct tcl_info*) clientData; - int r; + int i; - r = proc_html_invoke (clientData, interp, argc, argv); - wo_putc (p->wcl, '\n'); - return r; + for (i = 1; iwcl, argv[i], strlen(argv[i])); + return TCL_OK; } -static int proc_form_invoke (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +static int proc_wform_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) { struct tcl_info *p = (struct tcl_info*) clientData; + const char *arg = NULL; + int failFlag = 0; int i; - if (argc == 2) + + if (argc == 3) { - Tcl_AppendResult (p->interp, wgetval (p->wcl, argv[1]), NULL); + if (!strcmp (argv[1], "-raw")) + { + interp->result = p->wcl->raw_data; + return TCL_OK; + } + else if (!strcmp (argv[1], "-exists")) + { + failFlag = 1; + arg = argv[2]; + } + else + { + Tcl_AppendResult (p->interp, "bad option to ", argv[0], + " \"", argv[1], "\"", NULL); + return TCL_ERROR; + } + } + else if (argc == 2) + arg = argv[1]; + if (arg) + { + for (i = 0; *p->wcl->wf_data[i].name; i++) + if (!strcmp (arg, p->wcl->wf_data[i].name) && + *p->wcl->wf_data[i].value) + Tcl_AppendElement (p->interp, p->wcl->wf_data[i].value); + if (failFlag) + { + Tcl_AppendResult (p->interp, arg, " doesn't exist", NULL); + return TCL_ERROR; + } return TCL_OK; } for (i = 0; *p->wcl->wf_data[i].name; i++) - { + { Tcl_AppendResult (p->interp, "{ ", NULL); Tcl_AppendElement (p->interp, p->wcl->wf_data[i].name); Tcl_AppendElement (p->interp, p->wcl->wf_data[i].value); @@ -160,6 +224,117 @@ static int proc_form_invoke (ClientData clientData, Tcl_Interp *interp, return TCL_OK; } +static int proc_wlog_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + unsigned mask; + + if (argc < 3) + return TCL_OK; + if (!strcmp (argv[1], "debug")) + mask = GW_LOG_DEBUG; + else if (!strcmp (argv[1], "fatal")) + mask = GW_LOG_FATAL; + else if (!strcmp (argv[1], "warn")) + mask = GW_LOG_WARN; + else if (!strcmp (argv[1], "acct")) + mask = GW_LOG_ACCT; + else + mask = GW_LOG_DEBUG; + switch (argc) + { + case 3: + gw_log (mask, mod, "%s", argv[2]); + break; + case 4: + gw_log (mask, mod, "%s %s", argv[2], argv[3]); + break; + case 5: + gw_log (mask, mod, "%s %s %s", argv[2], argv[3], argv[4]); + break; + case 6: + gw_log (mask, mod, "%s %s %s %s", argv[2], argv[3], argv[4], argv[5]); + break; + } + return TCL_OK; +} + +static int proc_enc (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int i; + char buf1[4]; + char buf2[2]; + + buf1[0] = '%'; + buf2[1] = '\0'; + for (i = 1; i= 127 || *cp == '/' || *cp == ' ' || + *cp == '&' || *cp == ':' || *cp == '%') + { + sprintf (buf1+1, "%02X", *cp); + Tcl_AppendResult (interp, buf1, NULL); + } + else + { + buf2[0] = *cp; + Tcl_AppendResult (interp, buf2, NULL); + } + cp++; + } + } + return TCL_OK; +} + +static int proc_dec (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int i; + unsigned val; + char buf[2]; + + buf[1] = '\0'; + for (i = 1; i= 'A') + val = cp[1] - 'A'+10; + else + val = cp[1] - '0'; + + + if (cp[2] >= 'A') + val = val*16 + (cp[2] - 'A'+10); + else + val = val*16 + (cp[2] - '0'); + buf[0] = val; + cp += 3; + } + else + buf[0] = *cp++; + Tcl_AppendResult (interp, buf, NULL); + } + } + return TCL_OK; +} + +static int proc_prog (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + struct tcl_info *p = (struct tcl_info*) clientData; + + Tcl_AppendResult (p->interp, p->wcl->prog, NULL); + return TCL_OK; +} + int Tcl_AppInit (Tcl_Interp *interp) { if (Tcl_Init (interp) == TCL_ERROR) @@ -191,9 +366,13 @@ static void *do_create (WCLIENT wcl, void *args) } Tcl_AppInit (p->interp); Tcl_CreateCommand (p->interp, "html", proc_html_invoke, p, NULL); - Tcl_CreateCommand (p->interp, "htmlr", proc_htmlr_invoke, p, NULL); - Tcl_CreateCommand (p->interp, "form", proc_form_invoke, p, NULL); - Tcl_CreateCommand (p->interp, "wabort", proc_wabort_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_form", proc_wform_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_abort", proc_wabort_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_flush", proc_wflush_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_log", proc_wlog_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_enc", proc_enc, p, NULL); + Tcl_CreateCommand (p->interp, "egw_dec", proc_dec, p, NULL); + Tcl_CreateCommand (p->interp, "egw_prog", proc_prog, p, NULL); sprintf (tmp_str, "%d", wcl->id); Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY); return p; @@ -202,6 +381,8 @@ static void *do_create (WCLIENT wcl, void *args) static void report_error (struct tcl_info *p, int errorLine, const char *pre, const char *msg) { + if (!msg) + msg = ""; gw_log (GW_LOG_WARN, mod, "%s %d %s", pre, errorLine, msg); wo_printf (p->wcl, "\n
\n" "%s %d
\n", pre, errorLine); @@ -320,3 +501,37 @@ static int do_exec (const char *fname, char *parms, void *mydata) fclose (inf); return 0; } + + +static int do_load (char *parms, void *mydata) +{ + struct tcl_info *p = mydata; + char fname[80]; + int r; + + sprintf (fname, "tcl.state.%d", p->wcl->id); + r = Tcl_EvalFile (p->interp, fname); + if (r == TCL_ERROR) + gw_log (GW_LOG_WARN, mod, "Cannot load Tcl state" ); + return 0; +} + +static int do_save (char *parms, void *mydata) +{ + struct tcl_info *p = mydata; + struct Tcl_CmdInfo cinfo; + + if (Tcl_GetCommandInfo(p->interp, "saveState", &cinfo)) + { + int r; + + gw_log (GW_LOG_DEBUG, mod, "saveState"); + r = Tcl_Eval (p->interp, "saveState\n"); + if (r == TCL_ERROR) + report_error (p, p->interp->errorLine, + "Error in Tcl saveState in line", + Tcl_GetVar (p->interp, "errorInfo", 0)); + } + return 0; +} +