1 /*
2 * tdbcStubLib.c --
3 *
4 * Stubs table initialization wrapper for Tcl DataBase Connectivity
5 * (TDBC).
6 *
7 * Copyright (c) 2008 by Kevin B. Kenny.
8 *
9 * Please refer to the file, 'license.terms' for the conditions on
10 * redistribution of this file and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id$
13 *
14 *-----------------------------------------------------------------------------
15 */
16
17 #include <tcl.h>
18
19 #define USE_TDBC_STUBS 1
20 #include "tdbc.h"
21
22 MODULE_SCOPE const TdbcStubs *tdbcStubsPtr;
23
24 const TdbcStubs *tdbcStubsPtr = NULL;
25
26 /*
27 *-----------------------------------------------------------------------------
28 *
29 * TdbcInitializeStubs --
30 *
31 * Loads the Tdbc package and initializes its Stubs table pointer.
32 *
33 * Client code should not call this function directly; instead, it should
34 * use the Tdbc_InitStubs macro.
35 *
36 * Results:
37 * Returns the actual version of the Tdbc package that has been
38 * loaded, or NULL if an error occurs.
39 *
40 * Side effects:
41 * Sets the Stubs table pointer, or stores an error message in the
42 * interpreter's result.
43 *
44 *-----------------------------------------------------------------------------
45 */
46
47 const char*
TdbcInitializeStubs(Tcl_Interp * interp,const char * version,int epoch,int revision)48 TdbcInitializeStubs(
49 Tcl_Interp* interp, /* Tcl interpreter */
50 const char* version, /* Version of TDBC requested */
51 int epoch, /* Epoch number of the Stubs table */
52 int revision /* Revision number within the epoch */
53 ) {
54 const int exact = 0; /* Set this to 1 to require exact version */
55 const char* packageName = "tdbc";
56 /* Name of the package */
57 const char* errorMsg = NULL;
58 /* Error message if an error occurs */
59 ClientData clientData = NULL;
60 /* Client data for the package */
61 const char* actualVersion; /* Actual version of the package */
62 const TdbcStubs* stubsPtr; /* Stubs table for the public API */
63
64 /* Load the package */
65
66 actualVersion =
67 Tcl_PkgRequireEx(interp, packageName, version, exact, &clientData);
68
69 if (clientData == NULL) {
70 Tcl_ResetResult(interp);
71 Tcl_AppendResult(interp, "Error loading ", packageName, " package: "
72 "package not present, incomplete or misconfigured.",
73 (char*) NULL);
74 return NULL;
75 }
76
77 /* Test that all version information matches the request */
78
79 if (actualVersion == NULL) {
80 return NULL;
81 } else {
82 stubsPtr = (const TdbcStubs*) clientData;
83 if (stubsPtr->epoch != epoch) {
84 errorMsg = "mismatched epoch number";
85 } else if (stubsPtr->revision < revision) {
86 errorMsg = "Stubs table provides too early a revision";
87 } else {
88
89 /* Everything is ok. Return the package information */
90
91 tdbcStubsPtr = stubsPtr;
92 return actualVersion;
93 }
94 }
95
96 /* Try to explain what went wrong when a mismatched version is found. */
97
98 Tcl_ResetResult(interp);
99 Tcl_AppendResult(interp, "Error loading ", packageName, " package "
100 "(requested version \"", version, "\", loaded version \"",
101 actualVersion, "\"): ", errorMsg, (char*) NULL);
102 return NULL;
103
104 }
105