#!/bin/sh
#
# This is a shell archive.  To extract its contents,
# execute this file with /bin/sh to create the file(s):
#
# Makefile	    init.c		sqlFuncs.h	    tclFuncs.c
# README		    misc.c		sqlFuncsP.ec	    tclsql.h
# README.NEW	    rcs.mk		sqlFuncsP.h	    tclsql.tlib
# TO.DO.LIST	    rules.mk		symbols.mk	    tclsqlP.h
# TclSql.doc	    sqlFuncs.ec		tclDecimal.c
#
# This shell archive created: Tue Jul 23 14:59:34 EDT 1996
#
echo "Extracting file Makefile"
sed -e 's/^X//' <<\SHAR_EOF > Makefile
X# Makefile for the tclsql library
XSHELL=/bin/sh
X
XMAKEDIR = /usr5/src/Make
X
Xinclude $(MAKEDIR)/global-vars.mk
X
X
XLIB = libtclsql.a
XTCLLIBS = tclsql.tlib
XCFILES = init.c tclFuncs.c tclDecimal.c misc.c
XECFILES = sqlFuncs.ec sqlFuncsP.ec
XHFILES = tclsql.h tclsqlP.h sqlFuncs.h sqlFuncsP.h
XSQLFILES = 
XMKFILES = rules.mk	\
X	symbols.mk
XLIBOBJS = $(LIB)(tclFuncs.o) $(LIB)(sqlFuncs.o) $(LIB)(sqlFuncsP.o) $(LIB)(init.o) $(LIB)(tclDecimal.o) $(LIB)(misc.o)
XPRJINCLDIR = .
XINCLDIR = /usr5/local/include
XADDCFLAGS = -I/usr/informix/incl
X
Xinclude $(MAKEDIR)/lib.mk
XCC = cc -O
XCFLAGS = -I/usr/informix/incl -I/usr5/local/include
XLDFLAGS=-s
X
X$(LIB)(sqlFuncs.o) :	sqlFuncs.ec $(PRJINCLDIR)/tclsql.h $(INCLDIR)/tcl.h
X$(LIB)(sqlFuncsP.o) :	sqlFuncsP.ec $(PRJINCLDIR)/tclsql.h $(INCLDIR)/tcl.h
X$(LIB)(init.o) :	init.c $(PRJINCLDIR)/tclsql.h $(INCLDIR)/tcl.h
X
X
Xinstall:
X	cp $(LIB) /usr/local/lib
X	chmod 664 /usr/local/lib/libtclsql.a
X	cp tclsql.h /usr/local/include
X	chmod 444 /usr/local/include/tclsql.h
X	cp tclsql.tlib /usr/local/tcl
X	chmod 444 /usr/local/tcl/tclsql.tlib
SHAR_EOF
if [ `wc -c < Makefile` -ne     1055 ]
then
    echo "Lengths do not match -- Bad Copy of Makefile"
fi
echo "Extracting file README"
sed -e 's/^X//' <<\SHAR_EOF > README
X# README
X#
X#  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X#
X# Program   :    TclSql library
X# File      :    README
X#
X# Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X#   By                                  5916 Glenoak Ave.
X#                                       Baltimore, MD 21214-2009
X#                                       410-254-7060
X#
X# Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X#   For          400 West Franklin Street
X#                Baltimore, MD 21201
X#                410-225-9595
X#
X# RCS        :
X# $Source: /usr5/src/tclsql/lib/RCS/README $
X# $Revision: 0.1 $
X# $Date: 1993/08/30 11:40:37 $
X#
X# $Log: README $
X# Revision 0.1  1993/08/30  11:40:37  bkuhn
X#   # initial checkin
X#
X
XSome of this source code for the sql interface to Tcl was obtained from the
XINTERNET
X
Xharbor.ecn.purdue.edu:/pub/tcl/extensions/tcl_sql.tar.Z
X
XSee the file TCLSQL.DOC in this directory for more info.
X
XDO NOT compile this with optimize.  It screws things up.
X
XP.S.
X
XI wanted this to go in the Informix Archive because a lot of work went
Xinto making this code work with Informix. In some cases it was improved
Xover what was originally posted on purdue.edu.
X
XThis posting in the archive of Tcl stuff was not meant to be a "compile
Xand go" for anybody you wanted to use it. We don't have the time or
Xdesire to do that. This stuff has been tested in a complicated production
Xenvironment and it works for us. You should get the Tcl Informix
Xcode from purdue.edu and look at it.
X
XThe "Makefile" is custom to our installation. Trying to include all of
Xit so it will work on your system is too much work. If you are interested
Xenough to be using Informix/TcL interface then should have no trouble
Xfiguring out how to compile this stuff.
X
XHow we used it. . .
X
XWe used Tcl/Informix in the following way:
X
XWe needed to do statistical calculations envolving blood typing/DNA analysis
Xfor establishing paternity. The method of doing this required a lot of
Xlist comparison. From the Informix database we created temporary tables
Xthat had sets of data that the calculation would work on.
X
XThe Tcl code did the calculation work by reading data from the temp tables
Xand putting data back into temp tables. 
X
XThis was done in 4GL by creating a Tcl Interpreter and calling it
Xwith the filename of the Tcl code. Since Tcl was linked with esql/c
Xand because it is part of the same process you get an "imbeddable language"
Xinto 4GL that works just the way Tcl was intended.
X
XMike Kuhn  mkuhn@rhlab.com, csd@clark.net
X
XBrad Kuhn  bkuhn@acm.org
SHAR_EOF
if [ `wc -c < README` -ne     2586 ]
then
    echo "Lengths do not match -- Bad Copy of README"
fi
echo "Extracting file README.NEW"
sed -e 's/^X//' <<\SHAR_EOF > README.NEW
XAs I was checking this software into the IIUG archive, I discovered that the
XTCL archive has moved to:
X
X    http://www.neosoft.com/tcl and
X    ftp://ftp.neosoft.com/pub/tcl
X
X
XWalt Hultgren
XJuly 23, 1996
SHAR_EOF
if [ `wc -c < README.NEW` -ne      203 ]
then
    echo "Lengths do not match -- Bad Copy of README.NEW"
fi
echo "Extracting file TO.DO.LIST"
sed -e 's/^X//' <<\SHAR_EOF > TO.DO.LIST
X# To Do list for Tclsql                                            -*- Text -*-
X0. free() memory
X1. a function that returns a list of the names of the rows to be returned from
X   a query.
SHAR_EOF
if [ `wc -c < TO.DO.LIST` -ne      188 ]
then
    echo "Lengths do not match -- Bad Copy of TO.DO.LIST"
fi
echo "Extracting file TclSql.doc"
sed -e 's/^X//' <<\SHAR_EOF > TclSql.doc
X#
X#   initial documentation from the INTERNET (skumar@netcom.com)
X#
X
X  [NOTE: I changed this description to fit the changes that I made.
X         I orginally got this stuff from ftp
X         harbor.ecn.purdue.edu:/pub/tcl/extensions/tcl_sql.tar.Z]
X
X    Subject: A proposal for a standard way to provide for SQL based 
X             relational database interface to TCL (with sample interface 
X             for INFORMIX).
X
X    Objective:
X            This article discusses a standard for providing database access
X            directly in TCL (without using pipes to interactive sql programs).
X
X            The syntax of the C calls which should be provided are also
X            described. Support is provided for bind variables too so that
X            sql queries need not be concatenated with values (causing problems
X            with double quoted strings etc.). A modest amount of robustness
X            is also provided against invalid input.
X
X            Thus when support is to be added for a new database (like ORACLE, 
X            SYBASE etc.), only the C code need be written.
X
X            The rest of the article is organized as follows
X            TCL CALLS 
X            EXAMPLES
X            C CALLS STANDARD
X            EXAMPLES
X            CONCLUSIONS
X
X
X    TCL Calls available
X            The following TCL calls are available -
X
X            sql:database "database"
X                opens a connection to the database specified by the argument
X                "database". If the argument is "", the the environment
X                variable DATABASE will be used
X                RETURNS integer 0 on success, non-zero on failure
X            sql:open    "sql statement" [?arg] [?arg] ..
X                opens the sql query specified and sets the bind variables
X                if specified. To see what bind variables are, look at the
X                description in C CALLS STANDARD below.
X                This command compiles the query, allocates space for the
X                return values and makes it available for execution using
X                sql:fetch.
X                RETURNS an integer (>= 0) on success, < 0 on failure
X                This return values is to be treated like an open file
X                descriptor and should be closed finally to release space.
X                This is used typically to open a select query.
X            sql:fetch ?fd [1]
X                fetches a single row of the opened fd. If an optional second 
X                argument with value 1 is specified, then the trailing blanks
X                in the list elements are removed.
X                RETURN value is a TCL list on successful fetch, the NIL list 
X                or "" when the end is reached.
X            sql:execute ?fd
X                executes a non select statement
X
X            sql:close ?fd
X                closes the compiled query and release all memory associated
X                with it
X                RETURNS 0 on success, non-zero on failure
X            sql:reopen ?fd
X                reopens the query specified by fd so that fetches may be done
X                from the start again. Uses the old parameters specified for
X                the open
X            sql:run "sql statement" [?arg] [?arg] ..
X                executes the sql query specified immediately after setting 
X                the bind variables. Useful for INSERT, UPDATE, DELETE and
X                other sql calls.
X                RETURNS 0 on success, non-zero on failure
X            sql:exists table_name column_name column_value ?optional_where
X                check for existence of column_name in table_name with
X                value column_value and optionally a where_clause.
X                RETURNS 0 on success, non-zero on failure
X                This can be used to validate values quickly without using up 
X                an fd or setting up a sql:open, sql:fetch, sql:close structure.
X            sql:explain ?fd
X                sets debug on for the query fd. This feature may be used
X                for debugging and the implementation may vary from database
X                to database. It may be used to print out queries as they are
X                executed along with the bind variables etc. The database may
X                add other options like cost of the query etc.
X                RETURNS 0 on success, non-zero on failure
X            sql:get_error
X                RETURNS a string containing a complete description of the
X                last sql error. This will include the complete text of the
X                SQL error (and ISAM error if the database uses ISAM) and the
X                complete sql statement being processed.
X
X            Advanced functions:
X            sql:sqlca
X                RETURNS a TCL list of the sqlca elements
X            sql:sqld ?fd ?type
X                RETURNS the number of sqld elements present for the
X                sqlda associated with fd. If ?type is 1, then the sqlda used
X                is the input sqlda and if ?type is 0, then the sqlda used is
X                the output sqlda. This is useful to find out the number of
X                columns fetched from the dynamic query.
X            sql:sqlda ?fd ?type ?num
X                RETURNS a TCL list containing all information about the 
X                num'th element in the sqlda structure.
X                If ?type is 1, then the input sqlda is used.
X                If ?type is 0, then the output sqlda is used.
X                Information is returned for the ?num'th element.
X                ?num varies from 0 to [sql:sqld ?fd ?type]
X            sql:close_database
X                closes the database opened earlier
X                RETURNS 0 on success, non-zero on failure
X            sql:database_name
X                returns the database name opened with sql:database
X            
XTCL CODE ADDITONS
X            sql:selectInto selStr selParamList intoVarList ?stripSpaces?
X                calls sql:open with selStr selParamList, and fetches the
X                the first row, puting each value into the corresponding
X                variable in intoVarList.  Spaces are if stripSpaces is non-0,
X                or is left off the parameter list.
X
X    EXAMPLES
X                1)
X                set fd [sql:open 
X                    "select e.*, d.* 
X                    from employee e, department d 
X                    where e.dept_num = d.dept_num"]
X                set line [sql:fetch $fd]
X                while {$line != ""} {
X                    puts stdout "values are ($line)"
X                    set line [sql:fetch $fd]
X                }
X                sql:close $fd
X
X            2)  
X                set emp_name "FOO'BAR"
X                sql:run "delete from employee where emp_name = ?" $emp_name
X            
X            3)
X                catch {sql:database ""} ret
X                if {$ret != 0} {
X                    puts stdout "Connect Error: [sql:geterror]"
X                    exit_action
X                }
X
X    C CALLS STANDARD
X            The following C calls should be provided (to ensure that the
X            above TCL sql calls are available).
X
X            int Sql_Database(char *dbname)
X                Connects to the database specified by dbname or uses
X                DATABASE environ variable if dbname is "" or cannot be
X                opened.
X                Return value: 0 on success, < 0 on failure
X            int Sql_Open (char *stmt, int argc, char **argv)
X                opens the query specified by stmt and set the bind variables
X                from the argv. This compiles the query and allocates space
X                for the return values.
X                BIND VARIABLES:
X                    bind variables may be thought of as parameters which get
X                    substituted (like \1, \2 in regsub etc.) when the
X                    sql query is compiled. The substituted values may contain
X                    any character like ", ', : * , embedded spaces etc..
X                    If we do not use bind variables, then each column
X                    value has to be inspected to ensure that the special
X                    characters are escaped (using \, etc).
X                Return value: fd (>= 0) on success, < 0 on failure
X            int Sql_Fetch (int fd)
X                fetch a single row into the allocated space
X                Use sql_values() to retrieve it.
X                There is no need to free the sql_values return value.
X                Return value: 0 on success, > 0 on end, < 0 on error
X            char **Sql_Values(int fd, int *numvalues, int dostrip)
X                Return the values fetched by the previous fetch.
X                Set the number of argv values in numvalues.
X                If dostrip is 1, then trailing blanks are stripped from
X                each value
X                There is no need to free the return value from this function.
X                The function manages it by re-allocating space if needed.
X                Return value: NULL on error, char **argv on success
X            int Sql_Close(int fd)
X                Closes the compiled query and releases all memory associated
X                with it.
X                Return value: 0 on success, < 0 on failure
X            int Sql_Run(char *stmt, int argc, char **argv)
X                Calls sql_open, sql_fetch and sql_close returning the
X                status of sql_fetch.
X                Return value: 0 on success, < 0 on failure, > 0 on no such
X                record
X            int Sql_Exists(char *table, char *field, char *value, char *where)
X                Check for existence of field in table with value value and
X                an optional where clause.
X                Return value: 0 on success, < 0 on error, > 0 on no such record
X            char *Sql_GetError()
X                Return a static pointer into the text of the last error
X            int Sql_Explain(int fd)
X                Sets debug on for the query associated with fd
X            char **Sql_Sqlca(int *num)
X                Returns the sqlca structure as an array of character pointers
X                and sets the number of such pointers in num
X            int Sql_Sqld(int fd, int type)
X                Returns the number of sqld elements associated with fd
X                If type is 1, then the input sqlda is used.
X                If type is 0, then the output sqlda is used.
X                This number reflects the number of columns fetched from the
X                dynamic query or the number of bind variables specified.
X            char **Sql_Sqlda(int fd, int type, int elnum, int *numvalues)
X                Returns array of character pointers (the number of such
X                pointers is set in numvalues) for the sqlda element elnum.
X                This contains information like the column name, type,
X                value etc.
X                type is the same as in sql_sqld
X                elnum varies from 0 to sql_sqld(int fd, int type)
X            int Sql_CloseDatabase()
X                Closes the database opened earlier with sql_database
X                Returns 0 on success, < 0 on failure
X            char *Sql_DatabaseName()
X                Gets the database name opened with sql_database
X            
X            All the C calls above should ensure that the fd is valid
X            before it proceeds.
X
X    CONCLUSIONS
X        If support for all database SQL access calls are made with the
X        above format, then it will be easy to add support for other
X        vendors and easier to program.
SHAR_EOF
if [ `wc -c < TclSql.doc` -ne    11518 ]
then
    echo "Lengths do not match -- Bad Copy of TclSql.doc"
