File: tdbcStubLib.c

package info (click to toggle)
tdbc 1.1.1-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 928 kB
  • sloc: sh: 2,256; tcl: 1,146; ansic: 886; makefile: 61
file content (104 lines) | stat: -rw-r--r-- 2,982 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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;

}