/*
tclsql.c --
sql commands for informix database support
*/

#ifndef lint
static char rcsid[] = "$Header: /u/kumar/:w/RCS/tclsql.c,v 1.1 1993/06/17 17:41:50 kumar Exp kumar $ SPRITE (Berkeley)";
#endif

#include "stdio.h"
#include "stdlib.h"
#include "string.h"
#include "tcl.h"
#include "tk.h"

#define add_command(cmdname, procname)  \
    Tcl_CreateCommand(interp,cmdname,procname,(ClientData) w,(void (*)()) NULL);

int
tcl_sql_run(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    char *sql_geterror();
    int ret;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    stmt = argv[0];
    argc--;
    argv++;
    ret = sql_run(stmt, argc, argv);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_sql_open(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    int ret;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    stmt = argv[0];
    argc--;
    argv++;
    ret = sql_open(stmt, argc, argv);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}
int
tcl_sql_close(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    int ret;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &ret, buf) != 1) {
        Tcl_AppendResult(interp, "argument to sql_close not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    ret = sql_close(ret);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    /*sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);*/
    return TCL_OK;
}
int
tcl_sql_fetch(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    int fd, ret, retargc, dostrip;
    char **retargv, **sql_values();
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &fd, buf) != 1) {
        Tcl_AppendResult(interp, "argument to sql_fetch not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    if (argc >= 2 && argv[1] && sscanf(argv[1], "%d", &ret) == 1 && ret == 1)
        dostrip = 1;
    else dostrip = 0;
    ret = sql_fetch(fd);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    if (ret == 0) {
        retargv = sql_values(fd, &retargc, dostrip);
        if (!retargv) {
            Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
            "\"", (char *) NULL);
            return TCL_ERROR;
        }
        interp->result = Tcl_Merge(retargc, retargv);
        interp->freeProc = (Tcl_FreeProc *) free;
        return TCL_OK;
    }
    return TCL_OK;
}
int
tcl_sql_exists(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *arg0, *table, *column, *value = NULL, *where = NULL;
    char buf[25];
    int ret;
    if (argc < 3) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " table column ?value ?where?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    table = argv[0];
    column = argv[1];
    if (argv[2]) {
        value = argv[2];
        if (argv[3])
            where = argv[3];
    }
    ret = sql_exists(table, column, value, where);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_sql_reopen(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    int ret;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &ret, buf) != 1) {
        Tcl_AppendResult(interp, "argument to sql_reopen not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    ret = sql_reopen(ret);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_sql_explain(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    int ret;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &ret, buf) != 1) {
        Tcl_AppendResult(interp, "argument to sql_explain not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    ret = sql_explain(ret);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_getenv(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    int ret;
    char *p;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    p = getenv(argv[0]);
    if (!p) p = "";
    Tcl_SetResult(interp, p, TCL_VOLATILE);
    return TCL_OK;
}

#ifdef GETDATE
int
tcl_getdate(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    int ret;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    ret = getdate(argv[0], 0L);
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}
int
tcl_fmtdate(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char *p, *newdate();
    char buf[2];
    int ret;
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " arg ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    ret = 0;
    if (argv[1]) {
        if (sscanf(argv[1], "%d%1s", &ret, buf) != 1) {
            Tcl_AppendResult(interp, "argument 2 to fmtdate not an integer ==>",
                argv[1], (char *) NULL);
            return TCL_ERROR;
        }
    }
    p = newdate(argv[0], ret);
    Tcl_SetResult(interp, p, TCL_VOLATILE);
    return TCL_OK;
}
#endif

int
tcl_sql_geterror(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *p, *sql_geterror();
    int ret;
    p = sql_geterror();
    if (!p) p = "";
    Tcl_SetResult(interp, p, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_sqlca(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    int retargc;
    char **retargv, **sql_sqlca();
    char *arg0 = argv[0];

    retargv = sql_sqlca(&retargc);
    if (!retargv) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    interp->result = Tcl_Merge(retargc, retargv);
    interp->freeProc = (Tcl_FreeProc *) free;
    return TCL_OK;
}

int
tcl_sqld(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    char buf[25];
    int ret, type_ld;
    if (argc < 3) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " <fd> <in> \"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &ret, buf) != 1) {
        Tcl_AppendResult(interp, "argument to sqld not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &type_ld, buf) != 1) {
        Tcl_AppendResult(interp, "argument 2 to sqld not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    ret = sql_sqld(ret, type_ld);
    if (ret == -2) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_sqlda(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    int retargc;
    char **retargv, **sql_sqlda();
    char *stmt, *arg0;
    char buf[25];
    int ret, fd, num, type_ld;
    if (argc < 4) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " <fd> <in> <num> \"", (char *) NULL);
        return TCL_ERROR;
    }
    arg0 = argv[0];
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &fd, buf) != 1) {
        Tcl_AppendResult(interp, "argument to sqld not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &type_ld, buf) != 1) {
        Tcl_AppendResult(interp, "argument 2 to sqld not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    argc--;
    argv++;
    if (sscanf(argv[0], "%d%1s", &num, buf) != 1) {
        Tcl_AppendResult(interp, "argument 2 to sqld not an integer ==>",
            argv[0], (char *) NULL);
        return TCL_ERROR;
    }
    retargv = sql_sqlda(fd, type_ld, num, &retargc);
    if (!retargv) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    interp->result = Tcl_Merge(retargc, retargv);
    interp->freeProc = (Tcl_FreeProc *) free;
    return TCL_OK;
}

int
tcl_sql_getdatabase(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *p, *sql_getdatabase();
    int ret;
    p = sql_getdatabase();
    if (!p) p = "";
    Tcl_SetResult(interp, p, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_sql_finish(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *p, *sql_getdatabase();
    int ret;
    char buf[25];

    ret = sql_finish();
    sprintf(buf, "%d", ret);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

int
tcl_sql_database(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    char *stmt, *arg0;
    int ret;
    char *p = NULL;
    char buf[25];

    arg0 = argv[0];
    if (argc >= 2) p = argv[1];
    ret = sql_database(p);
    if (ret < 0) {
        Tcl_AppendResult(interp, "\"", arg0, ":", sql_geterror(), 
        "\"", (char *) NULL);
        return TCL_ERROR;
    }
    sprintf(buf, "%d", ret);

    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

int
tkwarp(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    int dest_x, dest_y, seq;

    if (argc < 3) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
            argv[0], " dest_x dest_y \"", (char *)NULL);
        return TCL_ERROR;
    }
    if (argv[1][0] == '-' && argv[1][1] == 'a') seq = 2;
    else seq = 1;
    if (Tcl_GetInt(interp, argv[seq], &dest_x) != TCL_OK ||
        Tcl_GetInt(interp, argv[seq+1], &dest_y) != TCL_OK) {
        return TCL_ERROR;
    }
    if (seq == 2) 
        XWarpPointer(Tk_Display(dummy), None, None, 0, 0, 0, 0, -9999, -9999);
    if (XWarpPointer(Tk_Display(dummy), None, None, 0, 0, 0, 0,
            dest_x, dest_y) == BadWindow) {
        Tcl_AppendResult(interp, "Bad window error to tkwarp", (char *)NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_BellCmd --
 *
 *      This procedure is invoked to process the "bell" Tcl command.
 *      See the user documentation for details on what it does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
int
Tk_BellCmd(clientData, interp, argc, argv)
    ClientData clientData;      /* Main window associated with
                                 * interpreter.*/
    Tcl_Interp *interp;         /* Current interpreter. */
    int argc;                   /* Number of arguments. */
    char **argv;                /* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    int percent;

    if (argc == 1) {
        percent = 50;
    } else if (argc == 2) {
        if ((Tcl_GetInt(interp, argv[1], &percent) != TCL_OK)
            || (percent < -100) || (percent > 100)) {
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "bad volume percentage value \"",
                             argv[1], "\"", (char *) NULL);
            return TCL_ERROR;
        }
    } else {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                         argv[0], " ?volumePercent?\"", (char *) NULL);
        return TCL_ERROR;
    }

    XBell(Tk_Display(tkwin), percent);
    return TCL_OK;
}

tcl_add_commands(interp, w)  
    Tcl_Interp *interp;
    Tk_Window w;
{
    add_command("sql_run",          tcl_sql_run);
    add_command("sql_open",         tcl_sql_open);
    add_command("sql_close",        tcl_sql_close);
    add_command("sql_fetch",        tcl_sql_fetch);
    add_command("sql_exists",       tcl_sql_exists);
    add_command("sql_reopen",       tcl_sql_reopen);
    add_command("sql_explain",      tcl_sql_explain);
    add_command("sql_geterror",     tcl_sql_geterror);
    add_command("sqlca",            tcl_sqlca);
    add_command("sqlda",            tcl_sqlda);
    add_command("sqld",             tcl_sqld);
    add_command("getenv",           tcl_getenv);
    add_command("sql_database",     tcl_sql_database);
    add_command("sql_getdatabase",  tcl_sql_getdatabase);
    add_command("sql_finish",       tcl_sql_finish);
#ifdef GETDATE
    add_command("getdate",          tcl_getdate);
    add_command("fmtdate",          tcl_fmtdate);
#endif
    add_command("tkwarp",           tkwarp);
    add_command("bell",             Tk_BellCmd);
}