fi
echo "Extracting file init.c"
sed -e 's/^X//' <<\SHAR_EOF > init.c
X/* init.c
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Initialization functions for the tclsql lib
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/init.c $
X** $Revision: 0.6 $
X** $Date: 1994/03/25 15:52:35 $
X**
X** $Log: init.c $
X** Revision 0.6  1994/03/25  15:52:35  bkuhn
X**   -- added keyed list initialize
X**
X** Revision 0.5  1993/12/29  12:55:17  bkuhn
X**   -- added Tcl_AppInit
X**
X** Revision 0.4  1993/12/28  19:30:55  bkuhn
X**   -- made function return TCL_OK
X**
X** Revision 0.3  1993/08/23  12:13:01  bkuhn
X**   found that I initialized sql:close twice...took out the first one
X**
X** Revision 0.2  1993/08/16  21:20:18  bkuhn
X**   major naming convention changes; some semantic changes
X**
X** Revision 0.1  1993/08/08  22:32:44  bkuhn
X**   revision before adding INTERNET stuff
X**
X**
X** HISTORY  : started by Bradley M. Kuhn on 26 May 1993
X*/
X#include "tclsqlP.h"
X#include "sqlFuncs.h"
X
Xstatic char rcsid[] =
X  "$Id: init.c 0.6 1994/03/25 15:52:35 bkuhn Exp $";
X/*****************************************************************************
X** function to initialize Tcl SQL functions
X**  PRECONDITIONS: None
X**  POSTCONDITIONS: The TCL commands corresponding to the functions will 
X**                  be available to the Tcl interpreter interp.
X*/
Xint Tcl_Init_Sql(interp)
X    Tcl_Interp *interp;
X{
X    /* from sql-funs.c */
X    Tcl_CreateCommand(interp, "sql:database", Tcl_Sql_Database_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:database_name", Tcl_Sql_GetDatabase_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:close_database", Tcl_Sql_CloseDatabase_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:set_explain", Tcl_Sql_SetExplain_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:run", Tcl_Sql_Run_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:open", Tcl_Sql_Open_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:reopen", Tcl_Sql_ReOpen_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:fetch", Tcl_Sql_Fetch_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:execute", Tcl_Sql_Execute_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:close", Tcl_Sql_Close_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:exists", Tcl_Sql_Exists_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:get_error", Tcl_Sql_GetError_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:sqlca", Tcl_Sql_SqlcaFormat_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:sqlda", Tcl_Sql_SqldaFormat_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "sql:sqld", Tcl_Sql_SqldReturn_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X
X    Sql_Init();                 /* initialize the sql data */
X
X    /* from tclDecimal.c */
X    Tcl_CreateCommand(interp, "dec:add", Tcl_dec_add_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:+", Tcl_dec_add_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:minus", Tcl_dec_minus_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:-", Tcl_dec_minus_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:mul", Tcl_dec_mul_Cmd,
X                    (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:*", Tcl_dec_mul_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:div", Tcl_dec_div_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:/", Tcl_dec_div_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:>", Tcl_dec_compare_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:<", Tcl_dec_compare_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:==", Tcl_dec_compare_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:!=", Tcl_dec_compare_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:>=", Tcl_dec_compare_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:<=", Tcl_dec_compare_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_CreateCommand(interp, "dec:format", Tcl_dec_format_Cmd,
X                      (ClientData)NULL, (void (*)())NULL);
X  return TCL_OK;
X}
X/*-----------------------------------------------------------------------------
X * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
X *
X * Permission to use, copy, modify, and distribute this software and its
X * documentation for any purpose and without fee is hereby granted, provided
X * that the above copyright notice appear in all copies.  Karl Lehenbauer and
X * Mark Diekhans make no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without express or
X * implied warranty.
X *-----------------------------------------------------------------------------
X * $Id: init.c 0.6 1994/03/25 15:52:35 bkuhn Exp $
X *-----------------------------------------------------------------------------
X * Copyright (c) 1993 The Regents of the University of California.
X * All rights reserved.
X *
X * Permission is hereby granted, without written agreement and without
X * license or royalty fees, to use, copy, modify, and distribute this
X * software and its documentation for any purpose, provided that the
X * above copyright notice and the following two paragraphs appear in
X * all copies of this software.
X * 
X * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
X * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
X * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
X * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
X *
X * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
X * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
X * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
X * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
X * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
X */
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_AppInit --
X *
X *      This procedure performs application-specific initialization.
X *      Most applications, especially those that incorporate additional
X *      packages, will have their own version of this procedure.
X *
X * Results:
X *      Returns a standard Tcl completion code, and leaves an error
X *      message in interp->result if an error occurs.
X *
X * Side effects:
X *      Depends on the startup script.
X *
X *----------------------------------------------------------------------
X */
Xint
XTcl_AppInit(interp)
X    Tcl_Interp *interp;         /* Interpreter for application. */
X{
X    /*
X     * Call the init procedures for included packages.  Each call should
X     * look like this:
X     *
X     * if (Mod_Init(interp) == TCL_ERROR) {
X     *     return TCL_ERROR;
X     * }
X     *
X     * where "Mod" is the name of the module.
X     */
X
X    if (Tcl_Init_KeyL(interp) == TCL_ERROR) {
X        return TCL_ERROR;     /* initialize keyl functions */
X    }
X
X    if (Tcl_Init_Sql(interp) == TCL_ERROR) {
X        return TCL_ERROR;     /* initialize sql functions */
X    }
X    /*
X     * Add in Extended Tcl commands and source TclX initialization file.
X     */
X    if (TclX_Init (interp) == TCL_ERROR) {
X        return TCL_ERROR;
X    }
X
X    /*
X     * Specify a user-specific startup file to invoke if the application
X     * is run interactively.  Typically the startup file is "~/.apprc"
X     * where "app" is the name of the application.  If this line is deleted
X     * then no user-specific startup file will be run under any conditions.
X     */
X
X    tcl_RcFileName = "~/.tclrc";
X    return TCL_OK;
X}
SHAR_EOF
if [ `wc -c < init.c` -ne     9159 ]
then
    echo "Lengths do not match -- Bad Copy of init.c"
fi
echo "Extracting file misc.c"
sed -e 's/^X//' <<\SHAR_EOF > misc.c
X/* misc.c
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    miscelaneous functions for tclsql
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/misc.c $
X** $Revision: 0.5 $
X** $Date: 1993/10/21 14:54:24 $
X**
X** $Log: misc.c $
X** Revision 0.5  1993/10/21  14:54:24  bkuhn
X**   -- added the memset in CheckMalloc() ... solved a world of problems...
X**
X** Revision 0.4  1993/09/28  17:26:31  bkuhn
X**   -- commented out free() call...FIX THIS!
X**
X** Revision 0.3  1993/08/16  21:20:19  bkuhn
X**   major naming convention changes; some semantic changes
X**
X** Revision 0.2  1993/08/12  12:36:38  bkuhn
X**   # cosmetic changes
X**
X** Revision 0.1  1993/08/08  22:33:46  bkuhn
X**   revision before adding INTERNET stuff
X**
X**
X** HISTORY    :   started by Bradley M. Kuhn on 12 June 1993
X*/
X#include <stdio.h>
X#include <string.h>
X#include <sys/types.h>
X#include <malloc.h>
X#include <sqlca.h>
X#include "tclsqlP.h"
X
Xstatic char rcsid[] =
X  "$Id: misc.c 0.5 1993/10/21 14:54:24 bkuhn Exp $";
X/*****************************************************************************
X** FormatSqlcaMsg -- calls rgetmsg and formats with the fields from sqlca
X**   PRECONDITIONS: sqlcd != 0
X**   POSTCONDITIONS: a pointer to a formatted string with errmsg will be
X**                   returned.
X*/
Xchar *FormatSqlcaMsg(cur_sqlca)
X    struct sqlca_s cur_sqlca;
X{
X    static char msg[MISC_MSG_STR_LEN];
X    char fmt[MISC_FORMAT_STR_LEN];
X    
X    msg[0] = '\0';
X    rgetmsg(cur_sqlca.sqlcode, fmt, MISC_FORMAT_STR_LEN);
X  
X    if ( strrchr(fmt, '%') == strchr(fmt, '%') )   /* check for only one % */
X      sprintf(msg, fmt, cur_sqlca.sqlerrm);
X    else
X      strcpy(msg, fmt);
X
X    return msg;
X}
X/*****************************************************************************
X** CheckMalloc -- this function simply checks to make sure that malloc
X**                does not return a NULL pointer.
X**  PRECONDITIONS:  None
X**  POSTCONDTIONS: a memory block of size, mem_size will be returned.
X*/
Xvoid *CheckMalloc(mem_size)
X    size_t mem_size;
X{
X    void *ptr;
X
X    ptr = (void *) malloc(mem_size);
X
X    if (ptr == NULL) {
X        fprintf(stderr,
X                "CheckMalloc(): No more memory available...Aborting...\n");
X        exit(-1);
X    }
X    else {
X        memset(ptr, 0, mem_size);   /* clear the memory to a known value */
X        return ptr;
X    }
X}
X/*****************************************************************************
X** CheckFree --  this function simply checks to make sure that the pointer
X**                is not NULL before freeing it.
X**  PRECONDITIONS:  None
X**  POSTCONDTIONS:  the memory pointed to by ptr will be freed if not NULL.
X*/
Xvoid CheckFree(ptr)
X    void *ptr;
X{
X    if (ptr != NULL) free(ptr);
X    return;
X}
SHAR_EOF
if [ `wc -c < misc.c` -ne     3244 ]
then
    echo "Lengths do not match -- Bad Copy of misc.c"
fi
echo "Extracting file rcs.mk"
sed -e 's/^X//' <<\SHAR_EOF > rcs.mk
X#
X#	-----	SCCS rules						-----
X#
XMakefile	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/Makefile,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/Makefile,v Makefile
XMakefile.old	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/Makefile.old,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/Makefile.old,v Makefile.old
XMakefile.old	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/Makefile.old,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/Makefile.old,v Makefile.old
Xdecimal.c	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/decimal.c,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/decimal.c,v decimal.c
Xinit.c	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/init.c,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/init.c,v init.c
Xmisc.ec	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/misc.ec,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/misc.ec,v misc.ec
Xrcs.mk	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/rcs.mk,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/rcs.mk,v rcs.mk
Xrules.mk	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/rules.mk,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/rules.mk,v rules.mk
Xsccs.mk	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/sccs.mk,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/sccs.mk,v sccs.mk
Xsql-funs.ec	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/sql-funs.ec,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/sql-funs.ec,v sql-funs.ec
Xsymbols.mk	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/symbols.mk,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/symbols.mk,v symbols.mk
Xtclsql.h	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/tclsql.h,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/tclsql.h,v tclsql.h
Xtclsql.tlib	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/tclsql.tlib,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/tclsql.tlib,v tclsql.tlib
XtclsqlP.h	: $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/tclsqlP.h,v
X	co $(SrcDir)//usr5/src/tclsql/lib.prg/RCS/tclsqlP.h,v tclsqlP.h
SHAR_EOF
if [ `wc -c < rcs.mk` -ne     1818 ]
then
    echo "Lengths do not match -- Bad Copy of rcs.mk"
fi
echo "Extracting file rules.mk"
sed -e 's/^X//' <<\SHAR_EOF > rules.mk
X# rules.mk
X#
X#  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X#
X# Program   :    TclSql library
X# File      :    Rules for the Makefile
X#
X# Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X#   By                                  5916 Glenoak Ave.
X#                                       Baltimore, MD 21214-2009
X#                                       410-254-7060
X#
X# Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X#   For          400 West Franklin Street
X#                Baltimore, MD 21201
X#                410-225-9595
X#
X# RCS        :
X# $Source: /usr5/src/tclsql/lib/RCS/rules.mk $
X# $Revision: 0.3 $
X# $Date: 1993/08/23 18:53:26 $
X#
X# $Log: rules.mk $
X# Revision 0.3  1993/08/23  18:53:26  bkuhn
X#   added tclsql.h to the install target
X#   added a header
X#
X#
X#	-----	START 4GL GLOBALS					-----
X#
X#
X#	-----	STOP 4GL GLOBALS					-----
X#
X
X#
X#	-----	rules for software control, i.e. rcs.mk or sccs.mk	-----
X#
X#include $(SCS).mk
X
Xinstall:
X	cp $(LIBRARY) /usr/local/lib
X	chmod 644 /usr/local/lib/$(LIBRARY)
X#	chmod 644 $(TCLLIBS)
X#	cp $(TCLLIBS) /usr/local/tcl
X	cp tclsql.h /usr/local/include
X	chmod 644 /usr/local/include/tclsql.h
Xci:
X	ci -d -M $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
X
Xco:
X	co -M $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
Xcico:
X	ci -d -M -u $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
Xtags:
X	etags -t $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
SHAR_EOF
if [ `wc -c < rules.mk` -ne     1424 ]
then
    echo "Lengths do not match -- Bad Copy of rules.mk"
fi
echo "Extracting file sqlFuncs.ec"
sed -e 's/^X//' <<\SHAR_EOF > sqlFuncs.ec
X/* sqlFuncs.ec
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Implementation of ESQL/C database commands
X** Functions :
X**  Sql_Init()                -- initialize the File level globals
X**  Sql_CurrentDatabaseName() -- return the current database name
X**  Sql_CurrentErrorMsg()     -- return the current formatted error message
X**  Sql_Database()            -- set the current database
X**  Sql_CloseDatabase()       -- close the current database
X**  Sql_SetExplain()          -- turn sqlexplain on or off
X**  Sql_Exists()              -- check to see if a field or table exists
X**  Sql_Run()                 -- run a simple sql statement(open,execute,close)
X**  Sql_Open()                -- open an sql statement
X**  Sql_ReOpen()              -- reopen an sql statement to redo it
X**  Sql_Fetch()               -- fetch row for a statement
X**  Sql_Execute()             -- execute a statement
X**  Sql_Close()               -- close an sql statement
X**  Sql_RowValues()           -- get the row values from the last fetch
X**  Sql_SqlcaFormat()         -- format values in the sqlca structure
X**  Sql_SqldReturn()          -- get the value of sqlda->sqld
X**  Sql_SqldaFormat()         -- format a specifix sqlda->sqlvar row
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/sqlFuncs.ec $
X** $Revision: 0.7 $
X** $Date: 1994/06/06 19:48:10 $
X**
X** $Log: sqlFuncs.ec $
X** Revision 0.7  1994/06/06  19:48:10  bkuhn
X**   -- added fix for "" problem
X**
X** Revision 0.6  1993/10/12  18:21:53  bkuhn
X**   -- made it work :-)
X**
X** Revision 0.5  1993/09/28  15:43:48  bkuhn
X**   -- changed Sql_Database() to be a simpler function.
X**
X** Revision 0.4  1993/08/26  17:17:39  bkuhn
X**   changes to fix memory problems.
X**
X** Revision 0.3  1993/08/16  21:20:20  bkuhn
X**   major naming convention changes; some semantic changes
X**
X** Revision 0.2  1993/08/12  18:51:18  bkuhn
X**   major changes, mostly just naming conventions
X**
X** Revision 0.1  1993/08/11  18:14:09  bkuhn
X**   initial version -- it works
X**
X*/
X#include <stdio.h>
X#include "tclsqlP.h"        
X#include "sqlFuncsP.h"
X#include "sqlFuncs.h"
X
XEXEC SQL include sqlca;
XEXEC SQL include sqlda;
XEXEC SQL include sqltypes;
X
Xstatic char rcsid[] =
X  "$Id: sqlFuncs.ec 0.7 1994/06/06 19:48:10 bkuhn Exp $";
X
Xstatic t_sqlStatement FsqlStatement[SQL_SD_MAX];
Xstatic char *FdatabaseName = NULL;
X
Xstatic char FcurrentErrorMsg[SQL_ERR_MSG_LEN+1];
X
X/*****************************************************************************
X** Sql_ClearSD -- clear the sd element in FsqlStatement arr.
X*/
Xvoid Sql_ClearSD(sd)
X    int sd;
X{
X    struct sqlda *udesc;
X    register struct sqlvar_struct *col;
X    register int ii;
X
X    SqlP_FreeSD(sd, FsqlStatement[sd].isPrepared);
X
X    FsqlStatement[sd].inUse = FsqlStatement[sd].isPrepared =
X      FsqlStatement[sd].isOpened = FsqlStatement[sd].isSelectStatement = FALSE;
X
X    CheckFree(FsqlStatement[sd].command);
X    FsqlStatement[sd].command = NULL;
X
X    if (FsqlStatement[sd].inputSqlda != NULL) {
X        udesc = FsqlStatement[sd].inputSqlda;
X        if (udesc->sqlvar != NULL) {
X            for (ii = 0, col = udesc->sqlvar; ii < udesc->sqld; ii++, col++)
X              CheckFree(col->sqldata);
X            CheckFree(udesc->sqlvar);
X        }
X        CheckFree(udesc);
X        FsqlStatement[sd].inputSqlda = NULL;
X    }
X
X    return;
X}
X/*****************************************************************************
X** Sql_InitSD -- initialize the sd element in FsqlStatement arr.
X*/
Xvoid Sql_InitSD(sd)
X    int sd;
X{
X    FsqlStatement[sd].inUse = FsqlStatement[sd].isPrepared = 
X      FsqlStatement[sd].isOpened = FsqlStatement[sd].isSelectStatement = FALSE;
X
X    FsqlStatement[sd].command = NULL;
X    FsqlStatement[sd].inputSqlda = NULL;
X    FsqlStatement[sd].outputSqlda = NULL;
X
X    return;
X}
X/******************************************************************************
X** Sql_InvalidSD() -- format the FcurrentErrorMsg for an invalid statement
X**                     discriptor
X**   PRECONDITIONS: sd is not a valid sql descriptor
X**   POSTCONDITIONS: FcurrentErrorMsg will contain an appropriate message;
X**                   -1 will be returned.
X*/
Xt_sqlCode Sql_InvalidSD(sd)
X    int sd;
X{
X    sprintf(FcurrentErrorMsg, "%s%d%s",
X            "Unknown sql statement discriptor(", sd, ")");
X    return -1;
X}
X/******************************************************************************
X** Sql_TooManySD() -- format the FcurrentErrorMsg for attempting to open
X**                     too many statements
X**   PRECONDITIONS: The user has attempted to open more than SQL_SD_MAX
X**                  sql statements
X**   POSTCONDITIONS: FcurrentErrorMsg will contain an appropriate message;
X**                   -1 will be returned.
X*/
Xt_sqlCode Sql_TooManySD()
X{
X    sprintf(FcurrentErrorMsg, "%s%d",
X            "No more sql statements are permitted; maximum is ", SQL_SD_MAX);
X    return -1;
X}
X/******************************************************************************
X** Sql_CheckSqlError() -- check for an sqlcode error.
X**    PRECONDITIONS: None
X**    POSTCONDTIONS: formats the FcurrentErrorMsg string if the sqlcode is
X**                   less than 0; returns sqlcode regardless.
X*/
Xt_sqlCode Sql_CheckSqlError()
X{
X    char *sqlMsg;
X    t_sqlCode retCode = sqlca.sqlcode;
X
X    if (retCode < 0) {
X        struct sqlca_s sqlcaSave;
X
X        FcurrentErrorMsg[0] = '\0';
X        memcpy(&sqlcaSave, &sqlca, sizeof(sqlca));
X
X        sqlMsg = FormatSqlcaMsg(sqlcaSave);
X
X        sprintf(FcurrentErrorMsg,
X            "ISAM(%d), SQL(%d):%s",
X            sqlcaSave.sqlerrd[1], sqlcaSave.sqlcode, sqlMsg);
X    }
X    return retCode;
X}
X/*****************************************************************************
X** Sql_Init -- initalize the Sql suite
X*/
Xvoid Sql_Init()
X{
X    register int ii;
X
X    CheckFree(FdatabaseName);
X    FdatabaseName = NULL;
X    FcurrentErrorMsg[0] = '\0';
X    for(ii = 0; ii < SQL_SD_MAX; ii++)  Sql_InitSD(ii);
X    return;
X}
X/*****************************************************************************
X** Sql_CurrentDatabaseName()
X**   access function for file level global, FdatabaseName
X*/
Xchar *Sql_CurrentDatabaseName() {
X    return FdatabaseName;
X}
X/******************************************************************************
X** Sql_CurrentErrorMsg()
X**   access function for file level global, FcurrentErrorMsg
X*/
Xchar *Sql_CurrentErrorMsg() {
X    return FcurrentErrorMsg;
X}
X/******************************************************************************
X** Sql_Database()
X**   connects to the database specified by dbname or if dbname is "" or
X**   cannot be opened uses the DATABASE environment variable
X*/
Xt_sqlCode Sql_Database(dbname)
X    char *dbname;
X{
X    EXEC SQL BEGIN DECLARE SECTION 
X      char db[256];
X    EXEC SQL END DECLARE SECTION
X    int len;
X    t_sqlCode ret = 0;
X
X    if (strlen(dbname) >= 256) {
X        fprintf(stderr, "Database name is too long...\n");
X        exit(-1);
X    }
X    strcpy(db, dbname);
X
X    CheckFree(FdatabaseName);
X    FdatabaseName = NULL;
X
X    EXEC SQL database $db;
X    ret = Sql_CheckSqlError();
X    if (ret == 0) {
X        len = strlen(db) + 1;
X        FdatabaseName = (char *) CheckMalloc(len * sizeof(char));
X        strcpy(FdatabaseName, db);
X    }
X    return ret;
X}
X/******************************************************************************
X** Sql_CloseDatabase()
X**   close the current database
X*/
Xt_sqlCode Sql_CloseDatabase() {
X
X  EXEC SQL close database;
X  return Sql_CheckSqlError();
X}
X/******************************************************************************
X** t_sqlCode Sql_SetExplain(bool)
X**     sets explain on if flag is TRUE, otherwise, turns explain off
X*/
Xt_sqlCode Sql_SetExplain(flag)
X    bool flag;
X{
X    if (flag)
X      EXEC SQL set explain on;
X    else 
X      EXEC SQL set explain off;
X
X    return Sql_CheckSqlError();
X}
X/******************************************************************************
X** Sql_Exists(char *table, char *field, char *value, char *where)
X**        check for existence of field in table optionally with value and
X**        optionally with a where clause, where.
X**  PRECONDITIONS: None    
X**  POSTCONDITIONS: returns sqlca.sqlcode, or 0 if everything was ok.
X*/
Xt_sqlCode Sql_Exists(table, field, value, where)
X    char *table, *field, *where;
X    $char *value;
X{
X    EXEC SQL BEGIN DECLARE SECTION
X      char *stmt;
X    EXEC SQL END DECLARE SECTION
X    t_sqlCode fetchCode = 0;
X    bool haveValue, haveWhere;
X
X    /* malloc enough for each value passed and the literals I am putting in */
X    stmt = (char *) CheckMalloc(
X                       (strlen(where) + strlen(table) + strlen(field) +
X                        strlen(value) + 40) * sizeof(char));
X    stmt[0] = '\0';
X
X    haveValue = ( (value != NULL) && (*value != '\0') );
X    haveWhere = ( (where != NULL) && (*where != '\0') );
X    if (haveValue) {
X        sprintf(stmt, "select '1' from %s where (%s == ?)", table, field);
X        if (haveWhere)
X            sprintf(&stmt[strlen(stmt)], " and (%s)", where);
X    }
X    else {
X        sprintf(stmt, "select '1' from %s", table, field);
X        if (haveWhere)
X            sprintf(&stmt[strlen(stmt)], " where %s", where);
X    }
X    EXEC SQL prepare q_sql_pexist from $stmt;
X    fetchCode = Sql_CheckSqlError();
X    if (fetchCode < 0) { CheckFree(stmt); return fetchCode; }
X
X    EXEC SQL declare c_sql_pexist cursor for q_sql_pexist;
X    fetchCode = Sql_CheckSqlError();
X    if (fetchCode < 0) { CheckFree(stmt); return fetchCode; }
X
X    if (haveValue)
X        EXEC SQL open c_sql_pexist using $value;
X    else
X        EXEC SQL open c_sql_pexist;
X    fetchCode = Sql_CheckSqlError();
X    if (fetchCode < 0)  { CheckFree(stmt); return fetchCode; }
X
X    EXEC SQL fetch c_sql_pexist into $stmt;
X    fetchCode = sqlca.sqlcode;
X
X    EXEC SQL close c_sql_pexist;
X
X    CheckFree(stmt);
X    return fetchCode;
X}
X/*****************************************************************************
X** t_sqlCode Sql_Run(char *stmt, int argc, char **argv)
X**    calls Sql_Open, Sql_Execute and then Sql_Close for simple statements
X**   PRECONDITONS:  sd is a valid statement descriptior; stmt contains
X**                  argc ?'s in it and argv has values for each.
X**   POSTCONDITONS:  returns sqlca.sqlcode for command
X*/
Xt_sqlCode Sql_Run(stmt, argc, argv)
X    char *stmt;
X    int argc;
X    char **argv;
X{
X    t_sqlCode ret;
X    int sd;
X
X    sd = Sql_Open(stmt, argc, argv);
X    if (sd < 0) return sd;
X    ret = Sql_Execute(sd);
X    Sql_Close(sd);
X
X    return ret;
X}
X/******************************************************************************
X** t_sqlCode Sql_Open(char *stmt, int argc, char **argv)
X**      -  open the query specified by statement and substitute all ? with
X**         parameters specified
X**      -  compiles the query and allocates space for return values
X**         if it is a select statement.
X**   PRECONDITIONS: stmt must have exactly argc ?'s in it; argv must have argc
X**                  strings in it; sd is a valid statement descriptior
X**   POSTCONDTIONS: the query will be open and described; the assigned
X**                  statement descriptor will be returned
X*/
Xt_sqlCode Sql_Open(stmt, argc, argv) 
X    $char *stmt;
X    int argc;
X    char **argv;
X{
X    struct sqlvar_struct *col;
X    struct sqlda *inputDesc = NULL, *outputDesc = NULL;
X    register int ii;
X    int sd, len, rowMallocSize;
X    char *mallocBuffer = NULL;
X    register char *cp;
X    bool fnd;
X    t_sqlCode ret = 0;
X
X    /* find the next available query location */
X    for (ii = 0, fnd = FALSE; ii < SQL_SD_MAX; ii++)  {
X        
X        fnd = (! FsqlStatement[ii].inUse);
X        if (fnd) break;
X    }
X    
X    if (fnd) sd = ii;
X    else return Sql_TooManySD(ii);
X
X    FsqlStatement[sd].inUse = TRUE;   /* set this statement to be in use  */
X
X    /* save the statement string */
X    len = strlen(stmt);
X    FsqlStatement[sd].command = (char *) CheckMalloc( (len+1) * sizeof(char));
X    strcpy(FsqlStatement[sd].command, stmt);
X
X    ret = SqlP_PrepareSD(sd, FsqlStatement[sd].command);
X    FsqlStatement[sd].isPrepared = TRUE;
X    if (ret < 0) { Sql_Close(sd); return ret; }
X
X    /* if we have any arguments (i.e. ?'s) to put into the description
X    **  do it now.  malloc space and load them into the sqlvar array.
X    **  see ESQL/C Programmer's Manual V4.00, 2-28 for more information
X    */
X    if (argc > 0) {
X        inputDesc = FsqlStatement[sd].inputSqlda = (struct sqlda *)
X                                          CheckMalloc(sizeof(struct sqlda));
X        inputDesc->sqld = argc;
X        inputDesc->sqlvar = (struct sqlvar_struct *)
X                              CheckMalloc(argc * sizeof(struct sqlvar_struct));
X
X        /* for every argument, load into into the next successive location
X        **  in the sqlvar array, mallocing space while going through */
X
X        for (ii = 0, col = inputDesc->sqlvar; ii < argc; ii++, col++) {
X            /* set the length and data for this field */
X            int valLen;
X
X            valLen = strlen(argv[ii]);
X            
X            col->sqllen = valLen + 1;
X            col->sqldata = (char *) CheckMalloc(col->sqllen+1);
X
X            /* we found that empty strings confuse Informix, so we force
X             ** a single space */
X            if (valLen == 0) {
X                strcpy(col->sqldata, " ");
X            } else {
X                strcpy(col->sqldata, argv[ii]);
X            }
X
X            /* argv contained all strings; tell informix so, and it will
X            **  take care of conversions as needed */
X            col->sqltype = CSTRINGTYPE;
X
X            col->sqlname = NULL; /* name of column; don't need it */
X            col->sqlind = NULL;    /* indicator is NULL; don't need it */
X        }
X    }
X    if (! SqlP_isSelectStatement(stmt)) {
X        FsqlStatement[sd].isSelectStatement = FALSE;
X        return sd;
X    }
X    /* if it is a select statment, then we need to prepare for rows returned */
X
X    FsqlStatement[sd].isSelectStatement = TRUE;
X
X    ret = SqlP_DescribeSD(sd, &outputDesc);
X    if (ret < 0)  { Sql_Close(sd); return ret; }
X
X    /* Save the descriptor that informix gave us
X    ** See ESQL/C Programmer's Manual V4.00, 2-23
X    */
X    FsqlStatement[sd].outputSqlda = outputDesc;
X
X    rowMallocSize = 0;
X    for (ii = 0,col = outputDesc->sqlvar; ii < outputDesc->sqld; ii++, col++) {
X
X        /* rtypwidth returns the size we need */
X        col->sqllen = rtypwidth(col->sqltype, col->sqllen) + 1;
X
X        /* INFORMIX will convert everything to char for us...See the
X        ** ESQL/C Programmer's manual V4.00, 2-26, paragraph 2, last sentence
X        */
X        col->sqltype = CCHARTYPE;
X
X        /* keep a sum of how much to malloc after we know how much there is */
X
X        rowMallocSize = (int) rtypalign(rowMallocSize, col->sqltype)
X                            + col->sqllen;
X
X        /* make the indicator NULL */
X        col->sqlind = NULL;
X    }
X    /* The following code is modeled after the code in the ESQL/C Programmer's
X    ** manual V4.00, 2-43, Step 3.  It mallocs the complete amount for the
X    ** entire row and then places pointers into that large buffer for each
X    ** column.
X    */
X    mallocBuffer = (char *) CheckMalloc(rowMallocSize);
X    cp = mallocBuffer;
X    for (ii = 0,col = outputDesc->sqlvar; ii < outputDesc->sqld; ii++, col++) {
X        cp = (char *) rtypalign(cp, col->sqltype);
X        col->sqldata = cp;
X        cp += col->sqllen;
X    }
X
X    ret = SqlP_DeclareSD(sd);
X    if (ret < 0) { Sql_Close(sd); return ret; }
X
X    ret = Sql_ReOpen(sd);
X    if (ret < 0) { Sql_Close(sd); return ret; }
X
X    FsqlStatement[sd].isOpened = TRUE;
X    return sd;
X}
X/*****************************************************************************
X** Sql_ReOpen() -- opens the cursor of sd so that fetches may be done from the 
X**                  beginning.
X**   PRECONDITIONS: The statement for sd has been described and a cursor
X**                  declared, if needed; sd is a valid statement descriptior
X**   POSTCONDITIONS: the statment will be open from the beginning
X*/
Xt_sqlCode Sql_ReOpen(sd)
X    int sd;
X{
X    struct sqlda *inputDesc;
X    t_sqlCode ret = 0;
X
X    inputDesc = FsqlStatement[sd].inputSqlda;
X    ret = SqlP_OpenSD(sd, inputDesc);
X    if (ret < 0) return ret;
X    return ret;
X}
X/*****************************************************************************
X** Sql_Fetch -- fetch a single row into the allocated space
X**    PRECONDITONS: sd is a valid statement descriptor
X**    POSTCONDITIONS: fetch will be performed
X*/
Xt_sqlCode Sql_Fetch(sd)
X     int sd;
X{
X    t_sqlCode ret = 0;
X    
X    if (! FsqlStatement[sd].isSelectStatement) {
X        sprintf(FcurrentErrorMsg, "can only fetch a select statement");
X        ret = -1;
X    }
X    else   ret = SqlP_FetchSD(sd, FsqlStatement[sd].outputSqlda);
X
X    return ret;
X}
X/*****************************************************************************
X** Sql_Execute -- execute it if not a select statement
X**    PRECONDITONS: sd is a valid statement descriptior
X**    POSTCONDITIONS: execute will be performed
X*/
Xt_sqlCode Sql_Execute(sd)
X     int sd;
X{
X    t_sqlCode ret = 0;
X    
X    if (FsqlStatement[sd].isSelectStatement) {
X        sprintf(FcurrentErrorMsg, "cannot execute a select statement");
X        ret = -1;
X    }
X    else
X      ret = SqlP_ExecuteSD(sd, FsqlStatement[sd].inputSqlda);
X    return ret;
X}
X/******************************************************************************
X** Sql_Close() -- close the compiled query and release memory allocated for it.
X**    PRECONDITIONS: sd is a valid statement descriptior
X**    POSTCONDITIONS: the statement will closed if it was open.
X*/
Xt_sqlCode Sql_Close(sd)
X    int sd;
X{
X    t_sqlCode ret = 0;
X
X    if (FsqlStatement[sd].isOpened) ret = SqlP_CloseSD(sd);
X    Sql_ClearSD(sd);
X    return ret;
X}
X/******************************************************************************
X** Sql_RowValues() -- return the values from the current row of a select st.
X**     PRECONDTIONS: sd is a valid statement descriptior
X**     POSTCONDITIONS: current row will be returned in an argv-type vector;
X**                     the count will be returned through the parameter, argc;
X**                    if doStrip is TRUE, all trailing blanks will be stripped;
X**
X**     NOTE: there is no need to free the Sql_RowValues return value!
X**           the program manages this space efficiently by reallocating more 
X**           space if needed and does not do repeated malloc and free.
X*/
Xchar **Sql_RowValues(sd, argcPtr, doStrip)
X    int sd, *argcPtr;
X    bool doStrip;
X{
X    char **argv;
X    struct sqlda *udesc;
X    struct sqlvar_struct *col;
X    register int len, ii;
X    register char *cp;
X
X    if ( ( ! FsqlStatement[sd].isSelectStatement) ||
X       ( ! FsqlStatement[sd].isOpened) ) {
X        sprintf(FcurrentErrorMsg, 
X                "Cannot get values for a non-select/non-Opened statement(%d)",
X                sd);
X        return NULL;
X    }
X    udesc = FsqlStatement[sd].outputSqlda;
X    if (udesc == NULL) return NULL;  /* if its not allocated, return nothing */
X
X    argv = (char **) CheckMalloc(udesc->sqld * sizeof(char *));
X
X    for (ii = 0, col = udesc->sqlvar; ii < udesc->sqld; ii++, col++) {
X        if (col->sqldata == NULL)
X          argv[ii] = "";
X        else {
X            argv[ii] = (char *) CheckMalloc(strlen(col->sqldata) + 1);
X            strcpy(argv[ii], col->sqldata);
X        }
X        if (doStrip) {  /* get rid of space padding */
X            len = strlen(argv[ii]);
X            cp = argv[ii] + len - 1;
X            while ( (len > 1) && (*cp == ' ') ) {
X                *cp = '\0';
X                len--, cp--;
X            }
X        }
X    }
X    if (argcPtr != NULL) *argcPtr = (int) udesc->sqld;
X    return argv;
X}
X/*****************************************************************************
X**  Sql_SqlcaFormat  -- return the sqlca strcuture formatted as a string
X**    PRECONDTIONS: None
X**    POSTCONDTIONS: a fomatted version of the sqlca struct will be returned;
X**                   the number of things in argv will be returned in argcPtr.
X*/
Xchar **Sql_SqlcaFormat(argcPtr)
X    int *argcPtr;
X{
X    static char **argv = NULL;
X    static char sqlcodeStr[15], sqlerrdStr[15*6], sqlwarnStr[25];
X
X    if (argv == NULL)   argv = (char **) CheckMalloc(4 * sizeof(char *));
X
X    sprintf(sqlcodeStr, "%d", sqlca.sqlcode);
X    sprintf(sqlerrdStr, "%d %d %d %d %d %d", 
X            sqlca.sqlerrd[0], sqlca.sqlerrd[1], sqlca.sqlerrd[2], 
X            sqlca.sqlerrd[3], sqlca.sqlerrd[4], sqlca.sqlerrd[5]);
X    sprintf(sqlwarnStr, "%c %c %c %c %c %c %c %c",
X            sqlca.sqlwarn.sqlwarn0, sqlca.sqlwarn.sqlwarn1, 
X            sqlca.sqlwarn.sqlwarn2, sqlca.sqlwarn.sqlwarn3,
X            sqlca.sqlwarn.sqlwarn4, sqlca.sqlwarn.sqlwarn5, 
X            sqlca.sqlwarn.sqlwarn6, sqlca.sqlwarn.sqlwarn7);
X
X    argv[0] = sqlcodeStr;
X    argv[1] = sqlca.sqlerrm;
X    argv[2] = sqlca.sqlerrp;
X    argv[3] = sqlerrdStr;
X
X    if (argcPtr) *argcPtr = 5;
X    return argv;
X}
X/*****************************************************************************
X**  Sql_SqldReturn  -- return the sqld value
X**    PRECONDTIONS: sd is a valid statement descriptior
X**    POSTCONDITIONS: if in is TRUE, it returns sqld from input descriptor
X**                    otherwise from output descriptior, if the chosen 
X**                    descriptor is NULL, then -2 is returned
X*/
Xint Sql_SqldReturn(sd, in)
X    int sd;
X    bool in;
X{
X    struct sqlda *udesc;
X
X    if (in) udesc = FsqlStatement[sd].inputSqlda;
X    else udesc = FsqlStatement[sd].outputSqlda;
X
X    if (udesc != NULL) return udesc->sqld;
X    else {
X        sprintf(FcurrentErrorMsg,
X                "no sqlda %s struct defined from statement %d", 
X                in ? "input" : "output", sd);
X        return -2;
X    }
X}
X/*****************************************************************************
X**  Sql_SqldaFormat  -- return the sqlda strcuture
X**    PRECONDTIONS: sd is a valid statement descriptior
X**    POSTCONDTIONS: a fomatted version of the sqlda struct for 
X**                   inputSqlda if in == TRUE, otherwise outputSqlda
X**                   for element, elementNum will be returned;
X**                   the number of things in argv will be returned in argcPtr.
X*/
Xchar **Sql_SqldaFormat(sd, in, elementNum, argcPtr)
X    int sd;
X    bool in;
X    int elementNum;
X    int *argcPtr;
X{
X    static char **argv = NULL;
X    static char sqltypeStr[15], sqllenStr[15],
X                sqlitypeStr[15], sqlilenStr[15];
X
X    struct sqlda *udesc;
X    struct sqlvar_struct *col;
X
X    if (in) udesc = FsqlStatement[sd].inputSqlda;
X    else    udesc = FsqlStatement[sd].outputSqlda;
X
X    if (elementNum < 0 || elementNum >= udesc->sqld) {
X        sprintf(FcurrentErrorMsg,
X                "descriptor %d's %s sqlda struct has no element, %d",
X                sd, in ? "input" : "output", elementNum);
X        return NULL;
X    }
X    if (argv == NULL) argv = (char **)CheckMalloc(8 * sizeof(char *));
X
X    col = udesc->sqlvar + elementNum;
X
X    sprintf(sqltypeStr, "%d", col->sqltype);
X    sprintf(sqllenStr, "%d", col->sqllen);
X    sprintf(sqlitypeStr, "%d", col->sqlitype);
X    sprintf(sqlilenStr, "%d", col->sqlilen);
X    argv[0] = sqltypeStr;
X    argv[1] = sqllenStr;
X    argv[2] = (col->sqldata == NULL) ? "" : col->sqldata;
X    argv[3] = (col->sqlname == NULL) ? "" : col->sqlname;
X    argv[4] = (col->sqlformat == NULL) ? "" : col->sqlformat;
X    argv[5] = sqlitypeStr;
X    argv[6] = sqlilenStr;
X
X    if (argcPtr != NULL) *argcPtr = 7;
X    return argv;
X}
SHAR_EOF
if [ `wc -c < sqlFuncs.ec` -ne    24025 ]
then
    echo "Lengths do not match -- Bad Copy of sqlFuncs.ec"
fi
echo "Extracting file sqlFuncs.h"
sed -e 's/^X//' <<\SHAR_EOF > sqlFuncs.h
X/* sqlFuncs.h
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Header files for sqlFuncs.ec
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/sqlFuncs.h $
X** $Revision: 0.3 $
X** $Date: 1993/10/12 14:35:43 $
X**
X** $Log: sqlFuncs.h $
X** Revision 0.3  1993/10/12  14:35:43  bkuhn
X**   # minor changes
X**
X** Revision 0.2  1993/08/16  18:23:27  bkuhn
X**   massive changes in naming conventions
X**
X** Revision 0.1  1993/08/11  11:56:19  bkuhn
X**   initial version
X**
X*/
X#ifndef SQLFUNCS_H
X#define SQLFUNCS_H
X
X  /* typedefs */
X
Xtypedef long t_sqlCode;
X
X/* function headers */
Xextern void      Sql_ClearSD();
Xextern void      Sql_InitSD();
Xextern t_sqlCode Sql_InvalidSD();
Xextern t_sqlCode Sql_TooManySD();
Xextern t_sqlCode Sql_CheckSqlError();
Xextern void      Sql_Init();
Xextern char     *Sql_CurrentDatabaseName();
Xextern char     *Sql_CurrentErrorMsg();
Xextern t_sqlCode Sql_Database();
Xextern t_sqlCode Sql_CloseDatabase();
Xextern t_sqlCode Sql_SetExplain();
Xextern t_sqlCode Sql_Exists();
Xextern t_sqlCode Sql_Run();
Xextern t_sqlCode Sql_Open();
Xextern t_sqlCode Sql_ReOpen();
Xextern t_sqlCode Sql_Fetch();
Xextern t_sqlCode Sql_Execute();
Xextern t_sqlCode Sql_Close();
Xextern char    **Sql_RowValues();
Xextern char    **Sql_SqlcaFormat();
Xextern int       Sql_SqldReturn();
Xextern char    **Sql_SqldaFormat();
X
X#endif
SHAR_EOF
if [ `wc -c < sqlFuncs.h` -ne     1839 ]
then
    echo "Lengths do not match -- Bad Copy of sqlFuncs.h"
fi
echo "Extracting file sqlFuncsP.ec"
sed -e 's/^X//' <<\SHAR_EOF > sqlFuncsP.ec
X/* sqlFuncsP.ec
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Private functions for use by sqlFuncs.ec
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/sqlFuncsP.ec $
X** $Revision: 0.5 $
X** $Date: 1993/11/02 17:30:09 $
X**
X** $Log: sqlFuncsP.ec $
X** Revision 0.5  1993/11/02  17:30:09  bkuhn
X**   # minor changes
X**
X** Revision 0.4  1993/10/12  14:51:08  bkuhn
X**   -- made it work :-)
X**
X** Revision 0.3  1993/09/28  16:49:05  bkuhn
X**   -- changed some outdated code
X**
X** Revision 0.2  1993/08/26  16:23:23  bkuhn
X**   changed the regexp in SqlP_isSelectStatement and took out
X**   rupshift call because rupshift() seemed to have memory problems
X**
X** Revision 0.1  1993/08/16  21:08:08  bkuhn
X**   initial revision
X**
X** Revision 0.2  1993/08/12  18:51:18  bkuhn
X**   major changes, mostly just naming conventions
X**
X** Revision 0.1  1993/08/11  18:14:09  bkuhn
X**   initial version -- it works
X**
X*/
X#include <stdio.h>
X#include "tclsqlP.h"
X#include "sqlFuncsP.h"
X
XEXEC SQL include sqlca;
XEXEC SQL include sqlda;
XEXEC SQL include sqltypes;
X
Xstatic char rcsid[] =
X  "$Id: sqlFuncsP.ec 0.5 1993/11/02 17:30:09 bkuhn Exp $";
X/*****************************************************************************
X** SqlP_PrepareSD() -- takes a statement descriptor and prepares its 
X**                     associated statement
X**   PRECONDITONS: FsqlStatement[sd].statement contains the statement to
X**                 prepare.
X**   POSTCONDTIONS: The statement will be prepared.  The sqlcode will be
X**                  returned.
X*/
Xt_sqlCode SqlP_PrepareSD(sd, stmt)
X    int sd;
X    $char *stmt;
X{
X    int  ret = 0;
X
X    switch (sd) {
X            case 0:
X                EXEC SQL prepare q_sql0 from $stmt;
X                break;
X            case 1:
X                EXEC SQL prepare q_sql1 from $stmt;
X                break;
X            case 2:
X                EXEC SQL prepare q_sql2 from $stmt;
X                break;
X            case 3:
X                EXEC SQL prepare q_sql3 from $stmt;
X                break;
X            case 4:
X                EXEC SQL prepare q_sql4 from $stmt;
X                break;
X            case 5:
X                EXEC SQL prepare q_sql5 from $stmt;
X                break;
X            case 6:
X                EXEC SQL prepare q_sql6 from $stmt;
X                break;
X            case 7:
X                EXEC SQL prepare q_sql7 from $stmt;
X                break;
X            case 8:
X                EXEC SQL prepare q_sql8 from $stmt;
X                break;
X            case 9:
X                EXEC SQL prepare q_sql9 from $stmt;
X                break;
X            case 10:
X                EXEC SQL prepare q_sql10 from $stmt;
X                break;
X            case 11:
X                EXEC SQL prepare q_sql11 from $stmt;
X                break;
X            case 12:
X                EXEC SQL prepare q_sql12 from $stmt;
X                break;
X            case 13:
X                EXEC SQL prepare q_sql13 from $stmt;
X                break;
X            case 14:
X                EXEC SQL prepare q_sql14 from $stmt;
X                break;
X            case 15:
X                EXEC SQL prepare q_sql15 from $stmt;
X                break;
X            case 16:
X                EXEC SQL prepare q_sql16 from $stmt;
X                break;
X            case 17:
X                EXEC SQL prepare q_sql17 from $stmt;
X                break;
X            case 18:
X                EXEC SQL prepare q_sql18 from $stmt;
X                break;
X            case 19:
X                EXEC SQL prepare q_sql19 from $stmt;
X                break;
X
X            default:
X                ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) ) 
X      ret = Sql_CheckSqlError();
X
X    return ret;
X}
X/*****************************************************************************
X** SqlP_DescribeSD() -- takes a statement descriptor and an sqlda struct
X**                      and describes the statement into the structure
X**   PRECONDITONS: The statement descriptor has been prepared with
X**                 SqlP_PrepareSD
X**   POSTCONDTIONS: The statement will be described.  The sqlcode will be
X**                  returned.
X**  NB: Needs a pointer to a udesc because describe changes things
X*/
Xt_sqlCode SqlP_DescribeSD(sd, udescPtr)
X    int          sd;
X    struct sqlda **udescPtr;
X{
X    t_sqlCode ret = 0;
X    struct sqlda *udesc;
X
X    switch (sd) {
X      case 0: 
X        EXEC SQL describe q_sql0 into udesc; 
X        break;
X      case 1: 
X        EXEC SQL describe q_sql1 into udesc; 
X        break;
X      case 2: 
X        EXEC SQL describe q_sql2 into udesc; 
X        break;
X      case 3: 
X        EXEC SQL describe q_sql3 into udesc; 
X        break;
X      case 4: 
X        EXEC SQL describe q_sql4 into udesc; 
X        break;
X      case 5: 
X        EXEC SQL describe q_sql5 into udesc; 
X        break;
X      case 6: 
X        EXEC SQL describe q_sql6 into udesc; 
X        break;
X      case 7: 
X        EXEC SQL describe q_sql7 into udesc; 
X        break;
X      case 8: 
X        EXEC SQL describe q_sql8 into udesc; 
X        break;
X      case 9: 
X        EXEC SQL describe q_sql9 into udesc; 
X        break;
X      case 10:    
X        EXEC SQL describe q_sql10 into udesc; 
X        break;
X      case 11:    
X        EXEC SQL describe q_sql11 into udesc; 
X        break;
X      case 12:    
X        EXEC SQL describe q_sql12 into udesc; 
X        break;
X      case 13:    
X        EXEC SQL describe q_sql13 into udesc; 
X        break;
X      case 14:    
X        EXEC SQL describe q_sql14 into udesc; 
X        break;
X      case 15:    
X        EXEC SQL describe q_sql15 into udesc; 
X        break;
X      case 16:    
X        EXEC SQL describe q_sql16 into udesc; 
X        break;
X      case 17:    
X        EXEC SQL describe q_sql17 into udesc; 
X        break;
X      case 18:    
X        EXEC SQL describe q_sql18 into udesc; 
X        break;
X      case 19:    
X        EXEC SQL describe q_sql19 into udesc; 
X        break;
X
X      default:
X        ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) )
X      ret = Sql_CheckSqlError();
X
X    *udescPtr = udesc;
X    return ret;
X}
X/*****************************************************************************
X** SqlP_DeclareSD() -- takes a statement descriptor and declares a cursor
X**                     for the statement
X**   PRECONDITONS: The statement descriptor has been prepared with
X**                  SqlP_PrepareSD; The statement is a select statement
X**   POSTCONDTIONS: The cursor will be declared.  The sqlcode will be
X**                  returned.
X*/
Xt_sqlCode SqlP_DeclareSD(sd)
X    int sd;
X{
X    t_sqlCode ret = 0;
X
X    switch (sd) {
X        case 0:
X            EXEC SQL declare c_sql0 cursor for q_sql0; 
X            break;
X        case 1:
X            EXEC SQL declare c_sql1 cursor for q_sql1; 
X            break;
X        case 2:
X            EXEC SQL declare c_sql2 cursor for q_sql2; 
X            break;
X        case 3:
X            EXEC SQL declare c_sql3 cursor for q_sql3; 
X            break;
X        case 4:
X            EXEC SQL declare c_sql4 cursor for q_sql4; 
X            break;
X        case 5:
X            EXEC SQL declare c_sql5 cursor for q_sql5; 
X            break;
X        case 6:
X            EXEC SQL declare c_sql6 cursor for q_sql6; 
X            break;
X        case 7:
X            EXEC SQL declare c_sql7 cursor for q_sql7; 
X            break;
X        case 8:
X            EXEC SQL declare c_sql8 cursor for q_sql8; 
X            break;
X        case 9:
X            EXEC SQL declare c_sql9 cursor for q_sql9; 
X            break;
X        case 10:
X            EXEC SQL declare c_sql10 cursor for q_sql10; 
X            break;
X        case 11:
X            EXEC SQL declare c_sql11 cursor for q_sql11; 
X            break;
X        case 12:
X            EXEC SQL declare c_sql12 cursor for q_sql12; 
X            break;
X        case 13:
X            EXEC SQL declare c_sql13 cursor for q_sql13; 
X            break;
X        case 14:
X            EXEC SQL declare c_sql14 cursor for q_sql14; 
X            break;
X        case 15:
X            EXEC SQL declare c_sql15 cursor for q_sql15; 
X            break;
X        case 16:
X            EXEC SQL declare c_sql16 cursor for q_sql16; 
X            break;
X        case 17:
X            EXEC SQL declare c_sql17 cursor for q_sql17; 
X            break;
X        case 18:
X            EXEC SQL declare c_sql18 cursor for q_sql18; 
X            break;
X        case 19:
X            EXEC SQL declare c_sql19 cursor for q_sql19; 
X            break;
X
X      default:
X        ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) )
X      ret = Sql_CheckSqlError();
X    return ret;
X}
X/*****************************************************************************
X** SqlP_OpenSD() -- takes a statement descriptor, and its initial sqlda struct
X**                  and opens the statement
X**   PRECONDITONS: The statement descriptor has been prepared with
X**                  SqlP_PrepareSD; and declared with SqlP_DeclareSD;
X**                  The statement is a select statement
X**   POSTCONDTIONS: The statement will be opened.  The sqlcode will be
X**                  returned.
X*/
Xt_sqlCode SqlP_OpenSD(sd, udesc)
X    int sd;
X    struct sqlda *udesc;
X{
X    t_sqlCode ret = 0;
X
X    switch (sd) {
X      case 0:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql0 using descriptor udesc;
X        else
X          EXEC SQL open c_sql0;
X        break;
X      case 1:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql1 using descriptor udesc;
X        else
X          EXEC SQL open c_sql1;
X        break;
X      case 2:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql2 using descriptor udesc;
X        else
X          EXEC SQL open c_sql2;
X        break;
X      case 3:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql3 using descriptor udesc;
X        else
X          EXEC SQL open c_sql3;
X        break;
X      case 4:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql4 using descriptor udesc;
X        else
X          EXEC SQL open c_sql4;
X        break;
X      case 5:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql5 using descriptor udesc;
X        else
X          EXEC SQL open c_sql5;
X        break;
X      case 6:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql6 using descriptor udesc;
X        else
X          EXEC SQL open c_sql6;
X        break;
X      case 7:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql7 using descriptor udesc;
X        else
X          EXEC SQL open c_sql7;
X        break;
X      case 8:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql8 using descriptor udesc;
X        else
X          EXEC SQL open c_sql8;
X        break;
X      case 9:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql9 using descriptor udesc;
X        else
X          EXEC SQL open c_sql9;
X        break;
X      case 10:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql10 using descriptor udesc;
X        else
X          EXEC SQL open c_sql10;
X        break;
X      case 11:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql11 using descriptor udesc;
X        else
X          EXEC SQL open c_sql11;
X        break;
X      case 12:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql12 using descriptor udesc;
X        else
X          EXEC SQL open c_sql12;
X        break;
X      case 13:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql13 using descriptor udesc;
X        else
X          EXEC SQL open c_sql13;
X        break;
X      case 14:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql14 using descriptor udesc;
X        else
X          EXEC SQL open c_sql14;
X        break;
X      case 15:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql15 using descriptor udesc;
X        else
X          EXEC SQL open c_sql15;
X        break;
X      case 16:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql16 using descriptor udesc;
X        else
X          EXEC SQL open c_sql16;
X        break;
X      case 17:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql17 using descriptor udesc;
X        else
X          EXEC SQL open c_sql17;
X        break;
X      case 18:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql18 using descriptor udesc;
X        else
X          EXEC SQL open c_sql18;
X        break;
X      case 19:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL open c_sql19 using descriptor udesc;
X        else
X          EXEC SQL open c_sql19;
X        break;
X
X      default:
X        ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) )
X      ret = Sql_CheckSqlError();
X
X    return ret;
X}
X/*****************************************************************************
X** SqlP_FreeSD() -- takes a statement descriptor, and frees the memory
X**                  associated with it
X**   PRECONDITONS: None
X**   POSTCONDTIONS: The statement will be freed.  The sqlcode will be
X**                  returned.
X*/
Xt_sqlCode SqlP_FreeSD(sd, preparedFlag)
X    int sd;
X    bool preparedFlag;
X{
X    t_sqlCode ret = 0;
X
X    switch (sd) {
X      case 0:
X        if (preparedFlag)
X          EXEC SQL free q_sql0;
X        break;
X      case 1:
X        if (preparedFlag)
X          EXEC SQL free q_sql1;
X        break;
X      case 2:
X        if (preparedFlag)
X          EXEC SQL free q_sql2;
X        break;
X      case 3:
X        if (preparedFlag)
X          EXEC SQL free q_sql3;
X        break;
X      case 4:
X        if (preparedFlag)
X          EXEC SQL free q_sql4;
X        break;
X      case 5:
X        if (preparedFlag)
X          EXEC SQL free q_sql5;
X        break;
X      case 6:
X        if (preparedFlag)
X          EXEC SQL free q_sql6;
X        break;
X      case 7:
X        if (preparedFlag)
X          EXEC SQL free q_sql7;
X        break;
X      case 8:
X        if (preparedFlag)
X          EXEC SQL free q_sql8;
X        break;
X      case 9:
X        if (preparedFlag)
X          EXEC SQL free q_sql9;
X        break;
X      case 10:
X        if (preparedFlag)
X          EXEC SQL free q_sql10;
X        break;
X      case 11:
X        if (preparedFlag)
X          EXEC SQL free q_sql11;
X        break;
X      case 12:
X        if (preparedFlag)
X          EXEC SQL free q_sql12;
X        break;
X      case 13:
X        if (preparedFlag)
X          EXEC SQL free q_sql13;
X        break;
X      case 14:
X        if (preparedFlag)
X          EXEC SQL free q_sql14;
X        break;
X      case 15:
X        if (preparedFlag)
X          EXEC SQL free q_sql15;
X        break;
X      case 16:
X        if (preparedFlag)
X          EXEC SQL free q_sql16;
X        break;
X      case 17:
X        if (preparedFlag)
X          EXEC SQL free q_sql17;
X        break;
X      case 18:
X        if (preparedFlag)
X          EXEC SQL free q_sql18;
X        break;
X      case 19:
X        if (preparedFlag)
X          EXEC SQL free q_sql19;
X        break;
X 
X      default:
X        ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) )
X      ret = Sql_CheckSqlError();
X
X    return ret;
X}
X/*****************************************************************************
X** SqlP_ExecuteSD() -- takes a statement descriptor, and its sqlda struct
X**                     and execute the statement
X**   PRECONDITONS: The statement descriptor has been prepared with
X**                  SqlP_PrepareSD; and declared with SqlP_DeclareSD;
X**                  and opened with SqlP_OpenSD; the statment cannot be a
X**                  select statement.
X**   POSTCONDTIONS: The statement will be executed.  The sqlcode will be
X**                  returned.
X*/
Xt_sqlCode SqlP_ExecuteSD(sd, udesc)
X    int sd;
X    struct sqlda *udesc;
X{
X    t_sqlCode ret = 0;
X
X    switch (sd) {
X      case 0:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql0 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql0;
X        break;
X      case 1:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql1 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql1;
X        break;
X      case 2:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql2 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql2;
X        break;
X      case 3:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql3 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql3;
X        break;
X      case 4:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql4 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql4;
X        break;
X      case 5:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql5 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql5;
X        break;
X      case 6:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql6 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql6;
X        break;
X      case 7:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql7 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql7;
X        break;
X      case 8:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql8 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql8;
X        break;
X      case 9:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql9 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql9;
X        break;
X      case 10:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql10 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql10;
X        break;
X      case 11:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql11 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql11;
X        break;
X      case 12:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql12 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql12;
X        break;
X      case 13:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql13 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql13;
X        break;
X      case 14:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql14 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql14;
X        break;
X      case 15:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql15 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql15;
X        break;
X      case 16:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql16 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql16;
X        break;
X      case 17:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql17 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql17;
X        break;
X      case 18:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql18 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql18;
X        break;
X      case 19:
X        if (udesc != NULL)
X          EXEC SQL execute q_sql19 using descriptor udesc;
X        else
X          EXEC SQL execute q_sql19;
X        break;
X
X      default:
X        ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) )
X      ret = Sql_CheckSqlError();
X    return ret;
X}
X/*****************************************************************************
X** SqlP_FetchSD() -- takes a statement descriptor, and its sqlda struct
X**                     and fetches the next row from the statement
X**   PRECONDITONS: The statement descriptor has been prepared with
X**                  SqlP_PrepareSD; and declared with SqlP_DeclareSD;
X**                  and opened with SqlP_OpenSD; the statment must be a
X**                  select statement.
X**   POSTCONDTIONS: The next row will be fetched.  The sqlcode will be
X**                  returned.
X*/
Xt_sqlCode SqlP_FetchSD(sd, udesc)
X    int sd;
X    struct sqlda *udesc;
X{
X    t_sqlCode ret = 0;
X
X    switch (sd) {
X      case 0:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql0 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql0;
X        break;
X      case 1:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql1 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql1;
X        break;
X      case 2:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql2 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql2;
X        break;
X      case 3:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql3 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql3;
X        break;
X      case 4:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql4 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql4;
X        break;
X      case 5:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql5 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql5;
X        break;
X      case 6:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql6 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql6;
X        break;
X      case 7:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql7 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql7;
X        break;
X      case 8:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql8 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql8;
X        break;
X      case 9:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql9 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql9;
X        break;
X      case 10:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql10 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql10;
X        break;
X      case 11:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql11 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql11;
X        break;
X      case 12:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql12 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql12;
X        break;
X      case 13:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql13 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql13;
X        break;
X      case 14:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql14 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql14;
X        break;
X      case 15:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql15 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql15;
X        break;
X      case 16:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql16 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql16;
X        break;
X      case 17:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql17 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql17;
X        break;
X      case 18:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql18 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql18;
X        break;
X      case 19:
X        if ( (udesc != NULL) && (udesc->sqld != 0) )
X          EXEC SQL fetch c_sql19 using descriptor udesc;
X        else
X          EXEC SQL fetch c_sql19;
X        break;
X
X      default:
X        ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) )
X        ret = Sql_CheckSqlError();
X    return ret;
X}
X/*****************************************************************************
X** SqlP_CloseSD() -- takes a statement descriptor, and closes the statement
X**   PRECONDITONS: The statement descriptor was opened with SqlP_OpenSD()
X**   POSTCONDTIONS: The statement will be closed.  The sqlcode will be
X**                  returned.
X*/
Xt_sqlCode SqlP_CloseSD(sd)
X    int sd;
X{
X    t_sqlCode ret = 0;
X
X    switch (sd) {
X      case 0:
X        EXEC SQL close c_sql0; 
X        break;
X      case 1:
X        EXEC SQL close c_sql1; 
X        break;
X      case 2:
X        EXEC SQL close c_sql2; 
X        break;
X      case 3:
X        EXEC SQL close c_sql3; 
X        break;
X      case 4:
X        EXEC SQL close c_sql4; 
X        break;
X      case 5:
X        EXEC SQL close c_sql5; 
X        break;
X      case 6:
X        EXEC SQL close c_sql6; 
X        break;
X      case 7:
X        EXEC SQL close c_sql7; 
X        break;
X      case 8:
X        EXEC SQL close c_sql8; 
X        break;
X      case 9:
X        EXEC SQL close c_sql9; 
X        break;
X      case 10:
X        EXEC SQL close c_sql10; 
X        break;
X      case 11:
X        EXEC SQL close c_sql11; 
X        break;
X      case 12:
X        EXEC SQL close c_sql12; 
X        break;
X      case 13:
X        EXEC SQL close c_sql13; 
X        break;
X      case 14:
X        EXEC SQL close c_sql14; 
X        break;
X      case 15:
X        EXEC SQL close c_sql15; 
X        break;
X      case 16:
X        EXEC SQL close c_sql16; 
X        break;
X      case 17:
X        EXEC SQL close c_sql17; 
X        break;
X      case 18:
X        EXEC SQL close c_sql18; 
X        break;
X      case 19:
X        EXEC SQL close c_sql19; 
X        break;
X
X      default:
X        ret = Sql_InvalidSD(sd);
X    }
X    if ( (ret == 0) && (sqlca.sqlcode != 0) )
X        ret = Sql_CheckSqlError();
X
X    return ret;
X}
X/******************************************************************************
X** SqlP_isSelectStatement() -- find out if stmt is a select statement that
X**                             will be fetched on.
X**   PRECONDITIONS: None
X**   POSTCONDITIONS: returns TRUE iff. this is a select statement;
X**                   stmt will be upshifted
X*/
Xbool SqlP_isSelectStatement(stmt)
X    char *stmt;
X{
X    static char *reSelect, *reIntoTemp;
X    static bool firstTime = TRUE;
X
X    if (firstTime) {            /* only compile regexp the first time */
X        firstTime = FALSE;
X        reSelect = regcmp("^[ \t]*[Ss][Ee][Ll][eE][cC][tT][ \t]+", NULL);
X        reIntoTemp =
X          regcmp("[ \t]+[Ii][Nn][Tt][oO][ \t]+[tT][Ee][Mm][Pp][ \t]+", NULL);
X    }
X    return ( (regex(reSelect, stmt) != NULL) &&
X             (regex(reIntoTemp, stmt) == NULL) );
X}
SHAR_EOF
if [ `wc -c < sqlFuncsP.ec` -ne    27259 ]
then
    echo "Lengths do not match -- Bad Copy of sqlFuncsP.ec"
