105 lines
2.9 KiB
C
105 lines
2.9 KiB
C
/*
|
|
* 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;
|
|
|
|
}
|