Import Tcl 8.6.11
This commit is contained in:
232
pkgs/tdbc1.1.2/generic/tdbc.c
Normal file
232
pkgs/tdbc1.1.2/generic/tdbc.c
Normal file
@@ -0,0 +1,232 @@
|
||||
/*
|
||||
* tdbc.c --
|
||||
*
|
||||
* Basic services for TDBC (Tcl DataBase Connectivity)
|
||||
*
|
||||
* Copyright (c) 2008 by Kevin B. Kenny.
|
||||
*
|
||||
* Please refer to the file, 'license.terms' for the conditions on
|
||||
* redistribution of this file and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*
|
||||
* RCS: @(#) $Id$
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#include <tcl.h>
|
||||
#include <string.h>
|
||||
#include "tdbcInt.h"
|
||||
|
||||
/* Static procedures declared in this file */
|
||||
|
||||
static int TdbcMapSqlStateObjCmd(ClientData unused, Tcl_Interp* interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
|
||||
MODULE_SCOPE const TdbcStubs tdbcStubs;
|
||||
|
||||
/* Table of commands to create for TDBC */
|
||||
|
||||
static const struct TdbcCommand {
|
||||
const char* name; /* Name of the command */
|
||||
Tcl_ObjCmdProc* proc; /* Command procedure */
|
||||
} commandTable[] = {
|
||||
{ "::tdbc::mapSqlState", TdbcMapSqlStateObjCmd },
|
||||
{ "::tdbc::tokenize", TdbcTokenizeObjCmd },
|
||||
{ NULL, NULL },
|
||||
};
|
||||
|
||||
/* Table mapping SQLSTATE to error code */
|
||||
|
||||
static const struct SqlStateLookup {
|
||||
const char* stateclass;
|
||||
const char* message;
|
||||
} StateLookup [] = {
|
||||
{ "00", "UNQUALIFIED_SUCCESSFUL_COMPLETION" },
|
||||
{ "01", "WARNING" },
|
||||
{ "02", "NO_DATA" },
|
||||
{ "07", "DYNAMIC_SQL_ERROR" },
|
||||
{ "08", "CONNECTION_EXCEPTION" },
|
||||
{ "09", "TRIGGERED_ACTION_EXCEPTION" },
|
||||
{ "0A", "FEATURE_NOT_SUPPORTED" },
|
||||
{ "0B", "INVALID_TRANSACTION_INITIATION" },
|
||||
{ "0D", "INVALID_TARGET_TYPE_SPECIFICATION" },
|
||||
{ "0F", "LOCATOR_EXCEPTION" },
|
||||
{ "0K", "INVALID_RESIGNAL_STATEMENT" },
|
||||
{ "0L", "INVALID_GRANTOR" },
|
||||
{ "0P", "INVALID_ROLE_SPECIFICATION" },
|
||||
{ "0W", "INVALID_STATEMENT_UN_TRIGGER" },
|
||||
{ "20", "CASE_NOT_FOUND_FOR_CASE_STATEMENT" },
|
||||
{ "21", "CARDINALITY_VIOLATION" },
|
||||
{ "22", "DATA_EXCEPTION" },
|
||||
{ "23", "CONSTRAINT_VIOLATION" },
|
||||
{ "24", "INVALID_CURSOR_STATE" },
|
||||
{ "25", "INVALID_TRANSACTION_STATE" },
|
||||
{ "26", "INVALID_SQL_STATEMENT_IDENTIFIER" },
|
||||
{ "27", "TRIGGERED_DATA_CHANGE_VIOLATION" },
|
||||
{ "28", "INVALID_AUTHORIZATION_SPECIFICATION" },
|
||||
{ "2B", "DEPENDENT_PRIVILEGE_DESCRIPTORS_STILL_EXIST" },
|
||||
{ "2C", "INVALID_CHARACTER_SET_NAME" },
|
||||
{ "2D", "INVALID_TRANSACTION_TERMINATION" },
|
||||
{ "2E", "INVALID_CONNECTION_NAME" },
|
||||
{ "2F", "SQL_ROUTINE_EXCEPTION" },
|
||||
{ "33", "INVALID_SQL_DESCRIPTOR_NAME" },
|
||||
{ "34", "INVALID_CURSOR_NAME" },
|
||||
{ "35", "INVALID_CONDITION_NUMBER" },
|
||||
{ "36", "CURSOR_SENSITIVITY_EXCEPTION" },
|
||||
{ "37", "SYNTAX_ERROR_OR_ACCESS_VIOLATION" },
|
||||
{ "38", "EXTERNAL_ROUTINE_EXCEPTION" },
|
||||
{ "39", "EXTERNAL_ROUTINE_INVOCATION_EXCEPTION" },
|
||||
{ "3B", "SAVEPOINT_EXCEPTION" },
|
||||
{ "3C", "AMBIGUOUS_CURSOR_NAME" },
|
||||
{ "3D", "INVALID_CATALOG_NAME" },
|
||||
{ "3F", "INVALID_SCHEMA_NAME" },
|
||||
{ "40", "TRANSACTION_ROLLBACK" },
|
||||
{ "42", "SYNTAX_ERROR_OR_ACCESS_RULE_VIOLATION" },
|
||||
{ "44", "WITH_CHECK_OPTION_VIOLATION" },
|
||||
{ "45", "UNHANDLED_USER_DEFINED_EXCEPTION" },
|
||||
{ "46", "JAVA_DDL" },
|
||||
{ "51", "INVALID_APPLICATION_STATE" },
|
||||
{ "53", "INSUFFICIENT_RESOURCES" },
|
||||
{ "54", "PROGRAM_LIMIT_EXCEEDED" },
|
||||
{ "55", "OBJECT_NOT_IN_PREREQUISITE_STATE" },
|
||||
{ "56", "MISCELLANEOUS_SQL_OR_PRODUCT_ERROR" },
|
||||
{ "57", "RESOURCE_NOT_AVAILABLE_OR_OPERATOR_INTERVENTION" },
|
||||
{ "58", "SYSTEM_ERROR" },
|
||||
{ "70", "INTERRUPTED" },
|
||||
{ "F0", "CONFIGURATION_FILE_ERROR" },
|
||||
{ "HY", "GENERAL_ERROR" },
|
||||
{ "HZ", "REMOTE_DATABASE_ACCESS_ERROR" },
|
||||
{ "IM", "DRIVER_ERROR" },
|
||||
{ "P0", "PGSQL_PLSQL_ERROR" },
|
||||
{ "S0", "ODBC_2_0_DML_ERROR" },
|
||||
{ "S1", "ODBC_2_0_GENERAL_ERROR" },
|
||||
{ "XA", "TRANSACTION_ERROR" },
|
||||
{ "XX", "INTERNAL_ERROR" },
|
||||
{ NULL, NULL }
|
||||
};
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* Tdbc_MapSqlState --
|
||||
*
|
||||
* Maps the 'sqlstate' return from a database error to a key
|
||||
* to place in the '::errorCode' variable.
|
||||
*
|
||||
* Results:
|
||||
* Returns the key.
|
||||
*
|
||||
* This procedure examines only the first two characters of 'sqlstate',
|
||||
* which are fairly portable among databases. The remaining three characters
|
||||
* are ignored. The result is that state '22012' (Division by zero)
|
||||
* is returned as 'data exception', while state '23505' (Unique key
|
||||
* constraint violation) is returned as 'constraint violation'.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
TDBCAPI const char*
|
||||
Tdbc_MapSqlState(const char* sqlstate)
|
||||
{
|
||||
int i;
|
||||
for (i = 0; StateLookup[i].stateclass != NULL; ++i) {
|
||||
if (!strncmp(sqlstate, StateLookup[i].stateclass, 2)) {
|
||||
return StateLookup[i].message;
|
||||
}
|
||||
}
|
||||
return "UNKNOWN_SQLSTATE";
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* TdbcMapSqlStateObjCmd --
|
||||
*
|
||||
* Command to call from a Tcl script to get a string that describes
|
||||
* a SQLSTATE
|
||||
*
|
||||
* Usage:
|
||||
* tdbc::mapSqlState state
|
||||
*
|
||||
* Parameters:
|
||||
* state -- A five-character SQLSTATE
|
||||
*
|
||||
* Results:
|
||||
* Returns a one-word token suitable for interpolating into
|
||||
* errorInfo
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
TdbcMapSqlStateObjCmd(
|
||||
ClientData dummy, /* No client data */
|
||||
Tcl_Interp* interp, /* Tcl interpreter */
|
||||
int objc, /* Parameter count */
|
||||
Tcl_Obj *const objv[] /* Parameter vector */
|
||||
) {
|
||||
(void)dummy;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "sqlstate");
|
||||
return TCL_ERROR;
|
||||
} else {
|
||||
const char* sqlstate = Tcl_GetString(objv[1]);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tdbc_MapSqlState(sqlstate),
|
||||
-1));
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* Tdbc_Init --
|
||||
*
|
||||
* Initializes the TDBC framework when this library is loaded.
|
||||
*
|
||||
* Side effects:
|
||||
*
|
||||
* Creates a ::tdbc namespace and a ::tdbc::Connection class
|
||||
* from which the connection objects created by a TDBC driver
|
||||
* may inherit.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif /* __cplusplus */
|
||||
DLLEXPORT int
|
||||
Tdbc_Init(
|
||||
Tcl_Interp* interp /* Tcl interpreter */
|
||||
) {
|
||||
|
||||
int i;
|
||||
|
||||
/* Require Tcl */
|
||||
|
||||
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* Create the provided commands */
|
||||
|
||||
for (i = 0; commandTable[i].name != NULL; ++i) {
|
||||
Tcl_CreateObjCommand(interp, commandTable[i].name, commandTable[i].proc,
|
||||
(ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
|
||||
}
|
||||
|
||||
/* Provide the TDBC package */
|
||||
|
||||
if (Tcl_PkgProvideEx(interp, PACKAGE_NAME, PACKAGE_VERSION,
|
||||
(ClientData) &tdbcStubs) == TCL_ERROR) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
|
||||
}
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
33
pkgs/tdbc1.1.2/generic/tdbc.decls
Normal file
33
pkgs/tdbc1.1.2/generic/tdbc.decls
Normal file
@@ -0,0 +1,33 @@
|
||||
# -*- tcl -*-
|
||||
#
|
||||
# tdbc.decls --
|
||||
#
|
||||
# Declarations of Stubs-exported functions from the support layer
|
||||
# of Tcl DataBase Connectivity (TDBC).
|
||||
#
|
||||
# Copyright (c) 2008 by Kevin B. Kenny.
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution of
|
||||
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
#
|
||||
# RCS: @(#) $Id$
|
||||
#
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
library tdbc
|
||||
interface tdbc
|
||||
epoch 0
|
||||
scspec TDBCAPI
|
||||
|
||||
# The public API for TDBC
|
||||
|
||||
# Just a dummy definition, meant to keep TDBC_STUBS_REVISION the same
|
||||
declare 0 current {
|
||||
int Tdbc_Init_(Tcl_Interp* interp)
|
||||
}
|
||||
declare 1 current {
|
||||
Tcl_Obj* Tdbc_TokenizeSql(Tcl_Interp* interp, const char* statement)
|
||||
}
|
||||
declare 2 current {
|
||||
const char* Tdbc_MapSqlState(const char* sqlstate)
|
||||
}
|
||||
80
pkgs/tdbc1.1.2/generic/tdbc.h
Normal file
80
pkgs/tdbc1.1.2/generic/tdbc.h
Normal file
@@ -0,0 +1,80 @@
|
||||
/*
|
||||
* tdbc.h --
|
||||
*
|
||||
* Declarations of the public API for Tcl DataBase Connectivity (TDBC)
|
||||
*
|
||||
* Copyright (c) 2006 by Kevin B. Kenny
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*
|
||||
* RCS: @(#) $Id$
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TDBC_H_INCLUDED
|
||||
#define TDBC_H_INCLUDED 1
|
||||
|
||||
#include <tcl.h>
|
||||
|
||||
#ifndef TDBCAPI
|
||||
# if defined(BUILD_tdbc)
|
||||
# define TDBCAPI MODULE_SCOPE
|
||||
# else
|
||||
# define TDBCAPI extern
|
||||
# undef USE_TDBC_STUBS
|
||||
# define USE_TDBC_STUBS 1
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
#if defined(BUILD_tdbc)
|
||||
DLLEXPORT int Tdbc_Init(Tcl_Interp *interp);
|
||||
#elif defined(STATIC_BUILD)
|
||||
extern int Tdbc_Init(Tcl_Interp* interp);
|
||||
#else
|
||||
DLLIMPORT int Tdbc_Init(Tcl_Interp* interp);
|
||||
#endif
|
||||
|
||||
#define Tdbc_InitStubs(interp) TdbcInitializeStubs(interp, \
|
||||
TDBC_VERSION, TDBC_STUBS_EPOCH, TDBC_STUBS_REVISION)
|
||||
#if defined(USE_TDBC_STUBS)
|
||||
TDBCAPI const char* TdbcInitializeStubs(
|
||||
Tcl_Interp* interp, const char* version, int epoch, int revision);
|
||||
#else
|
||||
# define TdbcInitializeStubs(interp, version, epoch, revision) \
|
||||
(Tcl_PkgRequire(interp, "tdbc", version))
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
* TDBC_VERSION and TDBC_PATCHLEVEL here must match the ones that
|
||||
* appear near the top of configure.ac.
|
||||
*/
|
||||
|
||||
#define TDBC_VERSION "1.1.2"
|
||||
#define TDBC_PATCHLEVEL "1.1.2"
|
||||
|
||||
/*
|
||||
* Include the Stubs declarations for the public API, generated from
|
||||
* tdbc.decls.
|
||||
*/
|
||||
|
||||
#include "tdbcDecls.h"
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
70
pkgs/tdbc1.1.2/generic/tdbcDecls.h
Normal file
70
pkgs/tdbc1.1.2/generic/tdbcDecls.h
Normal file
@@ -0,0 +1,70 @@
|
||||
/*
|
||||
* tdbcDecls.h --
|
||||
*
|
||||
* Exported Stubs declarations for Tcl DataBaseConnectivity (TDBC).
|
||||
*
|
||||
* This file is (mostly) generated automatically from tdbc.decls
|
||||
*
|
||||
* Copyright (c) 2008 by Kevin B. Kenny.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*
|
||||
* RCS: @(#) $Id$
|
||||
*
|
||||
*/
|
||||
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
#define TDBC_STUBS_EPOCH 0
|
||||
#define TDBC_STUBS_REVISION 3
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Exported function declarations:
|
||||
*/
|
||||
|
||||
/* 0 */
|
||||
TDBCAPI int Tdbc_Init_ (Tcl_Interp* interp);
|
||||
/* 1 */
|
||||
TDBCAPI Tcl_Obj* Tdbc_TokenizeSql (Tcl_Interp* interp,
|
||||
const char* statement);
|
||||
/* 2 */
|
||||
TDBCAPI const char* Tdbc_MapSqlState (const char* sqlstate);
|
||||
|
||||
typedef struct TdbcStubs {
|
||||
int magic;
|
||||
int epoch;
|
||||
int revision;
|
||||
void *hooks;
|
||||
|
||||
int (*tdbc_Init_) (Tcl_Interp* interp); /* 0 */
|
||||
Tcl_Obj* (*tdbc_TokenizeSql) (Tcl_Interp* interp, const char* statement); /* 1 */
|
||||
const char* (*tdbc_MapSqlState) (const char* sqlstate); /* 2 */
|
||||
} TdbcStubs;
|
||||
|
||||
extern const TdbcStubs *tdbcStubsPtr;
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#if defined(USE_TDBC_STUBS)
|
||||
|
||||
/*
|
||||
* Inline function declarations:
|
||||
*/
|
||||
|
||||
#define Tdbc_Init_ \
|
||||
(tdbcStubsPtr->tdbc_Init_) /* 0 */
|
||||
#define Tdbc_TokenizeSql \
|
||||
(tdbcStubsPtr->tdbc_TokenizeSql) /* 1 */
|
||||
#define Tdbc_MapSqlState \
|
||||
(tdbcStubsPtr->tdbc_MapSqlState) /* 2 */
|
||||
|
||||
#endif /* defined(USE_TDBC_STUBS) */
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
40
pkgs/tdbc1.1.2/generic/tdbcInt.h
Normal file
40
pkgs/tdbc1.1.2/generic/tdbcInt.h
Normal file
@@ -0,0 +1,40 @@
|
||||
/*
|
||||
* tdbcInt.h --
|
||||
*
|
||||
* Declarations of the public API for Tcl DataBase Connectivity (TDBC)
|
||||
*
|
||||
* Copyright (c) 2006 by Kevin B. Kenny
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*
|
||||
* RCS: @(#) $Id$
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
#ifndef TDBCINT_H_INCLUDED
|
||||
#define TDBCINT_H_INCLUDED 1
|
||||
|
||||
#include "tdbc.h"
|
||||
|
||||
/*
|
||||
* Used to tag functions that are only to be visible within the module being
|
||||
* built and not outside it (where this is supported by the linker).
|
||||
*/
|
||||
|
||||
#ifndef MODULE_SCOPE
|
||||
# ifdef __cplusplus
|
||||
# define MODULE_SCOPE extern "C"
|
||||
# else
|
||||
# define MODULE_SCOPE extern
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Linkage to procedures not exported from this module
|
||||
*/
|
||||
|
||||
MODULE_SCOPE int TdbcTokenizeObjCmd(ClientData clientData, Tcl_Interp* interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
|
||||
#endif
|
||||
34
pkgs/tdbc1.1.2/generic/tdbcStubInit.c
Normal file
34
pkgs/tdbc1.1.2/generic/tdbcStubInit.c
Normal file
@@ -0,0 +1,34 @@
|
||||
/*
|
||||
* tdbcStubInit.c --
|
||||
*
|
||||
* Initialization of the Stubs table for the exported API of
|
||||
* Tcl DataBase Connectivity (TDBC)
|
||||
*
|
||||
* Copyright (c) 2008 by Kevin B. Kenny.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*
|
||||
* RCS: @(#) $Id$
|
||||
*
|
||||
*/
|
||||
|
||||
#include "tdbcInt.h"
|
||||
|
||||
MODULE_SCOPE const TdbcStubs tdbcStubs;
|
||||
|
||||
#define Tdbc_Init_ Tdbc_Init
|
||||
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
const TdbcStubs tdbcStubs = {
|
||||
TCL_STUB_MAGIC,
|
||||
TDBC_STUBS_EPOCH,
|
||||
TDBC_STUBS_REVISION,
|
||||
0,
|
||||
Tdbc_Init_, /* 0 */
|
||||
Tdbc_TokenizeSql, /* 1 */
|
||||
Tdbc_MapSqlState, /* 2 */
|
||||
};
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
104
pkgs/tdbc1.1.2/generic/tdbcStubLib.c
Normal file
104
pkgs/tdbc1.1.2/generic/tdbcStubLib.c
Normal file
@@ -0,0 +1,104 @@
|
||||
/*
|
||||
* tdbcStubLib.c --
|
||||
*
|
||||
* Stubs table initialization wrapper for Tcl DataBase Connectivity
|
||||
* (TDBC).
|
||||
*
|
||||
* Copyright (c) 2008 by Kevin B. Kenny.
|
||||
*
|
||||
* Please refer to the file, 'license.terms' for the conditions on
|
||||
* redistribution of this file and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*
|
||||
* RCS: @(#) $Id$
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#include <tcl.h>
|
||||
|
||||
#define USE_TDBC_STUBS 1
|
||||
#include "tdbc.h"
|
||||
|
||||
MODULE_SCOPE const TdbcStubs *tdbcStubsPtr;
|
||||
|
||||
const TdbcStubs *tdbcStubsPtr = NULL;
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* TdbcInitializeStubs --
|
||||
*
|
||||
* Loads the Tdbc package and initializes its Stubs table pointer.
|
||||
*
|
||||
* Client code should not call this function directly; instead, it should
|
||||
* use the Tdbc_InitStubs macro.
|
||||
*
|
||||
* Results:
|
||||
* Returns the actual version of the Tdbc package that has been
|
||||
* loaded, or NULL if an error occurs.
|
||||
*
|
||||
* Side effects:
|
||||
* Sets the Stubs table pointer, or stores an error message in the
|
||||
* interpreter's result.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
const char*
|
||||
TdbcInitializeStubs(
|
||||
Tcl_Interp* interp, /* Tcl interpreter */
|
||||
const char* version, /* Version of TDBC requested */
|
||||
int epoch, /* Epoch number of the Stubs table */
|
||||
int revision /* Revision number within the epoch */
|
||||
) {
|
||||
const int exact = 0; /* Set this to 1 to require exact version */
|
||||
const char* packageName = "tdbc";
|
||||
/* Name of the package */
|
||||
const char* errorMsg = NULL;
|
||||
/* Error message if an error occurs */
|
||||
ClientData clientData = NULL;
|
||||
/* Client data for the package */
|
||||
const char* actualVersion; /* Actual version of the package */
|
||||
const TdbcStubs* stubsPtr; /* Stubs table for the public API */
|
||||
|
||||
/* Load the package */
|
||||
|
||||
actualVersion =
|
||||
Tcl_PkgRequireEx(interp, packageName, version, exact, &clientData);
|
||||
|
||||
if (clientData == NULL) {
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_AppendResult(interp, "Error loading ", packageName, " package: "
|
||||
"package not present, incomplete or misconfigured.",
|
||||
(char*) NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Test that all version information matches the request */
|
||||
|
||||
if (actualVersion == NULL) {
|
||||
return NULL;
|
||||
} else {
|
||||
stubsPtr = (const TdbcStubs*) clientData;
|
||||
if (stubsPtr->epoch != epoch) {
|
||||
errorMsg = "mismatched epoch number";
|
||||
} else if (stubsPtr->revision < revision) {
|
||||
errorMsg = "Stubs table provides too early a revision";
|
||||
} else {
|
||||
|
||||
/* Everything is ok. Return the package information */
|
||||
|
||||
tdbcStubsPtr = stubsPtr;
|
||||
return actualVersion;
|
||||
}
|
||||
}
|
||||
|
||||
/* Try to explain what went wrong when a mismatched version is found. */
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_AppendResult(interp, "Error loading ", packageName, " package "
|
||||
"(requested version \"", version, "\", loaded version \"",
|
||||
actualVersion, "\"): ", errorMsg, (char*) NULL);
|
||||
return NULL;
|
||||
|
||||
}
|
||||
218
pkgs/tdbc1.1.2/generic/tdbcTokenize.c
Normal file
218
pkgs/tdbc1.1.2/generic/tdbcTokenize.c
Normal file
@@ -0,0 +1,218 @@
|
||||
/*
|
||||
* tdbcTokenize.c --
|
||||
*
|
||||
* Code for a Tcl command that will extract subsitutable parameters
|
||||
* from a SQL statement.
|
||||
*
|
||||
* Copyright (c) 2007 by D. Richard Hipp.
|
||||
* Copyright (c) 2010, 2011 by Kevin B. Kenny.
|
||||
*
|
||||
* Please refer to the file, 'license.terms' for the conditions on
|
||||
* redistribution of this file and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*
|
||||
* RCS: @(#) $Id$
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#include "tdbcInt.h"
|
||||
#include <ctype.h>
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* Tdbc_TokenizeSql --
|
||||
*
|
||||
* Tokenizes a SQL statement.
|
||||
*
|
||||
* Results:
|
||||
* Returns a zero-reference Tcl object that gives the statement in
|
||||
* tokenized form, or NULL if an error occurs.
|
||||
*
|
||||
* Side effects:
|
||||
* If an error occurs, and 'interp' is not NULL, stores an error
|
||||
* message in the interpreter result.
|
||||
*
|
||||
* This is demonstration code for a TCL command that will extract
|
||||
* host parameters from an SQL statement.
|
||||
*
|
||||
* A "host parameter" is a variable within the SQL statement.
|
||||
* Different systems do host parameters in different ways. This
|
||||
* tokenizer recognizes three forms:
|
||||
*
|
||||
* $ident
|
||||
* :ident
|
||||
* @ident
|
||||
*
|
||||
* In other words, a host parameter is an identifier proceeded
|
||||
* by one of the '$', ':', or '@' characters.
|
||||
*
|
||||
* This function returns a Tcl_Obj representing a list. The
|
||||
* concatenation of the returned list will be equivalent to the
|
||||
* input string. Each element of the list will be either a
|
||||
* host parameter, a semicolon, or other text from the SQL
|
||||
* statement.
|
||||
*
|
||||
* Example:
|
||||
*
|
||||
* tokenize_sql {SELECT * FROM table1 WHERE :name='bob';}
|
||||
*
|
||||
* Resulting in:
|
||||
*
|
||||
* {SELECT * FROM table1 WHERE } {:name} {=} {'bob'} {;}
|
||||
*
|
||||
* The tokenizer knows about SQL comments and strings and will
|
||||
* not mistake a host parameter or semicolon embedded in a string
|
||||
* or comment as a real host parameter or semicolon.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
TDBCAPI Tcl_Obj*
|
||||
Tdbc_TokenizeSql(
|
||||
Tcl_Interp *interp,
|
||||
const char* zSql
|
||||
){
|
||||
Tcl_Obj *resultPtr;
|
||||
int i;
|
||||
|
||||
resultPtr = Tcl_NewObj();
|
||||
for(i = 0; zSql[i]; i++){
|
||||
switch( zSql[i] ){
|
||||
|
||||
/* Skip over quoted strings. Strings can be quoted in several
|
||||
** ways: '...' "..." [....]
|
||||
*/
|
||||
case '\'':
|
||||
case '"':
|
||||
case '[': {
|
||||
int endChar = zSql[i];
|
||||
if (endChar == '[') endChar = ']';
|
||||
for(i++; zSql[i] && zSql[i]!=endChar; i++){}
|
||||
if (zSql[i] == 0) i--;
|
||||
break;
|
||||
}
|
||||
|
||||
/* Skip over SQL-style comments: -- to end of line
|
||||
*/
|
||||
case '-': {
|
||||
if (zSql[i+1] == '-') {
|
||||
for(i+=2; zSql[i] && zSql[i]!='\n'; i++){}
|
||||
if (zSql[i] == 0) i--;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
/* Skip over C-style comments
|
||||
*/
|
||||
case '/': {
|
||||
if (zSql[i+1] == '*') {
|
||||
i += 3;
|
||||
while (zSql[i] && (zSql[i]!='/' || zSql[i-1]!='*')) {
|
||||
i++;
|
||||
}
|
||||
if (zSql[i] == 0) i--;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
/* Break up multiple SQL statements at each semicolon */
|
||||
case ';': {
|
||||
if (i>0 ){
|
||||
Tcl_ListObjAppendElement(interp, resultPtr,
|
||||
Tcl_NewStringObj(zSql, i));
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, resultPtr,
|
||||
Tcl_NewStringObj(";",1));
|
||||
zSql += i + 1;
|
||||
i = -1;
|
||||
break;
|
||||
}
|
||||
|
||||
/* Any of the characters ':', '$', or '@' which is followed
|
||||
** by an alphanumeric or '_' and is not preceded by the same
|
||||
** is a host parameter. A name following a doubled colon '::'
|
||||
** is also not a host parameter.
|
||||
*/
|
||||
case ':': {
|
||||
if (i > 0 && zSql[i-1] == ':') break;
|
||||
}
|
||||
/* fallthru */
|
||||
|
||||
case '$':
|
||||
case '@': {
|
||||
if (i>0 && (isalnum((unsigned char)(zSql[i-1]))
|
||||
|| zSql[i-1]=='_')) break;
|
||||
if (!isalnum((unsigned char)(zSql[i+1]))
|
||||
&& zSql[i+1]!='_') break;
|
||||
if (i>0 ){
|
||||
Tcl_ListObjAppendElement(interp, resultPtr,
|
||||
Tcl_NewStringObj(zSql, i));
|
||||
zSql += i;
|
||||
}
|
||||
i = 1;
|
||||
while (zSql[i] && (isalnum((unsigned char)(zSql[i]))
|
||||
|| zSql[i]=='_')) {
|
||||
i++;
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, resultPtr,
|
||||
Tcl_NewStringObj(zSql, i));
|
||||
zSql += i;
|
||||
i = -1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (i>0) {
|
||||
Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(zSql, i));
|
||||
}
|
||||
return resultPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* TdbcTokenizeObjCmd --
|
||||
*
|
||||
* Tcl command to tokenize a SQL statement.
|
||||
*
|
||||
* Usage:
|
||||
* ::tdbc::tokenize statement
|
||||
*
|
||||
* Results:
|
||||
* Returns a list as from passing the given statement to
|
||||
* Tdbc_TokenizeSql above.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
MODULE_SCOPE int
|
||||
TdbcTokenizeObjCmd(
|
||||
ClientData dummy, /* Unused */
|
||||
Tcl_Interp* interp, /* Tcl interpreter */
|
||||
int objc, /* Parameter count */
|
||||
Tcl_Obj *const objv[] /* Parameter vector */
|
||||
) {
|
||||
Tcl_Obj* retval;
|
||||
(void)dummy;
|
||||
|
||||
/* Check param count */
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "statement");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* Parse the statement */
|
||||
|
||||
retval = Tdbc_TokenizeSql(interp, Tcl_GetString(objv[1]));
|
||||
if (retval == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* Return the tokenized statement */
|
||||
|
||||
Tcl_SetObjResult(interp, retval);
|
||||
return TCL_OK;
|
||||
|
||||
}
|
||||
Reference in New Issue
Block a user