fi
echo "Extracting file sqlFuncsP.h"
sed -e 's/^X//' <<\SHAR_EOF > sqlFuncsP.h
X/* sqlFuncsP.h
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Private header files for sqlFuncs.ec
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/sqlFuncsP.h $
X** $Revision: 0.2 $
X** $Date: 1993/10/12 16:13:45 $
X**
X** $Log: sqlFuncsP.h $
X** Revision 0.2  1993/10/12  16:13:45  bkuhn
X**   # minor changes
X**
X** Revision 0.1  1993/08/16  18:17:55  bkuhn
X**   massive changes in naming conventions
X**
X**
X*/
X#ifndef SQLFUNCS_P_H
X#define SQLFUNCS_P_H
X
X/* includes */
X#include "tclsql.h"             /* need bool data type */
X#include "sqlFuncs.h"
X
X/* defines */
X#define SQL_SD_MAX 20           /* maximum number of open sql statements */
X#define SQL_ERR_MSG_LEN 256     /* should be long enough for any error msg */
X/* typedefs */
X
Xtypedef struct {
X    bool inUse, isPrepared, isOpened, isSelectStatement;
X    char *command;
X    struct sqlda *inputSqlda;
X    struct sqlda *outputSqlda;
X} t_sqlStatement;
X
X/* function headers */
X
Xextern char *getenv();          /* there was no header file for these on  */
Xextern char *regcmp();          /* AT&T 3B2/600, SYS V R3.2.3 */
X
Xextern char *rtypalign();       /* INFORMIX ESQL/C function */
X/* Private functions */
X
Xextern t_sqlCode SqlP_PrepareSD();
Xextern t_sqlCode SqlP_DescribeSD();
Xextern t_sqlCode SqlP_DeclareSD();
Xextern t_sqlCode SqlP_OpenSD();
Xextern t_sqlCode SqlP_ExecuteSD();
Xextern t_sqlCode SqlP_FreeSD();
Xextern t_sqlCode SqlP_CloseSD();
Xextern bool SqlP_isSelectStatement();
X
X
X#endif
SHAR_EOF
if [ `wc -c < sqlFuncsP.h` -ne     1967 ]
then
    echo "Lengths do not match -- Bad Copy of sqlFuncsP.h"
fi
echo "Extracting file symbols.mk"
sed -e 's/^X//' <<\SHAR_EOF > symbols.mk
X#
X#	-----	default CFLAGS						-----
X#
XEsqlC = ${INFORMIXDIR}/lib/esqlc
XCC = gcc -O2 -traditional -nostdinc -I/usr/include
XCFLAGS = $(EsqlIncludeDir) -I/usr/local/include
XLDFLAGS=-s
X
X#
X#       -----   FILES MACROS                                            -----
X#
XTCLLIBS = tclsql.tlib
XCFILES = init.c tclFuncs.c tclDecimal.c misc.c
XECFILES = sqlFuncs.ec sqlFuncsP.ec
XHFILES = tclsql.h tclsqlP.h sqlFuncs.h sqlFuncsP.h
XSQLFILES = 
XMKFILES = rules.mk	\
X	symbols.mk
X
X#
X#       -----   list of files to put in the library			-----
X#
XLIBFILES = $(LIBRARY)(misc.o) \
X        $(LIBRARY)(tclDecimal.o)	\
X	$(LIBRARY)(init.o)	\
X	$(LIBRARY)(sqlFuncs.o) \
X	$(LIBRARY)(sqlFuncsP.o) \
X        $(LIBRARY)(tclFuncs.o)
X
X#
X#	-----	required for uucp					-----
X#
XUUDIR	= /usr5/src/tclsql
XUUFILE	= lib.prg.cpz
X
SHAR_EOF
if [ `wc -c < symbols.mk` -ne      790 ]
then
    echo "Lengths do not match -- Bad Copy of symbols.mk"
fi
echo "Extracting file tclDecimal.c"
sed -e 's/^X//' <<\SHAR_EOF > tclDecimal.c
X/* tclDecimal.c
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Implementation of ESQL/C fixed decimal functions Tcl commands
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/tclDecimal.c $
X** $Revision: 0.2 $
X** $Date: 1993/08/16 21:18:59 $
X**
X** $Log: tclDecimal.c $
X** Revision 0.2  1993/08/16  21:18:59  bkuhn
X**   major naming convention changes; some semantic changes
X**
X** Revision 0.1  1993/08/08  22:31:30  bkuhn
X**   initial revision
X**
X**
X** HISTORY: started by Bradley M. Kuhn on 10 June 1993
X*/
X#include <decimal.h>
X#include <sqlca.h>
X#include <string.h>
X#include "tclsqlP.h"
X
Xstatic char rcsid[] = 
X  "$Id: tclDecimal.c 0.2 1993/08/16 21:18:59 bkuhn Exp $";
X/***************************************************************************/
Xint Tcl_dec_add_Cmd(dummy, interp, argc, argv)
X  ClientData dummy;           /* Not used. */
X  Tcl_Interp *interp;         /* Current interpreter. */
X  int argc;                   /* Number of arguments. */
X  char **argv;                /* Argument strings. */
X{
X  dec_t addand1, addand2, ans;
X  dec_t_string ans_str;
X  int val = 0;
X  char *msg_ptr = (char *) NULL, *ptr = (char *) NULL;
X
X  if (argc != 3) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                     " <addand1> <addand2>\"", CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[1], strlen(argv[1]), &addand1);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": addand1: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[2], strlen(argv[2]), &addand2);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": addand2: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X  val = decadd(&addand1, &addand2, &ans);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": addop: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ans_str[0] = '\0';
X  val = dectoasc(&ans, ans_str, DEC_T_STR_LEN - 1, -1);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": answer: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ptr = strchr(ans_str, ' ');
X  if (ptr != (char *) NULL) *ptr = '\0';
X
X  Tcl_ResetResult(interp);
X  Tcl_AppendResult(interp, ans_str, CHARNULL);
X  return TCL_OK;
X}
X/***************************************************************************/
Xint Tcl_dec_minus_Cmd(dummy, interp, argc, argv)
X  ClientData dummy;           /* Not used. */
X  Tcl_Interp *interp;         /* Current interpreter. */
X  int argc;                   /* Number of arguments. */
X  char **argv;                /* Argument strings. */
X{
X  dec_t  subtractend, subtractor, ans;
X  dec_t_string ans_str;
X  int val = 0;
X  char *msg_ptr = (char *) NULL, *ptr = (char *) NULL;
X
X  if ( (argc != 3) && (argc != 2) ) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                     " <subtractand> ?<subtractor>?\"", CHARNULL);
X    return TCL_ERROR;
X  }
X  if (argc == 3) val = deccvasc(argv[1], strlen(argv[1]), &subtractend);
X  else           val = deccvint(0, &subtractend); /* unary minus */
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp,"\n", argv[0], ": subtractand: ",msg_ptr,CHARNULL);
X    return TCL_ERROR;
X  }
X  if (argc == 3) val = deccvasc(argv[2], strlen(argv[2]), &subtractor);
X  else           val = deccvasc(argv[1], strlen(argv[1]), &subtractor);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": subtractor: ",msg_ptr,CHARNULL);
X    return TCL_ERROR;
X  }
X  val = decsub(&subtractend, &subtractor, &ans);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": subop: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ans_str[0] = '\0';
X  val = dectoasc(&ans, ans_str, DEC_T_STR_LEN - 1, -1);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": answer: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ptr = strchr(ans_str, ' ');
X  if (ptr != (char *) NULL) *ptr = '\0';
X
X  Tcl_ResetResult(interp);
X  Tcl_AppendResult(interp, ans_str, CHARNULL);
X  return TCL_OK;
X}
X/***************************************************************************/
Xint Tcl_dec_div_Cmd(dummy, interp, argc, argv)
X  ClientData dummy;           /* Not used. */
X  Tcl_Interp *interp;         /* Current interpreter. */
X  int argc;                   /* Number of arguments. */
X  char **argv;                /* Argument strings. */
X{
X  dec_t dividand, divisor, ans;
X  dec_t_string ans_str;
X  int val = 0;
X  char *msg_ptr = (char *) NULL, *ptr = (char *) NULL;
X
X  if (argc != 3) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                     " <dividand> <divisor>\"", CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[1], strlen(argv[1]), &dividand);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": dividand: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[2], strlen(argv[2]), &divisor);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": divisor: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X  val = decdiv(&dividand, &divisor, &ans);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": divop: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ans_str[0] = '\0';
X  val = dectoasc(&ans, ans_str, DEC_T_STR_LEN - 1, -1);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": answer: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ptr = strchr(ans_str, ' ');
X  if (ptr != (char *) NULL) *ptr = '\0';
X
X  Tcl_ResetResult(interp);
X  Tcl_AppendResult(interp, ans_str, CHARNULL);
X  return TCL_OK;
X}
X/*****************************************************************************/
Xint Tcl_dec_mul_Cmd(dummy, interp, argc, argv)
X  ClientData dummy;           /* Not used. */
X  Tcl_Interp *interp;         /* Current interpreter. */
X  int argc;                   /* Number of arguments. */
X  char **argv;                /* Argument strings. */
X{
X  dec_t multiplier1, multiplier2, ans;
X  dec_t_string ans_str;
X  int val = 0;
X  char *msg_ptr = (char *) NULL, *ptr = (char *) NULL;
X
X  if (argc != 3) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                     " <multiplier1> <multiplier2>\"", CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[1], strlen(argv[1]), &multiplier1);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp,"\n",argv[0], ": multiplier1: ", msg_ptr,CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[2], strlen(argv[2]), &multiplier2);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp,"\n", argv[0], ": multiplier2: ",msg_ptr,CHARNULL);
X    return TCL_ERROR;
X  }
X  val = decmul(&multiplier1, &multiplier2, &ans);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": mulop: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ans_str[0] = '\0';
X  val = dectoasc(&ans, ans_str, DEC_T_STR_LEN - 1, -1);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": answer: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  ptr = strchr(ans_str, ' ');
X  if (ptr != (char *) NULL) *ptr = '\0';
X
X  Tcl_ResetResult(interp);
X  Tcl_AppendResult(interp, ans_str, CHARNULL);
X  return TCL_OK;
X}
X/***************************************************************************/
Xint Tcl_dec_compare_Cmd(dummy, interp, argc, argv)
X  ClientData dummy;           /* Not used. */
X  Tcl_Interp *interp;         /* Current interpreter. */
X  int argc;                   /* Number of arguments. */
X  char **argv;                /* Argument strings. */
X{
X  dec_t left, right, ans;
X  dec_t_string ans_str;
X  char *msg_ptr = (char *) NULL;
X  int val = 0;
X  bool flag;
X
X  if (argc != 3) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                     " <left_hand_num> <right_hand_num>\"", CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[1], strlen(argv[1]), &left);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": left_hand_num: ", msg_ptr,
X                     CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[2], strlen(argv[2]), &right);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": right_hand_num: ", msg_ptr,
X                     CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccmp(&left, &right);
X
X  if (val == DECUNKNOWN) {
X    Tcl_AppendResult(interp, "\n", argv[0], ": unknown DEC_T value", CHARNULL);
X    return TCL_ERROR;
X  }
X  if      (strequal(argv[0], "dec_>"))   flag = (val == 1);
X  else if (strequal(argv[0], "dec_<"))   flag = (val == -1);
X  else if (strequal(argv[0], "dec_=="))  flag = (val == 0);
X  else if (strequal(argv[0], "dec_!="))  flag = (val != 0);
X  else if (strequal(argv[0], "dec_>="))  flag = ( (val == 1) || (val == 0) );
X  else if (strequal(argv[0], "dec_<="))  flag = ( (val == -1) || (val == 0) );
X  else {
X    Tcl_AppendResult(interp, "invalid command name: \"", argv[0], "\"",
X                     CHARNULL);
X    return TCL_ERROR;
X  }
X
X  Tcl_ResetResult(interp);
X  if (flag) Tcl_AppendResult(interp, "1", CHARNULL);
X  else      Tcl_AppendResult(interp, "0", CHARNULL);
X  return TCL_OK;
X}
X/*****************************************************************************/
Xint Tcl_dec_format_Cmd(dummy, interp, argc, argv)
X  ClientData dummy;           /* Not used. */
X  Tcl_Interp *interp;         /* Current interpreter. */
X  int argc;                   /* Number of arguments. */
X  char **argv;                /* Argument strings. */
X{
X  dec_t unformatted;
X  dec_t_string formatted_str;
X  int val = 0, decimal_places = 0;
X  char *msg_ptr = (char *) NULL, *ptr = (char *) NULL;
X
X  if (argc != 3) {
X    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                     " <dec_value> <#_of_decimal_places>\"", CHARNULL);
X    return TCL_ERROR;
X  }
X  val = deccvasc(argv[1], strlen(argv[1]), &unformatted);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp,"\n",argv[0], ": dec_value: ", msg_ptr,CHARNULL);
X    return TCL_ERROR;
X  }
X
X  if (Tcl_GetInt(interp, argv[2], &decimal_places) != TCL_OK) return TCL_ERROR;
X
X  /* (DEC_T_STR_LEN-4) need to leave room for at least null byte, sign, and 
X  **  a 0. before any decimal places 
X  */
X  if (decimal_places >= DEC_T_STR_LEN - 4) {
X    Tcl_AppendResult(interp, argv[0], ": too many decimal places specified",
X                     CHARNULL);
X    return TCL_ERROR;
X  }
X  formatted_str[0] = '\0';
X  val = dectoasc(&unformatted, formatted_str, DEC_T_STR_LEN-1, decimal_places);
X
X  if (val != 0) {
X    msg_ptr = FormatSqlcaMsg(val);
X    Tcl_AppendResult(interp, "\n", argv[0], ": format: ", msg_ptr, CHARNULL);
X    return TCL_ERROR;
X  }
X
X  /* get rid of trailing spaces that dectoasc leaves */
X  ptr = strchr(formatted_str, ' ');
X  if (ptr != (char *) NULL) *ptr = '\0';
X
X  Tcl_ResetResult(interp);
X  Tcl_AppendResult(interp, formatted_str, CHARNULL);
X  return TCL_OK;
X}
SHAR_EOF
if [ `wc -c < tclDecimal.c` -ne    11863 ]
then
    echo "Lengths do not match -- Bad Copy of tclDecimal.c"
fi
echo "Extracting file tclFuncs.c"
sed -e 's/^X//' <<\SHAR_EOF > tclFuncs.c
X/* tclFucs.ec
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Tcl calls to ESQL/C database commands
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/tclFuncs.c $
X** $Revision: 0.3 $
X** $Date: 1993/10/12 18:21:55 $
X**
X** $Log: tclFuncs.c $
X** Revision 0.3  1993/10/12  18:21:55  bkuhn
X**   -- made it work :-)
X**
X** Revision 0.2  1993/08/26  15:01:50  bkuhn
X**   # took quotes off of the error messages
X**
X** Revision 0.1  1993/08/16  20:37:03  bkuhn
X**   major naming convention changes; some semantic changes
X**
X** Revision 0.1  1993/08/08  22:51:22  bkuhn
X**   revision before added INTERNET stuff
X**
X**
X** HISTORY    : started by Bradley M. Kuhn on 26 May 1993
X*/
X#include <limits.h>             /* to get NAME_MAX, max size of a file name */
X#include <datetime.h>
X#include <malloc.h>             /* need a declaration of free() */
X#include "tclsqlP.h"
X#include "sqlFuncs.h"
X
X#include <stdio.h>
X
Xstatic char rcsid[] =
X  "$Id: tclFuncs.c 0.3 1993/10/12 18:21:55 bkuhn Exp $";
X
X/*****************************************************************************/
Xint Tcl_Sql_Database_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char buf[25];
X    t_sqlCode ret = 0;
X    char *db = NULL;
X
X    if (argc >= 2) db = argv[1];
X
X    ret = Sql_Database(db);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        sprintf(buf, "%d", ret);
X        Tcl_SetResult(interp, buf, TCL_VOLATILE);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_GetDatabase_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char *db;
X    t_sqlCode ret = 0;
X
X    db = Sql_CurrentDatabaseName();
X    if (db == NULL) db = "";
X    Tcl_SetResult(interp, db, TCL_VOLATILE);
X    return TCL_OK;
X}
X/***************************************************************************/
Xint Tcl_Sql_CloseDatabase_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;           /* Not used. */
X    Tcl_Interp *interp;         /* Current interpreter. */
X    int argc;                   /* Number of arguments. */
X    char **argv;                /* Argument strings. */
X{
X    t_sqlCode ret = 0;
X    
X    if (argc != 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                         CHARNULL);
X        return TCL_ERROR;
X    }
X    ret = Sql_CloseDatabase();
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        Tcl_ResetResult(interp);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_Run_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char *stmt, *arg0;
X    char buf[25];
X    t_sqlCode ret = 0;
X
X    if (argc < 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT> ?arg ...?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    arg0 = argv[0];
X    argc--;   argv++;
X    stmt = argv[0];
X    argc--;  argv++;
X
X    ret = Sql_Run(stmt, argc, argv);
X    if (ret < 0) {
X        Tcl_AppendResult(interp, arg0, ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        sprintf(buf, "%d", ret);
X        Tcl_SetResult(interp, buf, TCL_VOLATILE);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_Open_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char *stmt, *arg0;
X    char buf[25];
X    t_sqlCode ret = 0;
X
X    if (argc < 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT> ?arg ...?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    arg0 = argv[0];
X    argc--;  argv++;
X    stmt = argv[0];
X    argc--;  argv++;
X
X    ret = Sql_Open(stmt, argc, argv);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, arg0, ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        sprintf(buf, "%d", ret);
X        Tcl_SetResult(interp, buf, TCL_VOLATILE);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_Close_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    int sd;
X    t_sqlCode ret = 0;
X
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT_ID>\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &sd) != TCL_OK) return TCL_ERROR;
X
X    ret = Sql_Close(sd);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    return TCL_OK;
X}
X/*****************************************************************************/
Xint Tcl_Sql_Fetch_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    int sd;
X    int retArgc;
X    char **retArgv;
X    register char *cp;
X    register int ii;
X    t_sqlCode ret = 0;
X    bool doStrip = TRUE;        /* default is to trim args */
X
X    if ( (argc < 2) || (argc > 3) ) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT_ID> ?<TRIM_OUTPUT_FLAG>?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (Tcl_GetInt(interp, argv[1], &sd) != TCL_OK) return TCL_ERROR;
X
X    if (argc == 3)
X      if (Tcl_GetBoolean(interp,argv[2], &doStrip) != TCL_OK) return TCL_ERROR;
X
X    ret = Sql_Fetch(sd);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else if (ret == 0) {             /* if a row was found */
X        retArgv = Sql_RowValues(sd, &retArgc, doStrip);
X        if (retArgv == NULL) {
X            Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(),
X                             (char *) NULL);
X            return TCL_ERROR;
X        }
X        interp->result = Tcl_Merge(retArgc, retArgv);
X        interp->freeProc = (Tcl_FreeProc *) free;
X        /* free up retArgv since Tcl won't need it after the merge */
X        for (ii = 0; ii < retArgc; ii++)   CheckFree(retArgv[ii]);
X        CheckFree(retArgv);
X    }
X    else   Tcl_ResetResult(interp);
X
X    return TCL_OK;
X}
X/*****************************************************************************/
Xint Tcl_Sql_Execute_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    int sd;
X    t_sqlCode ret = 0;
X
X    if (argc != 2)  {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT_ID>\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &sd) != TCL_OK) return TCL_ERROR;
X
X    ret = Sql_Execute(sd);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else   return TCL_OK;
X}
X/*****************************************************************************/
Xint Tcl_Sql_Exists_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char *table, *column, *value = NULL, *where = NULL;
X    char buf[25];
X    t_sqlCode ret = 0;
X
X    if (argc < 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " table column ?value ?where?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    table = argv[1];
X    column = argv[2];
X
X    if (argv[3] != NULL) {
X        value = argv[3];
X        if (argv[4] != NULL)   where = argv[4];
X    }
X
X    ret = Sql_Exists(table, column, value, where);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        sprintf(buf, "%d", ret);
X        Tcl_SetResult(interp, buf, TCL_VOLATILE);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_ReOpen_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    int sd;
X    char buf[25];
X    t_sqlCode ret = 0;
X
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT_ID>\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &sd) != TCL_OK) return TCL_ERROR;
X
X    ret = Sql_ReOpen(ret);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        sprintf(buf, "%d", ret);
X        Tcl_SetResult(interp, buf, TCL_VOLATILE);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_SetExplain_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char buf[25];
X    t_sqlCode ret = 0;
X    bool onFlag;
X
X    if ( (argc < 1) || (argc > 2) ) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                "?<ON/OFF FLAG>?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    /* argc == 1 is ok, default to OFF, just like isql */
X    if (argc == 1) onFlag = FALSE;
X    else {
X        if (Tcl_GetBoolean(interp, argv[1], &onFlag) != TCL_OK)
X          return TCL_ERROR;
X    }
X
X    ret = Sql_SetExplain(onFlag);
X
X    if (ret < 0) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        sprintf(buf, "%d", ret);
X        Tcl_SetResult(interp, buf, TCL_VOLATILE);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_GetError_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char *err;
X
X    if (argc != 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                         "\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    err = Sql_CurrentErrorMsg();
X    if (err == NULL) err = "";
X    Tcl_SetResult(interp, err, TCL_VOLATILE);
X    return TCL_OK;
X}
X/*****************************************************************************/
Xint Tcl_Sql_SqlcaFormat_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    int retargc;
X    char **retargv;
X
X    if (argc != 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                         "\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    retargv = Sql_SqlcaFormat(&retargc);
X
X    if (retargv == NULL) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        interp->result = Tcl_Merge(retargc, retargv);
X        interp->freeProc = (Tcl_FreeProc *) free;
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_SqldReturn_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char buf[25];
X    int sd;
X    t_sqlCode ret = 0;
X    bool inputWantedFlag;
X
X    if (argc != 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT_ID> <FLAG, TRUE-IF-INPUT> \"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (Tcl_GetInt(interp, argv[1], &sd) != TCL_OK) return TCL_ERROR;
X
X    if (Tcl_GetBoolean(interp, argv[2], &inputWantedFlag) != TCL_OK)
X      return TCL_ERROR;
X    
X    ret = Sql_SqldReturn(sd, inputWantedFlag);
X
X    if (ret == -2) {
X        Tcl_AppendResult(interp,  argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        sprintf(buf, "%d", ret);
X        Tcl_SetResult(interp, buf, TCL_VOLATILE);
X        return TCL_OK;
X    }
X}
X/*****************************************************************************/
Xint Tcl_Sql_SqldaFormat_Cmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X    char *stmt, *arg0;
X    char buf[25];
X    int sd;
X    bool inputWantedFlag;
X    int  rowNum;
X    int retArgc;
X    char **retArgv;
X    t_sqlCode ret = 0;
X
X    if (argc != 4) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " <STATEMENT_ID> <FLAG, TRUE-IF-INPUT> <ROW_NUMBER> \"",
X                (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &sd) != TCL_OK) return TCL_ERROR;
X
X    if (Tcl_GetBoolean(interp, argv[2], &inputWantedFlag) != TCL_OK)
X      return TCL_ERROR;
X    
X   
X    if (Tcl_GetInt(interp, argv[3], &rowNum) != TCL_OK) return TCL_ERROR;
X
X    retArgv = Sql_SqldaFormat(sd, inputWantedFlag, rowNum, &retArgc);
X
X    if (retArgv == NULL) {
X        Tcl_AppendResult(interp, argv[0], ":", Sql_CurrentErrorMsg(), 
X                         (char *) NULL);
X        return TCL_ERROR;
X    }
X    else {
X        interp->result = Tcl_Merge(retArgc, retArgv);
X        interp->freeProc = (Tcl_FreeProc *) free;
X        return TCL_OK;
X    }
X}
SHAR_EOF
if [ `wc -c < tclFuncs.c` -ne    16921 ]
then
    echo "Lengths do not match -- Bad Copy of tclFuncs.c"
fi
echo "Extracting file tclsql.h"
sed -e 's/^X//' <<\SHAR_EOF > tclsql.h
X/* tclsql.h
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Public include file for ESQL/C function Tcl interfaces
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/tclsql.h $
X** $Revision: 0.5 $
X** $Date: 1993/12/29 15:58:23 $
X**
X** $Log: tclsql.h $
X** Revision 0.5  1993/12/29  15:58:23  bkuhn
X**   -- re-added Tcl_Sql_Init
X**
X** Revision 0.4  1993/12/29  12:55:04  bkuhn
X**   -- added prototype for Tcl_AppInit
X**
X** Revision 0.3  1993/12/28  19:30:37  bkuhn
X**   -- changed header for sql init function
X**
X** Revision 0.2  1993/08/16  17:43:18  bkuhn
X**   massive changes in naming conventions
X**
X** Revision 0.1  1993/08/08  22:34:55  bkuhn
X**   revision before adding INTERNET stuff
X**
X**
X** HISTORY    :  started by Bradley M. Kuhn on 26 May 1993
X*/
X
X#ifndef TCLSQL_H
X#define TCLSQL_H
X
X/* includes */
X#include <tcl.h>
X
X/* defines */
X#define CHARNULL (char *) NULL
X
X/* typedefs */
Xtypedef enum e_bool { FALSE = 0, TRUE = 1 } bool;
X
X/* function prototypes */
X
X  /* from tclFuncs.c */
Xextern int Tcl_Sql_Database_Cmd();
Xextern int Tcl_Sql_CloseDatabase_Cmd();
Xextern int Tcl_Sql_SetExplain_Cmd();
Xextern int Tcl_Sql_GetDatabase_Cmd();
Xextern int Tcl_Sql_Run_Cmd();
Xextern int Tcl_Sql_Open_Cmd();
Xextern int Tcl_Sql_ReOpen_Cmd();
Xextern int Tcl_Sql_Fetch_Cmd();
Xextern int Tcl_Sql_Execute_Cmd();
Xextern int Tcl_Sql_Close_Cmd();
Xextern int Tcl_Sql_Exists_Cmd();
Xextern int Tcl_Sql_GetError_Cmd();
Xextern int Tcl_Sql_SqlcaFormat_Cmd();
Xextern int Tcl_Sql_SqldaFormat_Cmd();
Xextern int Tcl_Sql_SqldReturn_Cmd();
X
X  /* from tclDecimal.c */
Xextern int Tcl_dec_add_Cmd();
Xextern int Tcl_dec_minus_Cmd();
Xextern int Tcl_dec_mul_Cmd();
Xextern int Tcl_dec_div_Cmd();
Xextern int Tcl_dec_compare_Cmd();
Xextern int Tcl_dec_format_Cmd();
X
X  /* from init.c */
Xextern int Tcl_AppInit();
Xextern int Tcl_Init_Sql();
X  /* from misc.ec */
Xextern char *FormatSqlcaMsg();
Xextern void *CheckMalloc();
Xextern void CheckFree();
X
X
X#endif
SHAR_EOF
if [ `wc -c < tclsql.h` -ne     2439 ]
then
    echo "Lengths do not match -- Bad Copy of tclsql.h"
fi
echo "Extracting file tclsql.tlib"
sed -e 's/^X//' <<\SHAR_EOF > tclsql.tlib
X# tclsql.tlib                                                      -*- Tcl -*-
X#
X#  Copyright (C) 1994 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X#
X# Program         :  TclSql library
X# File            :  Additional Tclsql functions written in TCL
X# Packages/Procs  :
X#
X# Written         :  Bradley M. Kuhn    Computer Systems Development, Inc.
X#   By                                  5916 Glenoak Ave.
X#                                       Baltimore, MD 21214-2009
X#                                       410-254-7060
X#
X# Written         : BALTIMORE RH TYPING Laboratory, Inc.
X#   For             400 West Franklin Street
X#                   Baltimore, MD 21201
X#                   410-225-9595
X#
X# RCS             :
X# $Source: /usr5/src/tclsql/lib/RCS/tclsql.tlib $
X# $Revision: 0.10 $
X# $Date: 1994/06/02 19:26:47 $
X#
X# $Log: tclsql.tlib $
X# Revision 0.10  1994/06/02  19:26:47  bkuhn
X#   # fixed typo in sql:foreach
X#
X# Revision 0.9  1994/03/29  21:33:40  bkuhn
X#   # refixed old bugs...don't kon what happend
X#
X# Revision 0.8  1994/03/29  16:08:00  bkuhn
X#   # fixed minor bugs
X#
X# Revision 0.7  1994/03/25  17:35:26  bkuhn
X#   -- changed keyed list usage
X#
X# Revision 0.6  1994/03/03  18:09:25  bkuhn
X#   -- changed to keyed list format
X#
X# Revision 0.5  1994/01/06  21:02:43  bkuhn
X#   # commented out packend
X#
X# Revision 0.4  1993/11/09  21:01:11  bkuhn
X#   -- bug fixes
X#
X# Revision 0.3  1993/08/31  18:49:37  bkuhn
X#   -- changed to conform to new interface
X#
X# Revision 0.2  1993/08/31  13:20:18  bkuhn
X#   - initial version for old tclsql library
X#
X#
X# HISTORY    :  1993/06/03 - file started by Bradley M. Kuhn
X#
X# TCL Sql package
X#
X#  sql:foreach { selStr selParamList varNameList body {stripSpaces 1} } :
X#    This function takes a valid select string, a list of variables, and a body
X#    of code.  The select string is opened, and then each 
X#    row is loaded into the variables in varNameList.  body is executed in
X#    the scope of the caller (as are the variables set in that scope).
X#    if stripSpace is TRUE, trailing spaces are stripped from the string.
X
X#@package: TclSql sql:selectInto sql:foreach sql:foreachIntoKeyL sql:selectIntoKeyL sql:fetchIntoKeyL
X
X###############################################################################
X# sql:selectInto
X#   do a "select ... into" like INFORMIX-4g;
X#  PRECONDITIONS: None
X#  POSTCONDITIONS: all the names in intoVarList will be upvar'ed and set to 
X#                  the values returned by the first fetch of selStr.  If
X#                  stripSpaces is TRUE, then spaces will be stripped.  If 
X#                  fetch returns no row, vars will be upvared as empty strings.
X
Xproc sql:selectInto { selStr selParamList intoVarList {stripSpaces 1} } {
X
X    set cmdStr "sql:open \{$selStr\} "
X    foreach val $selParamList {
X        append cmdStr "\{$val\} "
X    }
X    set selectSD [eval $cmdStr]
X    set valList [sql:fetch $selectSD $stripSpaces]
X    set valListLen [llength $valList]
X
X    if { $valListLen == 0 } {
X        foreach var $intoVarList {
X            upvar $var $var
X            set $var ""
X        }
X    } else {
X        if { $valListLen != [llength $intoVarList] } {
X            error "sql:selectInto: wrong number of variables in intoVarList"
X        } else {
X            loop ii 0 $valListLen {
X                set var [lindex $intoVarList $ii]
X                upvar $var $var
X                set $var [lindex $valList $ii]
X            }
X        }
X    }
X    sql:close $selectSD
X    return $valListLen
X}
X###############################################################################
X# sql:selectIntoKeyL
X#   do a "select ... into" like INFORMIX-4gl, but places values in a keyed
X#   list
X#  PRECONDITIONS: None
X#  POSTCONDITIONS: keyList will be returned and the values of the data will
X#                  be keyed by the names of the fields for 
X#                  the values returned by the first fetch of selStr.  If
X#                  stripSpaces is TRUE, then spaces will be stripped.  If 
X#                  fetch returns no row, vars will be upvared as empty strings.
X
Xproc sql:selectIntoKeyL { selStr selParamList {stripSpaces 1} } {
X    set keyL [keyl:create]
X
X    set cmdStr "sql:open \{$selStr\} "
X    foreach val $selParamList {
X        append cmdStr "\{$val\} "
X    }
X    set selectSD [eval $cmdStr]
X
X    set valList [sql:fetch $selectSD $stripSpaces]
X    set valListLen [llength $valList]
X    if { $valListLen != 0 } {
X        loop ii 0 $valListLen {
X            set fieldName [lindex [sql:sqlda $selectSD 0 $ii] 3]
X            $keyL keylset $fieldName [lindex $valList $ii]
X        }
X    }
X    sql:close $selectSD
X    return $keyL
X}
X###############################################################################
Xproc sql:foreach { selStr selParamList varNameList body {stripSpaces 1} } {
X    set varCnt [llength $varNameList]
X    if [lempty $selParamList] {
X        set selectSD [sql:open "$selStr"]
X    } else {
X        set cmdStr "sql:open \{$selStr\} "
X        foreach val $selParamList {
X            append cmdStr "\{$val\} "
X        }
X        set selectSD [eval $cmdStr]
X    }
X
X    loop jj 0 $varCnt {
X        set curVarName [lindex $varNameList $jj]
X        upvar $curVarName $curVarName
X        set $curVarName ""
X    }
X    set firstTime 1
X    while { ! [lempty [set curRow [sql:fetch $selectSD $stripSpaces]] ] } {
X        if {$firstTime} {
X            set rowLen [llength $curRow]
X            if { $varCnt != $rowLen } {
X                error "sql:foreach: Invaild number of variables"
X            }
X            set firstTime 0
X        }
X        loop jj 0 $rowLen {
X            set [lindex $varNameList $jj] [lindex $curRow $jj]
X        }
X        uplevel $body
X    }
X    sql:close $selectSD
X}
X###############################################################################
Xproc sql:foreachIntoKeyL { selStr selParamList keyL body {stripSpaces 1} } {
X
X    upvar $keyL keyList
X    set keyList [keyl:create]
X
X    set cmdStr "sql:open \{$selStr\} "
X    foreach val $selParamList {
X        append cmdStr "\{$val\} "
X    }
X    set selectSD [eval $cmdStr]
X
X    set firstTime 1
X    while { ! [lempty [set curRow [sql:fetch $selectSD $stripSpaces]] ] } {
X        set rowLen [llength $curRow]
X        loop jj 0 $rowLen {
X            $keyList keylset [lindex [sql:sqlda $selectSD 0 $jj] 3] [lindex $curRow $jj]
X        }
X        uplevel $body
X    }
X    rename $keyList {}
X    set keyList ""
X    sql:close $selectSD
X}
X###############################################################################
Xproc sql:fetchIntoKeyL { selectSD keyL {stripSpaces 1} } {
X    upvar $keyL keyList
X    set keyList [keyl:create]
X    set retVal 1
X
X    set curRow [sql:fetch $selectSD $stripSpaces]
X    set rowLen [llength $curRow]
X
X    loop jj 0 $rowLen {
X        set fieldName [lindex [sql:sqlda $selectSD 0 $jj] 3]
X        $keyList keylset $fieldName [lindex $curRow $jj]
X        set retVal 0
X    }
X    return $retVal
X}
X##@packend
SHAR_EOF
if [ `wc -c < tclsql.tlib` -ne     6936 ]
then
    echo "Lengths do not match -- Bad Copy of tclsql.tlib"
fi
echo "Extracting file tclsqlP.h"
sed -e 's/^X//' <<\SHAR_EOF > tclsqlP.h
X/* tclsqlP.h
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    TclSql library
X** File      :    Private include file for ESQL/C function Tcl interfaces
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tclsql/lib/RCS/tclsqlP.h $
X** $Revision: 0.2 $
X** $Date: 1993/08/16 18:35:42 $
X**
X** $Log: tclsqlP.h $
X** Revision 0.2  1993/08/16  18:35:42  bkuhn
X**   massive changes in naming conventions
X**
X** Revision 0.1  1993/08/08  22:46:27  bkuhn
X**   revision before adding INTERNET stuff
X**
X**
X** HISTORY    : started by Bradley M. Kuhn on 29 May 1993
X*/
X
X#ifndef TCLSQLP_H
X#define TCLSQLP_H
X
X/* includes */
X#include <string.h>
X#include "sqlFuncs.h"
X#include "tclsql.h"
X
X
X#define strequal(x, y) ( (strcmp((x), (y))) == 0 )
X
X/* defines for tclDecimal.c */
X#define DEC_T_STR_LEN 64         /* the biggest a dec_t can be */
X
X/* defines for misc.c */
X#define MISC_FORMAT_STR_LEN 80  /* 80 is arbitrarly picked  */
X#define MISC_MSG_STR_LEN 152    /* FORMAT_STR_LEN + 72 for sqlerrm */
X
X/* typedefs for tclDecimal.c */
Xtypedef char dec_t_string[DEC_T_STR_LEN];
X
X  /* functions from misc.c */
Xchar *FormatSqlcaMsg();
Xvoid *CheckMalloc();
X
X
X#endif
SHAR_EOF
if [ `wc -c < tclsqlP.h` -ne     1609 ]
then
    echo "Lengths do not match -- Bad Copy of tclsqlP.h"
fi
echo "Done."
exit 0