Import Tcl 8.6.12

This commit is contained in:
Steve Dower
2021-11-08 17:30:58 +00:00
parent 1aadb2455c
commit 674867e7e6
608 changed files with 78089 additions and 60360 deletions

625
pkgs/tdbc1.1.3/ChangeLog Normal file
View File

@@ -0,0 +1,625 @@
2015-01-23 Don Porter <dgp@users.sourceforge.net>
* generic/tdbc.h: Advance version number to 1.0.3
* configure.in:
* README:
* configure: autoconf-2.69
2014-10-23 Don Porter <dgp@users.sourceforge.net>
* generic/tdbc.h: Advance version number to 1.0.2
* configure.in:
* README:
* configure: autoconf-2.59
* doc/*.[3n]: [Bug 00b792] OpenBSD friendly docs.
2014-08-14 Don Porter <dgp@users.sourceforge.net>
* generic/tdbc.h: Advance version number to 1.0.1
* configure.in:
* README:
* configure: autoconf-2.59
2012-12-05 Harald Oehlmann <oehhar@users.sf.net>
* win/Makefile.vc: Install headers, stub file and fixed tdbcConfig.sh.
2012-11-08 Don Porter <dgp@users.sourceforge.net>
* generic/tdbc.h: Advance version number to 1.0.0
* configure.in:
* README:
* configure: autoconf-2.59
2012-08-17 Jan Nijtmans <nijtmans@users.sf.net>
* win/nmakehlp.c: Add "-V<num>" option, in order to be able
to detect partial version numbers.
2012-07-26 Jan Nijtmans <jan.nijtmans@gmail.com>
* tclconfig/install-sh: Update to latest TEA
* tclconfig/tcl.m4:
* configure: autoconf-2.59
2012-07-17 Jan Nijtmans <nijtmans@users.sf.net>
* win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails
2012-07-12 Kevin B. Kenny <kennykb@acm.org>
* generic/tdbc.h:
* generic/tdbc.c: Restored Unix buildability for 'tdbc', and
removed code that swizzles TCL_STORAGE_CLASS
in favour of avoiding Tcl's EXTERN macro.
2012-06-10 Jan Nijtmans <jan.nijtmans@gmail.com>
* configure.in:0
* generic/tdbc.decls:
* generic/tdbc.h:
* tdbcConfig.sh.in:
* tools/genStubs.tcl: FRQ-b4029dc351: make all TDBC API functions
MODULE_SCOPE
* generic/tdbcDecls.h:
* generic/tdbcStubInit.c:
* generic/tdbcStubLib.c: Regen
* configure: autoconf-2.59
2012-06-08 Jan Nijtmans <jan.nijtmans@gmail.com>
* tclconfig/ChangeLog:
* tclconfig/tcl.m4: Update to latest TEA
* configure: autoconf-2.59
2011-08-01 Don Porter <dgp@users.sourceforge.net>
* win/rules.vc: Extend support to MSVC10. Thanks to Twylite.
2011-07-19 Kevin B. Kenny <kennykb@acm.org>
* generic/tdbc.h: Advance version number to 1.0b17
* configure.in:
* README:
* configure: autoconf-2.59
2011-07-18 Don Porter <dgp@users.sourceforge.net>
* configure.in: Update to latest TEA 3.9 revisions.
* Makefile.in:
* tclconfig/*:
* configure: autoconf-2.59
2011-04-12 Kevin B. Kenny <kennykb@acm.org>
* generic/tdbcTokenize.c (Tdbc_Tokenize):
Added a special case for PostgreSQL's typecast syntax
:var::type. (Allows us to do things like 'select :var::type'
without tripping over 'cannot determine data type' errors.
* tests/tokenize.test (tokenize-2.1):
Added a test case for the above.
2011-02-21 Kevin B. Kenny <kennykb@acm.org>
* library/tdbc.tcl (tdbc::connection transaction):
Modified the 'transaction' method to attempt to rollback
if a commit fails, in order to clear out a failed
transaction.
* doc/tdbc_connection.n:
Modified the 'tdbc_connection' manual page to reflect the
above behaviour. (Bug [d7dd97c402])
2011-02-20 Kevin B. Kenny <kennykb@acm.org>
* library/tdbc.tcl:
Changed 'foreach' method on the connection, statement
and result set objects so that 'foreach' and 'allrows'
will iterate over multiple result sets. Added
default 'nextresults' method (does nothing, reports
that no further results are available) and
'outputparams' method (does nothing, reports no
output parameters) to the base 'resultset' class so
that drivers that lack multiple-results functionality
need not implement these.
* doc/tdbc_resultset.n:
Added description of the 'nextresults' method,
and its effect on 'allrows' and 'foreach'
2011-01-26 Kevin B. Kenny <kennykb@acm.org>
* doc/tdbc.n, doc/tdbc_connection.n, doc/tdbc_mapSqlState.n:
* doc/tdbc_resultset.n, doc/tdbc_statement.n, doc/tdbc_tokenize.n:
Added empty comment at the start of each manpage because 'man'
interprets comments there as directives. Thanks to Konstantin
Kohmoutov for reporting and diagnosing this error.
2011-01-23 Kevin B. Kenny <kennykb@acm.org>
* configure.in: Changed to put the absolute path name of the
source directory in tdbc_INCLUDE_PATH so that
drivers will build correctly against an uninstalled
tdbc. Thanks to Konstantin Khomoutov for reporting
this error.
* configure: autoconf2.59
2010-09-03 Kevin B. Kenny <kennykb@acm.org>
* doc/tdbc_connection.n:
Added description of the new 'primarykeys' and
'foreignkeys' methods to the manual.
* library/tdbc.tcl:
Revised the 'keySequence' column in 'foreignkeys'
to be 'ordinalPosition' instead, for consistency
with 'primarykeys'
* configure.in:
* Makefile.in:
* pkgIndex.tcl.in (new file):
* README:
* tdbcConfig.sh.in:
* generic/tdbc.h:
* tclconfig/: Upgraded the build to use TEA 3.9. Changed the
approach to pkgIndex.tcl generation. (It's now built
at configure time, rather than from the Makefile.)
Advanced version number to 1.0b16.
* configure: autoconf 2.59
2010-06-19 Kevin B. Kenny <kennykb@acm.org>
* Makefile.in: Revised the code at the suggestion
* generic/tdbc.c (Tdbc_Init): of Andreas Kupries to avoid using
* tests/all.tcl: 'tcl_findLibrary' and instead execute
* tests/tdbc.test: both 'source' and 'load' commands from
* tests/tokenize.test: 'pkgIndex.tcl'. Revised the 'make test'
rule, and the test scripts, to
test successfully under the new regime.
Thanks to Andreas for providing the
original patch, and to Joe English
for providing ideas for simplifying
and repairing 'make test' under the
new regime.
2010-05-23 Kevin B. Kenny <kennykb@acm.org>
* library/tdbc.tcl: Add methods 'primarykeys' and 'foreignkeys'
on the 'tdbc::connection' object
to inspect database structure, and methods
'BuildPrimaryKeysStatement' and
'BuildForeignKeysStatement' to initialize the
'statement' objects that the methods use.
2010-05-10 Kevin B. Kenny <kennykb@acm.org>
* aclocal.m4: Add a TEAX_PATH_LINE rule to simplify emitting the
stub library paths in tdbcConfig.sh.
* tools/genExtStubs.tcl (ParseImports, writeStubDeclarations):
Add a new '* CONVENTION:' declaration to the
stub declarations that specifies the linkage
convention (e.g., __stdcall, WINAPI) that is
used in an imported library.
* configure.in: Add code to put the stub library path (build and
(install) in the tdbcConfig.sh file so that extensions
that import TDBC stubs can find it.
* generic/tdbc.h:
* README: Advance release to 1.0b15
2010-04-30 Kevin B. Kenny <kennykb@acm.org>
* Makefile.in: Updated 'make dist' to include the tools that
generate Stubs for external libs to support
run-time loading.
* configure.in: Removed a stray backslash that caused a shell
error message while configuring (and otherwise
appeared harmless).
* tools/genExtStubs.tcl: Adjusted to generate the Stubs files in
Unix format only to avoid DOS-formatted files
sneaking into the repository.
2010-04-26 Kevin B. Kenny <kennykb@acm.org>
* tools/genStubs.tcl: Revised 'genStubs' to write files in Unix
format (-translation lf) so that 'make genstubs'
generates the same output on Unix and Windows.
* tdbcDecls.h:
* tdbcStubInit.h: make genstubs
* README:
* configure.in:
* generic/tdbc.h: Advance patchlevel to 1.0b14.1
* configure: autoconf-2.59
2010-04-25 Kevin B. Kenny <kennykb@acm.org>
* configure.in: Advance release to 1.0b14
* generic/tdbc.h:
* README:
* configure: autoconf-2.59
2010-04-10 Kevin B. Kenny <kennykb@acm.org>
* configure.in:
* tdbcConfig.sh.in: Modified to pass the build-time and run-time
Tcl script library directories in tdbcConfig.sh,
so that driver tests can be run before tdbc itself
is installed.
* configure: autoconf 2.59
2010-04-08 Kevin B. Kenny <kennykb@acm.org>
* configure.in:
* tdbcConfig.sh.in: Revised names starting with TDBC_ to start
with tdbc_ in order to conform with the expectations of
TEA_LOAD_CONFIG. Added tdbc_BUILD_STUB_LIB_SPEC and
tdbc_BUILD_INCLUDE_SPEC to the generated tdbcConfig.sh so that
the Stubs library and include files for tdbc can be found in
the build directory as well as the install directory.
* configure: autoconf 2.59
2010-04-06 Kevin B. Kenny <kennykb@acm.org>
* doc/Tdbc_Init.3:
* doc/tdbc.n:
* doc/tdbc_connection.n:
* doc/tdbc_mapSqlState.n:
* doc/tdbc_connection.n:
* doc/tdbc_resultset.n:
* doc/tdbc_statement.n:
* doc/tdbc_tokenize.n: Merged changes from the trunk of the
Tcl source tree that make the documentation fit better with the
Tcl manuals. (Tickets [fcc8231b9e], [02c0131ba1] and [18c90402fb]).
* Makefile.in: Corrected a misinstallation of the manual
pages in the case where $(MANDIR)/man3 doesn't exist.
(Ticket [99e97fb098])
* generic/tdbc.c:
* generic/tdbcDecls.h:
* generic/tdbcStubInit.c:
* generic/tdbcStubLib.c:
* tools/genStubs.tcl: Made the Stubs tables (and a few other constants
formally 'const'. (Ticket [cf7bc364cc])
2010-03-14 Kevin B. Kenny <kennykb@acm.org>
* tools/genExtStubs.tcl (new file): Added a tool so that
drivers can resolve imports into Stubs tables at run time, allowing
them to avoid compile-dependencies on the respective databases'
build systems.
2010-03-01 Kevin B. Kenny <kennykb@acm.org>
* tools/tdbc-man2html.tcl: Added SourceForge logo to the HTML
documentation, to comply with requirements for hosting the
documentation at SourceForge.
2009-09-20 Kevin B. Kenny <kennykb@acm.org>
* tools/tdbc-man2html.tcl: Added tdbcpostgres to the documentation set.
* generic/tdbc.h:
* configure.in:
* README: Advance version number to 1.0b13
* configure: autoconf-2.59
2009-07-02 Kevin B. Kenny <kennykb@acm.org>
* generic/tdbc.h:
* configure.in:
* README: Advance version number to 1.0b12
* configure: autoconf-2.59
2009-05-29 Kevin B. Kenny <kennykb@acm.org>
* generic/tdbc.h:
* configure.in:
* README: Advance version number to 1.0b11
* configure: autoconf-2.59
2009-04-21 Kevin B. Kenny <kennykb@acm.org>
* Makefile.in (dist): Rename Tdbc.3 to Tdbc_Init.3 to avoid
a file naming conflict in HTML documentation.
* doc/Tdbc_Init.3: Renamed from Tdbc.3. Added IGNORE arond macros
* doc/tbdc.n:
* doc/tdbc_connection.n:
* doc/tdbc_mapSqlState.n:
* doc/tdbc_resultset.n:
* doc/tdbc_statement.n:
* doc/tdbc_tokenize.n: Added IGNORE / END IGNORE around macros.
* tdbc_mapSqlState.n: Moved the .BS comment to where it belongs.
* tools/tdbc-man2html.tcl: Added .3 man pages to the build. Added a
'\" IGNORE ... \'" END IGNORE directive so that *roff macros
can be skipped reliably (needed in order to handle the .AS and
.AP macros)
Retagged 1.0b10 with these changes.
2009-04-20 Kevin B. Kenny <kennykb@acm.org>
* Makefile.in (dist): Added new man pages to the 'dist' rule.
Retagged 1.0b10 with these changes.
2009-04-19 Kevin B. Kenny <kennykb@acm.org>
* Makefile.in (install-doc): Added missing commands to install
section 3 man pages
2009-04-18 Kevin B. Kenny <kennykb@acm.org>
* doc/Tdbc.3: Added manual page for C API to TDBC
* doc/tdbc.n:
* doc/tdbc_connection.n: Changed 'starttransaction' to
'begintransaction'. Corrected the 'foreach'
syntax
* doc/tdbc_statement.n: Corrected the 'foreach' syntax.
* doc/tdbc_resultset.n:
* doc/tdbc_tokenize.n: Corrected tabs, margins, etc. to Tcl standard.
* doc/tdbc_mapSqlState.n: Added documentation for tdbc::mapSqlState.
2009-04-16 Kevin B. Kenny <kennykb@acm.org>
* generic/tdbc.h:
* configure.in:
* README: Advance version number to 1.0b10
* configure: autoconf-2.59
2009-03-03 Kevin B. Kenny <kennykb@acm.org>
* tdbc.tcl: Replaced the 'statementClass' and 'resultSetClass'
instance variables with 'statementCreate and 'resultSetCreate'
methods (expected to forward to the appropriate constructors).
Replaced 'my variable' usage with 'variable' declarations at
class level. Removed various bits of debugging output.
2009-02-16 Kevin B. Kenny <kennykb@acm.org>
* generic/tdbc.h:
* configure.in:
* README: Advance version number to 1.0b9
* configure: autoconf-2.59
2009-02-15 Kevin B. Kenny <kennykb@acm.org>
* README: Fix several editorial details. Thanks to Larry Virden
for the patch. [Ticket e33df9041f]
2009-02-14 Kevin B. Kenny <kennykb@acm.org>
* tools/tdbc-man2html.tcl (new file):
First cut at automating HTML generation for the manual
pages.
* doc/tdbc.n:
* doc/tdbc_connection.n:
* doc/tdbc_resultset.n:
* doc/tdbc_statement.n:
* doc/tdbc_tokenize.n: Formatting changes to the man pages so that
man2html works.
* generic/tdbc.h:
* configure.in:
* README: Advance version number to 1.0b8
* configure: autoconf-2.59
2009-02-01 Kevin B. Kenny <kennykb@acm.org>
* Makefile.in: Modified 'pkgIndex.tcl' rule to allow for
requiring the TclOO package in 8.5, and not
in 8.6, while allowing both versions.
Modified 'clean' to clean up 'pkgIndex.tcl',
and added the version dependencies as
TCL_VERSION_REQ, TCL_VERSION_DESIRED,
and TCLOO_VERSION_REQ. Added the new
'tests/tdbc.test' to 'make dist'.
* tests/tdbc.test: Removed explicit check for {TCL WRONGARGS}
in ::errorCode, to restore 8.5 compatibility.
2009-01-31 Kevin B. Kenny <kennykb@acm.org>
* README:
* configure.in:
* generic/tdbc.h: Advanced version to 1.0b7
* configure: autoconf-2.59
* generic/tdbc.c: Added a 'tdbc::mapSqlState' command that
makes a key suitable for 'errorCode' from
a SQLSTATE.
* generic/tdbc.decls: Added Tdbc_MapSqlState, C API to 'mapSqlState'
* generic/tdbcDecls.h:
* generic/tdbcStubInit.c: Regenerated
* library/tdbc.tcl: Modified so that all errors return a proper
errorCode
* tests/tdbc.test: Added tests for tdbc::mapSqlState
2009-01-07 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc: Needed quotes around $(SCRIPT_INSTALL_DIR)
in the install-libraries target else directory with spaces
in it failed.
2009-01-05 Kevin B. Kenny <kennykb@acm.org>
* README: Advanced version to 1.0b6
* configure.in:
* generic/tdbc.h:
* configure: autoconf-2.59
2009-01-04 Kevin B. Kenny <kennykb@acm.org>
* README: Advanced version to 1.0b5
* configure.in:
* generic/tdbc.h:
* configure: autoconf-2.59
2008-12-30 Kevin B. Kenny <kennykb@acm.org>
* README: Advanced version to 1.0b4
* configure.in:
* generic/tdbc.h:
* configure: autoconf-2.59
* Makefile.in: Changes to 'make dist' to include all files
explicitly - avoids distributing Emacs backups,
cores, etc. D'oh!
* Makefile.in:
* README:
* configure.in:
* generic/tdbc.c:
* generic/tdbc.decls:
* generic/tdbc.h:
* generic/tdbcDecls.h:
* generic/tdbcInt.h:
* generic/tdbcStubInit.c:
* generic/tdbcStubLib.c:
* generic/tdbcTokenize.c:
* library/tdbc.tcl:
* tdbcConfig.sh.in:
* tests/all.tcl:
* win/makefile.vc:
* win/nmakehlp.c:
* win/rules.vc: Many trivial changes (e.g. RCS ID strings)
to avoid merge conflicts when importing to
Tcl's vendor branch.
* generic/tdbcStubInit.c: Added MODULE_SCOPE to the tdbcStubs
declaration to correct a linkera error on
linux-x64.
* generic/tdbcTokenize.c: Added explicit casts to the 'ctype' macros
to guard against possible signed characters.
2008-12-21 Kevin B. Kenny <kennykb@acm.org>
* win/makefile.vc: Added files for a MSVC build system.
* win/rules.vc: Thanks to Pat Thoyts <patthoyts@users.sf.net>
* win/versions.vc: for developing these files.n
* win/tdbc.rc:
2008-12-20 Kevin B. Kenny <kennykb@acm.org>
sign manifest
2008-12-20 Daniel Steffen <das@users.sourceforge.net>
* Makefile.in: use INSTALL_LIBRARY instead of INSTALL_PROGRAM to
install libraries, avoids breakage from tcl's install-strip when
built as a bundled package.
* tclconfig/ChangeLog: update to latest TEA from tcl CVS, which has
* tclconfig/tcl.m4: Jan's 2008-12-19 changes (tcl.m4 r1.127)
* configure.in: update TEA_INIT for TEA 3.7
* configure: autoconf-2.59
2008-12-19 Kevin Kenny <kennykb@acm.org>
* aclocal.m4: Changed to make ADD_MANIFEST default to ':'
rather than an empty string, to silence a warning on BSD compiles.
Thanks to Stu Cassoff for reporting this bug.
* configure: autoconf-2.59
2008-12-19 Jan Nijtmans <nijtmans@users.sf.net>
* tclconfig/tcl.m4: fix odbc build on mingw32
* configure: autoconf-2.59
2008-12-17 Don Porter <dgp@users.sourceforge.net>
* README: New file.
* configure: autoconf-2.59
2008-12-07 Kevin B. Kenny <kennykb@acm.org>
* doc/tdbc.n: Added a file omitted from the 2008-11-30 commit.
* configure.in:
* generic/tdbc.h: Advanced version number to 1.0b1 in preparation
for release.
* configure: Autoconf 2.61
2008-11-30 Kevin B. Kenny <kennykb@acm.org>
* Makefile.in: Removed nagging reminder about documentation.
* configure.in: Advanced revision to 0.2
* configure: Autoconf 2.61
* doc/tdbc.n: First cut at a set of man
* doc/tdbc_connection.n: pages for TDBC. Redactors
* doc/tdbc_resultSet.n: and proofreaders are
* doc/tdbc_statement.n: welcome to submit
* doc/tdbc_tokenize.n: improvements.
* generic/tdbc.c: Lowercased the package name 'tdbc'
* generic/tdbc.h: Advanced patchlevel to 0.2a1
* generic/tdbcDecls.h: Lowercased the package name 'tdbc'
* generic/tdbcStubLib.c: Lowercased the package name 'tdbc'
* tests/tokenize.test: Lowercased the package name 'tdbc'
2008-11-22 Kevin B. Kenny <kennykb@acm.org>
* configure.in: Changed to make TDBC buildable on 8.6 without
needing to install a dummy tclooConfig.sh.
* configure: Autoconf 2.61.
2008-10-23 Kevin B. Kenny <kennykb@acm.org>
* library/tdbc.tcl: Fixed the constructor of tdbc::resultset
to *not* have an empty constructor (which is interpreted by
tcloo as deleting the constructor!). Attempted to sign the commit
with a key that *isn't* about to expire. ;)
2008-06-11 Kevin B. Kenny <kennykb@acm.org>
* library/tdbc.tcl: Split [$resultset nextrow] into two primitive
methods: [$resultset nextlist] and [$resultset nextdict]. Added
a [$resultset nextrow] method that delegates to one or the other
of these.
2008-05-24 Kevin B. Kenny <kennykb@acm.org>
* configure.in: Changed configuration to use TEA_PATH_CONFIG to
* aclocal.m4: locate tcloo. Removed the local code that did it
from aclocal.m4.
* configure: Autoconf 2.61
2008-05-13 Kevin B. Kenny <kennykb@acm.org>
* library/tdbc.tcl: Silenced tracing.
2008-05-10 Kevin B. Kenny <kennykb@acm.org>
* library/tdbc.tcl: Simplified processing of several callbacks
by eliminating a useless [namespace code my] in favor of [self].
Added tracing to attempt to track down a bug in oo's method
resolution.
2008-04-30 Kevin B. Kenny <kennykb@acm.org>
* aclocal.m4:
* configure:
* configure.in:
* license.terms:
* Makefile.in:
* tdbcConfig.sh.in:
* generic/tdbc.c:
* generic/tdbc.decls:
* generic/tdbc.h:
* generic/tdbcDecls.h:
* generic/tdbcInt.h:
* generic/tdbcStubInit.c:
* generic/tdbcStubLib.c:
* generic/tdbcTokenize.c:
* library/tdbc.tcl:
* tclconfig/ChangeLog:
* tclconfig/install-sh:
* tclconfig/README.txt:
* tclconfig/tcl.m4:
* tests/all.tcl:
* tests/tokenize.test:
* tools/genStubs.tcl:
Initial commit of the "tdbc" package - the generic base class support
for Tcl Data Base Connectivity (TDBC) - TIP #308.

502
pkgs/tdbc1.1.3/Makefile.in Normal file
View File

@@ -0,0 +1,502 @@
# Makefile.in --
#
# This file is a Makefile for Sample TEA Extension. If it has the name
# "Makefile.in" then it is a template for a Makefile; to generate the
# actual Makefile, run "./configure", which is a configuration script
# generated by the "autoconf" program (constructs like "@foo@" will get
# replaced in the actual Makefile.
#
# Copyright (c) 1999 Scriptics Corporation.
# Copyright (c) 2002-2005 ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#========================================================================
# Add additional lines to handle any additional AC_SUBST cases that
# have been added in a customized configure script.
#========================================================================
#SAMPLE_NEW_VAR = @SAMPLE_NEW_VAR@
#========================================================================
# Nothing of the variables below this line should need to be changed.
# Please check the TARGETS section below to make sure the make targets
# are correct.
#========================================================================
#========================================================================
# The names of the source files is defined in the configure script.
# The object files are used for linking into the final library.
# This will be used when a dist target is added to the Makefile.
# It is not important to specify the directory, as long as it is the
# $(srcdir) or in the generic, win or unix subdirectory.
#========================================================================
PKG_SOURCES = @PKG_SOURCES@
PKG_OBJECTS = @PKG_OBJECTS@
PKG_STUB_SOURCES = @PKG_STUB_SOURCES@
PKG_STUB_OBJECTS = @PKG_STUB_OBJECTS@
#========================================================================
# PKG_TCL_SOURCES identifies Tcl runtime files that are associated with
# this package that need to be installed, if any.
#========================================================================
PKG_TCL_SOURCES = @PKG_TCL_SOURCES@
#========================================================================
# This is a list of public header files to be installed, if any.
#========================================================================
PKG_HEADERS = @PKG_HEADERS@
#========================================================================
# "PKG_LIB_FILE" refers to the library (dynamic or static as per
# configuration options) composed of the named objects.
#========================================================================
PKG_LIB_FILE = @PKG_LIB_FILE@
PKG_LIB_FILE8 = @PKG_LIB_FILE8@
PKG_LIB_FILE9 = @PKG_LIB_FILE9@
PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@
lib_BINARIES = $(PKG_LIB_FILE) $(PKG_STUB_LIB_FILE)
BINARIES = $(lib_BINARIES)
SHELL = @SHELL@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
libdir = @libdir@
includedir = @includedir@
datarootdir = @datarootdir@
runstatedir = @runstatedir@
datadir = @datadir@
mandir = @mandir@
DESTDIR =
PKG_DIR = $(PACKAGE_NAME)$(PACKAGE_VERSION)
pkgdatadir = $(datadir)/$(PKG_DIR)
pkglibdir = $(libdir)/$(PKG_DIR)
pkgincludedir = $(includedir)/$(PKG_DIR)
top_builddir = @abs_top_builddir@
INSTALL_OPTIONS =
INSTALL = @INSTALL@ $(INSTALL_OPTIONS)
INSTALL_DATA_DIR = @INSTALL_DATA_DIR@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_LIBRARY = @INSTALL_LIBRARY@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_VERSION = @PACKAGE_VERSION@
CC = @CC@
CFLAGS_DEFAULT = @CFLAGS_DEFAULT@
CFLAGS_WARNING = @CFLAGS_WARNING@
EXEEXT = @EXEEXT@
LDFLAGS_DEFAULT = @LDFLAGS_DEFAULT@
MAKE_LIB = @MAKE_LIB@
MAKE_STUB_LIB = @MAKE_STUB_LIB@
OBJEXT = @OBJEXT@
RANLIB = @RANLIB@
RANLIB_STUB = @RANLIB_STUB@
SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_LD = @SHLIB_LD@
SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
STLIB_LD = @STLIB_LD@
#TCL_DEFS = @TCL_DEFS@
TCL_BIN_DIR = @TCL_BIN_DIR@
TCL_SRC_DIR = @TCL_SRC_DIR@
#TK_BIN_DIR = @TK_BIN_DIR@
#TK_SRC_DIR = @TK_SRC_DIR@
# Not used, but retained for reference of what libs Tcl required
#TCL_LIBS = @TCL_LIBS@
#========================================================================
# TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our
# package without installing. The other environment variables allow us
# to test against an uninstalled Tcl. Add special env vars that you
# require for testing here (like TCLX_LIBRARY).
#========================================================================
EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR)
#EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR)
TCLLIBPATH = $(top_builddir)
TCLSH_ENV = TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library`
PKG_ENV = @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \
PATH="$(EXTRA_PATH):$(PATH)" \
TDBC_LIBRARY=`@CYGPATH@ $(srcdir)/library` \
TCLLIBPATH="$(TCLLIBPATH)"
TCLSH_PROG = @TCLSH_PROG@
TCLSH = $(TCLSH_ENV) $(PKG_ENV) $(TCLSH_PROG)
#WISH_ENV = TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library`
#WISH_PROG = @WISH_PROG@
#WISH = $(TCLSH_ENV) $(WISH_ENV) $(PKG_ENV) $(WISH_PROG)
SHARED_BUILD = @SHARED_BUILD@
INCLUDES = @PKG_INCLUDES@ @TCL_INCLUDES@
#INCLUDES = @PKG_INCLUDES@ @TCL_INCLUDES@ @TK_INCLUDES@ @TK_XINCLUDES@
PKG_CFLAGS = @PKG_CFLAGS@
# TCL_DEFS is not strictly need here, but if you remove it, then you
# must make sure that configure.ac checks for the necessary components
# that your library may use. TCL_DEFS can actually be a problem if
# you do not compile with a similar machine setup as the Tcl core was
# compiled with.
#DEFS = $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS)
DEFS = @DEFS@ $(PKG_CFLAGS) -DTCL_NO_DEPRECATED=1
# Move pkgIndex.tcl to 'BINARIES' var if it is generated in the Makefile
CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl tdbcConfig.sh
CLEANFILES = @CLEANFILES@
CPPFLAGS = @CPPFLAGS@
LIBS = @PKG_LIBS@ @LIBS@
AR = @AR@
CFLAGS = @CFLAGS@
LDFLAGS = @LDFLAGS@
LDFLAGS_DEFAULT = @LDFLAGS_DEFAULT@
COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) \
$(CFLAGS_DEFAULT) $(CFLAGS_WARNING) $(SHLIB_CFLAGS) $(CFLAGS)
GDB = gdb
VALGRIND = valgrind
VALGRINDARGS = --tool=memcheck --num-callers=8 --leak-resolution=high \
--leak-check=yes --show-reachable=yes -v
.SUFFIXES: .c .$(OBJEXT)
#========================================================================
# Start of user-definable TARGETS section
#========================================================================
#========================================================================
# TEA TARGETS. Please note that the "libraries:" target refers to platform
# independent files, and the "binaries:" target includes executable programs and
# platform-dependent libraries. Modify these targets so that they install
# the various pieces of your package. The make and install rules
# for the BINARIES that you specified above have already been done.
#========================================================================
all: binaries libraries doc
#========================================================================
# The binaries target builds executable programs, Windows .dll's, unix
# shared/static libraries, and any other platform-dependent files.
# The list of targets to build for "binaries:" is specified at the top
# of the Makefile, in the "BINARIES" variable.
#========================================================================
binaries: $(BINARIES)
libraries:
#========================================================================
# Your doc target should differentiate from doc builds (by the developer)
# and doc installs (see install-doc), which just install the docs on the
# end user machine when building from source.
#========================================================================
doc:
install: all install-binaries install-libraries install-doc
install-binaries: binaries install-lib-binaries install-bin-binaries
#========================================================================
# This rule installs platform-independent files, such as header files.
# The list=...; for p in $$list handles the empty list case x-platform.
#========================================================================
install-libraries: libraries
@$(INSTALL_DATA_DIR) "$(DESTDIR)$(includedir)"
@echo "Installing header files in $(DESTDIR)$(includedir)"
@list='$(PKG_HEADERS)'; for i in $$list; do \
echo "Installing $(srcdir)/$$i" ; \
$(INSTALL_DATA) $(srcdir)/$$i "$(DESTDIR)$(includedir)" ; \
done;
#========================================================================
# Install documentation. Unix manpages should go in the $(mandir)
# directory.
#========================================================================
install-doc: doc
@$(INSTALL_DATA_DIR) "$(DESTDIR)$(mandir)/man3" "$(DESTDIR)$(mandir)/mann"
@echo "Installing documentation in $(DESTDIR)$(mandir)"
@list='$(srcdir)/doc/*.3'; for i in $$list; do \
echo "Installing $$i"; \
$(INSTALL_DATA) $$i "$(DESTDIR)$(mandir)/man3" ; \
done
@list='$(srcdir)/doc/*.n'; for i in $$list; do \
echo "Installing $$i"; \
$(INSTALL_DATA) $$i "$(DESTDIR)$(mandir)/mann" ; \
done
test: binaries libraries
$(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) \
-load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
[list load `@CYGPATH@ $(PKG_LIB_FILE)` [string totitle $(PACKAGE_NAME)]]"
shell: binaries libraries
@$(TCLSH) $(SCRIPT)
gdb:
$(TCLSH_ENV) $(PKG_ENV) $(GDB) $(TCLSH_PROG) $(SCRIPT)
gdb-test: binaries libraries
$(TCLSH_ENV) $(PKG_ENV) $(GDB) \
--args $(TCLSH_PROG) `@CYGPATH@ $(srcdir)/tests/all.tcl` \
$(TESTFLAGS) -singleproc 1 \
-load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
[list load `@CYGPATH@ $(PKG_LIB_FILE)` [string totitle $(PACKAGE_NAME)]]"
valgrind: binaries libraries
$(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(TCLSH_PROG) \
`@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS)
valgrindshell: binaries libraries
$(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(TCLSH_PROG) $(SCRIPT)
depend:
#========================================================================
# $(PKG_LIB_FILE) should be listed as part of the BINARIES variable
# mentioned above. That will ensure that this target is built when you
# run "make binaries".
#
# The $(PKG_OBJECTS) objects are created and linked into the final
# library. In most cases these object files will correspond to the
# source files above.
#========================================================================
$(PKG_LIB_FILE): $(PKG_OBJECTS)
-rm -f $(PKG_LIB_FILE)
${MAKE_LIB}
$(RANLIB) $(PKG_LIB_FILE)
$(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS)
-rm -f $(PKG_STUB_LIB_FILE)
${MAKE_STUB_LIB}
$(RANLIB_STUB) $(PKG_STUB_LIB_FILE)
#========================================================================
# We need to enumerate the list of .c to .o lines here.
#
# In the following lines, $(srcdir) refers to the toplevel directory
# containing your extension. If your sources are in a subdirectory,
# you will have to modify the paths to reflect this:
#
# sample.$(OBJEXT): $(srcdir)/generic/sample.c
# $(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
#
# Setting the VPATH variable to a list of paths will cause the makefile
# to look into these paths when resolving .c to .obj dependencies.
# As necessary, add $(srcdir):$(srcdir)/compat:....
#========================================================================
VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx
.c.@OBJEXT@:
$(COMPILE) -c `@CYGPATH@ $<` -o $@
#========================================================================
# Distribution creation
# You may need to tweak this target to make it work correctly.
#========================================================================
#COMPRESS = tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar
COMPRESS = tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR)
DIST_ROOT = /tmp/dist
DIST_DIR = $(DIST_ROOT)/$(PKG_DIR)
DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644
DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755
dist-clean:
rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.*
dist: dist-clean
$(INSTALL_DATA_DIR) $(DIST_DIR)
# TEA files
$(DIST_INSTALL_DATA) $(srcdir)/Makefile.in \
$(srcdir)/aclocal.m4 $(srcdir)/configure.ac \
$(DIST_DIR)/
$(DIST_INSTALL_SCRIPT) $(srcdir)/configure $(DIST_DIR)/
$(INSTALL_DATA_DIR) $(DIST_DIR)/tclconfig
$(DIST_INSTALL_DATA) $(srcdir)/tclconfig/README.txt \
$(srcdir)/tclconfig/tcl.m4 $(srcdir)/tclconfig/install-sh \
$(DIST_DIR)/tclconfig/
# Extension files
$(DIST_INSTALL_DATA) \
$(srcdir)/ChangeLog \
$(srcdir)/license.terms \
$(srcdir)/README \
$(srcdir)/pkgIndex.tcl.in \
$(srcdir)/tdbcConfig.sh.in \
$(DIST_DIR)/
$(INSTALL_DATA_DIR) $(DIST_DIR)/doc
$(DIST_INSTALL_DATA) $(srcdir)/doc/tdbc.n \
$(srcdir)/doc/tdbc_connection.n \
$(srcdir)/doc/tdbc_resultset.n \
$(srcdir)/doc/tdbc_statement.n \
$(srcdir)/doc/tdbc_mapSqlState.n \
$(srcdir)/doc/tdbc_tokenize.n \
$(srcdir)/doc/Tdbc_Init.3 \
$(DIST_DIR)/doc/
$(INSTALL_DATA_DIR) $(DIST_DIR)/generic
$(DIST_INSTALL_DATA) $(srcdir)/generic/tdbc.c $(srcdir)/generic/tdbc.decls \
$(srcdir)/generic/tdbc.h $(srcdir)/generic/tdbcDecls.h \
$(srcdir)/generic/tdbcInt.h $(srcdir)/generic/tdbcStubInit.c \
$(srcdir)/generic/tdbcStubLib.c \
$(srcdir)/generic/tdbcTokenize.c $(DIST_DIR)/generic/
$(INSTALL_DATA_DIR) $(DIST_DIR)/library
$(DIST_INSTALL_DATA) $(srcdir)/library/tdbc.tcl $(DIST_DIR)/library/
$(INSTALL_DATA_DIR) $(DIST_DIR)/tests
$(DIST_INSTALL_DATA) $(srcdir)/tests/all.tcl \
$(srcdir)/tests/tdbc.test \
$(srcdir)/tests/tokenize.test \
$(DIST_DIR)/tests/
$(INSTALL_DATA_DIR) $(DIST_DIR)/tools
$(DIST_INSTALL_DATA) $(srcdir)/tools/genExtStubs.tcl \
$(srcdir)/tools/genStubs.tcl \
$(srcdir)/tools/tdbc-man2html.tcl \
$(DIST_DIR)/tools/
$(INSTALL_DATA_DIR) $(DIST_DIR)/win
$(DIST_INSTALL_DATA) $(srcdir)/win/makefile.vc $(srcdir)/win/nmakehlp.c \
$(srcdir)/win/targets.vc $(srcdir)/win/rules-ext.vc \
$(srcdir)/win/rules.vc $(srcdir)/win/tdbc.rc \
$(DIST_DIR)/win/
(cd $(DIST_ROOT); $(COMPRESS);)
#========================================================================
# How to rebuild the package's stub table.
#========================================================================
genstubs: $(srcdir)/tools/genStubs.tcl $(srcdir)/generic/tdbc.decls
@echo $(TCLSH_PROGRAM) $(srcdir)/tools/genStubs.tcl $(srcdir)/generic $(srcdir)/generic/tdbc.decls
@$(TCLSH) `@CYGPATH@ $(srcdir)/tools/genStubs.tcl` `@CYGPATH@ $(srcdir)/generic` `@CYGPATH@ $(srcdir)/generic/tdbc.decls`
#========================================================================
# End of user-definable section
#========================================================================
#========================================================================
# Don't modify the file to clean here. Instead, set the "CLEANFILES"
# variable in configure.ac
#========================================================================
clean:
-test -z "$(BINARIES)" || rm -f $(BINARIES)
-rm -f *.$(OBJEXT) core *.core
-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
distclean: clean
-rm -f *.tab.c
-rm -f $(CONFIG_CLEAN_FILES)
-rm -f config.cache config.log config.status
#========================================================================
# Install binary object libraries. On Windows this includes both .dll and
# .lib files. Because the .lib files are not explicitly listed anywhere,
# we need to deduce their existence from the .dll file of the same name.
# Library files go into the lib directory.
# In addition, this will generate the pkgIndex.tcl
# file in the install location (assuming it can find a usable tclsh shell)
#
# You should not have to modify this target.
#========================================================================
install-lib-binaries: binaries
@$(INSTALL_DATA_DIR) "$(DESTDIR)$(pkglibdir)"
@list='$(lib_BINARIES)'; for p in $$list; do \
if test -f $$p; then \
echo " $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p"; \
$(INSTALL_LIBRARY) $$p "$(DESTDIR)$(pkglibdir)/$$p"; \
ext=`echo $$p|sed -e "s/.*\.//"`; \
if test "x$$ext" = "xdll"; then \
lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \
if test -f $$lib; then \
echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib"; \
$(INSTALL_DATA) $$lib "$(DESTDIR)$(pkglibdir)/$$lib"; \
fi; \
fi; \
fi; \
done
@list='$(PKG_TCL_SOURCES)'; for p in $$list; do \
if test -f $(srcdir)/$$p; then \
destp=`basename $$p`; \
echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \
$(INSTALL_DATA) $(srcdir)/$$p "$(DESTDIR)$(pkglibdir)/$$destp"; \
fi; \
done
@if test "x$(SHARED_BUILD)" = "x1"; then \
echo " Install pkgIndex.tcl $(DESTDIR)$(pkglibdir)"; \
$(INSTALL_DATA) pkgIndex.tcl "$(DESTDIR)$(pkglibdir)"; \
fi
@echo " Install tdbcConfig.sh $(DESTDIR)$(pkglibdir)"; \
$(INSTALL_DATA) tdbcConfig.sh $(DESTDIR)$(pkglibdir)/tdbcConfig.sh
#========================================================================
# Install binary executables (e.g. .exe files and dependent .dll files)
# This is for files that must go in the bin directory (located next to
# wish and tclsh), like dependent .dll files on Windows.
#
# You should not have to modify this target, except to define bin_BINARIES
# above if necessary.
#========================================================================
install-bin-binaries: binaries
@$(INSTALL_DATA_DIR) "$(DESTDIR)$(bindir)"
@list='$(bin_BINARIES)'; for p in $$list; do \
if test -f $$p; then \
echo " $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p"; \
$(INSTALL_PROGRAM) $$p "$(DESTDIR)$(bindir)/$$p"; \
fi; \
done
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
cd $(top_builddir) \
&& CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status
uninstall-binaries:
list='$(lib_BINARIES)'; for p in $$list; do \
rm -f "$(DESTDIR)$(pkglibdir)/$$p"; \
done
list='$(PKG_TCL_SOURCES)'; for p in $$list; do \
p=`basename $$p`; \
rm -f "$(DESTDIR)$(pkglibdir)/$$p"; \
done
list='$(bin_BINARIES)'; for p in $$list; do \
rm -f "$(DESTDIR)$(bindir)/$$p"; \
done
.PHONY: all binaries clean depend distclean doc install libraries test
.PHONY: gdb gdb-test valgrind valgrindshell
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

95
pkgs/tdbc1.1.3/README Normal file
View File

@@ -0,0 +1,95 @@
README: tdbc
This is the 1.1.3 source distribution of Tcl Database Connectivity
(TDBC). TDBC is available from a Fossil version control repository
at http://tdbc.tcl.tk/ .
RCS: @(#) $Id$
1. Introduction
This directory contains the source code, documentation, and test scripts
for the base classes and SQL tokenizer of Tcl Database Connectivity. It
is not very useful by itself; to access databases, you also need one
or more driver modules for the database manager(s) that you intend to use.
The drivers are available from http://tdbc.tcl.tk along with the
source code of this module. A bug database and Wiki are available
at the same location.
TDBC is a freely-available open source package. You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part. See the file
"license.terms" for complete information.
2. Documentation
The 'doc' subdirectory in this release contains a set of reference manual
entries for TDBC. Files with an extension '.n' are for Tcl classes and
commands; files with an extension '.3' are for C library functions. The
file, 'doc/tdbc.n' gives an overview, listing the classes and functions.
3. Compiling and Installing.
TDBC is built in much the same way that Tcl itself is. Once you have
a Tcl build environment set up, you should be able to simply
enter the commands:
cd tdbc
./configure
make all
make test
make install
to have the TDBC base classes and tokenizer installed and usable from
Tcl. See http://www.tcl.tk/doc/howto/compile.html for instructions on
how to set up a build environment for Tcl.
4. Tcl newsgroup.
There is a USENET news group, "comp.lang.tcl", intended for the exchange of
information about Tcl, Tk, and related applications. The newsgroup is a
great place to ask general information questions. For bug reports, please
see the "Support and bug fixes" section below.
5. Tcl'ers Wiki
A Wiki-based open community site covering all aspects of Tcl/Tk is at:
http://wiki.tcl.tk/
It is dedicated to the Tcl programming language and its extensions. A
wealth of useful information can be found there. It contains code
snippets, references to papers, books, and FAQs, as well as pointers to
development tools, extensions, and applications. You can also recommend
additional URLs by editing the wiki yourself.
6. Mailing lists
SourceForge hosts a mailing list, tcl-tdbc, to discuss issues with using
and developing TDBC. For more information and to subscribe, visit
http://sourceforge.net/projects/tcl
and go to the 'Mailing Lists' page.
7. Support
We are very interested in receiving bug reports, patches, and suggestions
for improvements. We prefer that you send this information to us via the
bug database, rather than emailing us directly. The bug database is at:
http://tdbc.tcl.tk/
The bug form was designed to give uniform structure to bug reports as
well as to solicit enough information to minimize followup questions.
We will log and follow-up on each bug, although we cannot promise a
specific turn-around time. Enhancements, reported via the Feature
Requests form at the same web site, may take longer and may not happen
at all unless there is widespread support for them.
The Tcl community is too large for us to provide much individual support
for users. If you need help, we suggest that you post questions to
comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric
questions for which no one else is likely to know the answer.

86
pkgs/tdbc1.1.3/aclocal.m4 vendored Normal file
View File

@@ -0,0 +1,86 @@
#
# Include the TEA standard macro set
#
builtin(include,tclconfig/tcl.m4)
#
# Add here whatever m4 macros you want to define for your package
#
dnl Helper macros
AC_DEFUN([TEAX_LAPPEND], [$1="[$]{$1} $2"])
AC_DEFUN([TEAX_FOREACH], [for $1 in $2; do $3; done])
AC_DEFUN([TEAX_IFEQ], [AS_IF([test "x$1" = "x$2"], [$3])])
AC_DEFUN([TEAX_IFNEQ], [AS_IF([test "x$1" != "x$2"], [$3])])
AC_DEFUN([TEAX_SWITCH], [case "$1" in TEAX_SWITCH_Cases(m4_shift($@)) esac])
AC_DEFUN([TEAX_SWITCH_Cases], [m4_if([$#],0,,[$#],1,,[TEAX_SWITCH_OneCase($1,$2)TEAX_SWITCH_Cases(m4_shift(m4_shift($@)))])])
AC_DEFUN([TEAX_SWITCH_OneCase],[ $1) $2;;])
AC_DEFUN([CygPath],[`${CYGPATH} $1`])
dnl Interesting macros
AC_DEFUN([TEAX_SUBST_RESOURCE], [
AC_REQUIRE([TEA_CONFIG_CFLAGS])dnl
TEAX_IFEQ($TEA_PLATFORM, windows, [
AC_CHECK_PROGS(RC_, 'windres -o' 'rc -nologo -fo', none)
TEAX_SWITCH($RC_,
windres*, [
rcdef_inc="--include "
rcdef_start="--define "
rcdef_q='\"'
AC_SUBST(RES_SUFFIX, [res.o])
TEAX_LAPPEND(PKG_OBJECTS, ${PACKAGE_NAME}.res.o)],
rc*, [
rcdef_inc="-i "
rcdef_start="-d "
rcdef_q='"'
AC_SUBST(RES_SUFFIX, [res])
TEAX_LAPPEND(PKG_OBJECTS, ${PACKAGE_NAME}.res)],
*, [
AC_MSG_WARN([could not find resource compiler])
RC_=: ])])
# This next line is because of the brokenness of TEA...
AC_SUBST(RC, $RC_)
TEAX_FOREACH(i, $1, [
TEAX_LAPPEND(RES_DEFS, ${rcdef_inc}\"CygPath($i)\")])
TEAX_FOREACH(i, $2, [
TEAX_LAPPEND(RES_DEFS, ${rcdef_start}$i='${rcdef_q}\$($i)${rcdef_q}')])
AC_SUBST(RES_DEFS)])
AC_DEFUN([TEAX_ADD_PRIVATE_HEADERS], [
TEAX_FOREACH(i, $@, [
# check for existence, be strict because it should be present!
AS_IF([test ! -f "${srcdir}/$i"], [
AC_MSG_ERROR([could not find header file '${srcdir}/$i'])])
TEAX_LAPPEND(PKG_PRIVATE_HEADERS, $i)])
AC_SUBST(PKG_PRIVATE_HEADERS)])
AC_DEFUN([TEAX_SDX], [
AC_PATH_PROG(SDX, sdx, none)
TEAX_IFEQ($SDX, none, [
AC_PATH_PROG(SDX_KIT, sdx.kit, none)
TEAX_IFNEQ($SDX_KIT, none, [
# We assume that sdx.kit is on the path, and that the default
# tclsh is activetcl
SDX="tclsh '${SDX_KIT}'"])])
TEAX_IFEQ($SDX, none, [
AC_MSG_WARN([cannot find sdx; building starkits will fail])
AC_MSG_NOTICE([building as a normal library still supported])])])
dnl TODO: Adapt this for OSX Frameworks...
dnl This next bit is a bit ugly, but it makes things for tclooConfig.sh...
AC_DEFUN([TEAX_PATH_LINE], [
eval "$1=\"[]CygPath($2)\""
AC_SUBST($1)])
AC_DEFUN([TEAX_INCLUDE_LINE], [
eval "$1=\"-I[]CygPath($2)\""
AC_SUBST($1)])
AC_DEFUN([TEAX_LINK_LINE], [
AS_IF([test ${TCL_LIB_VERSIONS_OK} = nodots], [
eval "$1=\"-L[]CygPath($2) -l$3${TCL_TRIM_DOTS}\""
], [
eval "$1=\"-L[]CygPath($2) -l$3${PACKAGE_VERSION}\""
])
AC_SUBST($1)])
dnl Local Variables:
dnl mode: autoconf
dnl End:

10453
pkgs/tdbc1.1.3/configure vendored Normal file

File diff suppressed because it is too large Load Diff

238
pkgs/tdbc1.1.3/configure.ac Normal file
View File

@@ -0,0 +1,238 @@
#!/bin/bash -norc
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
#-----------------------------------------------------------------------
# Sample configure.ac for Tcl Extensions. The only places you should
# need to modify this file are marked by the string __CHANGE__
#-----------------------------------------------------------------------
#-----------------------------------------------------------------------
# __CHANGE__
# Set your package name and version numbers here.
#
# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
# set as provided. These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
# This will also define a special symbol for Windows (BUILD_<PACKAGE_NAME>
# so that we create the export library with the dll.
#-----------------------------------------------------------------------
AC_INIT([tdbc],[1.1.3])
#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------
TEA_INIT()
AC_CONFIG_AUX_DIR(tclconfig)
#--------------------------------------------------------------------
# Load the tclConfig.sh file
#--------------------------------------------------------------------
TEA_PATH_TCLCONFIG
TEA_LOAD_TCLCONFIG
#--------------------------------------------------------------------
# Load the tkConfig.sh file if necessary (Tk extension)
#--------------------------------------------------------------------
#TEA_PATH_TKCONFIG
#TEA_LOAD_TKCONFIG
#--------------------------------------------------------------------
# Load the tclooConfig.sh file on Tcl versions where oo is an
# extension.
#--------------------------------------------------------------------
if test "${TCL_MAJOR_VERSION}" -lt 8 ; then
AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.5 or newer.
Found configuration for Tcl ${TCL_VERSION}.])
fi
if test "${TCL_MAJOR_VERSION}" -eq 8 ; then
if test "${TCL_MINOR_VERSION}" -lt 5 ; then
AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.5 or newer.
Found configuration for Tcl ${TCL_VERSION}.])
fi
if test "${TCL_MINOR_VERSION}" -eq 5 ; then
TEA_PATH_CONFIG(tcloo)
TEA_LOAD_CONFIG(tcloo)
else
TCLOO_CFLAGS=""
fi
fi
# Announce what versions of Tcl (and TclOO) are needed
TCL_VERSION_REQ=8.5-; AC_SUBST(TCL_VERSION_REQ)
TCL_VERSION_DESIRED=8.6; AC_SUBST(TCL_VERSION_DESIRED)
TCLOO_VERSION_REQ=1.0; AC_SUBST(TCLOO_VERSION_REQ)
#-----------------------------------------------------------------------
# Handle the --prefix=... option by defaulting to what Tcl gave.
# Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER.
#-----------------------------------------------------------------------
TEA_PREFIX
#-----------------------------------------------------------------------
# Standard compiler checks.
# This sets up CC by using the CC env var, or looks for gcc otherwise.
# This also calls AC_PROG_CC and a few others to create the basic setup
# necessary to compile executables.
#-----------------------------------------------------------------------
TEA_SETUP_COMPILER
#-----------------------------------------------------------------------
# Setup inlining if available.
#-----------------------------------------------------------------------
AC_C_INLINE
#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------
TEA_ADD_SOURCES([tdbc.c tdbcStubInit.c tdbcTokenize.c])
TEA_ADD_HEADERS([generic/tdbc.h generic/tdbcInt.h generic/tdbcDecls.h])
if test "${TCL_MAJOR_VERSION}" -eq 8 ; then
if test "${TCL_MINOR_VERSION}" -eq 5 ; then
TEA_ADD_INCLUDES([${TCLOO_INCLUDE_SPEC}])
TEA_ADD_LIBS([${TCLOO_STUB_LIB_SPEC}])
fi
fi
TEA_ADD_CFLAGS([${TCLOO_CFLAGS}])
TEA_ADD_STUB_SOURCES([tdbcStubLib.c])
TEA_ADD_TCL_SOURCES([library/tdbc.tcl])
#--------------------------------------------------------------------
# __CHANGE__
#
# You can add more files to clean if your extension creates any extra
# files by extending CLEANFILES.
# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------
#CLEANFILES="$CLEANFILES pkgIndex.tcl"
if test "${TEA_PLATFORM}" = "windows" ; then
# Ensure no empty if clauses
:
#TEA_ADD_SOURCES([win/winFile.c])
#TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
else
# Ensure no empty else clauses
:
#TEA_ADD_SOURCES([unix/unixFile.c])
#TEA_ADD_LIBS([-lsuperfly])
fi
#--------------------------------------------------------------------
# __CHANGE__
# Choose which headers you need. Extension authors should try very
# hard to only rely on the Tcl public header files. Internal headers
# contain private data structures and are subject to change without
# notice.
# This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG
#--------------------------------------------------------------------
TEA_PUBLIC_TCL_HEADERS
#TEA_PRIVATE_TCL_HEADERS
#TEA_PUBLIC_TK_HEADERS
#TEA_PRIVATE_TK_HEADERS
#TEA_PATH_X
#--------------------------------------------------------------------
# Check whether --enable-threads or --disable-threads was given.
# This auto-enables if Tcl was compiled threaded.
#--------------------------------------------------------------------
TEA_ENABLE_THREADS
#--------------------------------------------------------------------
# The statement below defines a collection of symbols related to
# building as a shared library instead of a static library.
#--------------------------------------------------------------------
TEA_ENABLE_SHARED
#--------------------------------------------------------------------
# This macro figures out what flags to use with the compiler/linker
# when building shared/static debug/optimized objects. This information
# can be taken from the tclConfig.sh file, but this figures it all out.
#--------------------------------------------------------------------
TEA_CONFIG_CFLAGS
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------
TEA_ENABLE_SYMBOLS
#--------------------------------------------------------------------
# This macro generates a line to use when building a library. It
# depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS,
# and TEA_LOAD_TCLCONFIG macros above.
#--------------------------------------------------------------------
TEA_MAKE_LIB
#--------------------------------------------------------------------
# Determine the name of the tclsh and/or wish executables in the
# Tcl and Tk build directories or the location they were installed
# into. These paths are used to support running test cases only,
# the Makefile should not be making use of these paths to generate
# a pkgIndex.tcl file or anything else at extension build time.
#--------------------------------------------------------------------
TEA_PROG_TCLSH
#TEA_PROG_WISH
#--------------------------------------------------------------------
# Finally, substitute all of the various values into the Makefile.
# You may alternatively have a special pkgIndex.tcl.in or other files
# which require substituting the AC variables in. Include these here.
#--------------------------------------------------------------------
# Develop a fully qualified path for the package source dir
eval tdbc_SRC_DIR="${srcdir}"
tdbc_SRC_DIR=`cd "${tdbc_SRC_DIR}"; $CYGPATH $(pwd)`
AC_SUBST(tdbc_SRC_DIR)
# Develop -I specifications for the build and installed directories where
# tdbc.h may be found.
TEAX_INCLUDE_LINE(tdbc_INCLUDE_SPEC, [${includedir}])
TEAX_INCLUDE_LINE(tdbc_BUILD_INCLUDE_SPEC, [${tdbc_SRC_DIR}/generic])
# Develop a fully qualified path for where .tcl files for the tdbc package
# appear at run time.
eval tdbc_LIB_DIR="${libdir}/${PACKAGE_NAME}${PACKAGE_VERSION}"
if test -d "${tdbc_LIB_DIR}" ; then
tdbc_LIB_DIR=`cd "${tdbc_LIB_DIR}"; $CYGPATH $(pwd)`
fi
AC_SUBST(tdbc_LIB_DIR)
# Make the export configuration for the TDBC package
TEA_EXPORT_CONFIG([tdbc])
# Set up to produce Makefile from Makefile.in and tdbcConfig.sh from
# tdbcConfig.sh.in.
AC_CONFIG_FILES([Makefile pkgIndex.tcl tdbcConfig.sh])
AC_OUTPUT

View File

@@ -0,0 +1,168 @@
'\"
'\" Copyright (c) 2009 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.
.TH Tdbc_Init 3 8.6 Tcl "Tcl Database Connectivity"
'\" .so man.macros
'\" IGNORE
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
.de AP
.ie !"\\$4"" .TP \\$4
.el \{\
. ie !"\\$2"" .TP \\n()Cu
. el .TP 15
.\}
.ta \\n()Au \\n()Bu
.ie !"\\$3"" \{\
\&\\$1 \\fI\\$2\\fP (\\$3)
.\".b
.\}
.el \{\
.br
.ie !"\\$2"" \{\
\&\\$1 \\fI\\$2\\fP
.\}
.el \{\
\&\\fI\\$1\\fP
.\}
.\}
..
.\" # define tabbing values for .AP
.de AS
.nr )A 10n
.if !"\\$1"" .nr )A \\w'\\$1'u+3n
.nr )B \\n()Au+15n
.\"
.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
.nr )C \\n()Bu+\\w'(in/out)'u+2n
..
.AS Tcl_Interp Tcl_CreateInterp in/out
.\" # BS - start boxed text
.\" # ^y = starting y location
.\" # ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
.\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
.\" Draw four-sided box normally, but don't draw top of
.\" box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
.\" # CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
.\" # CE - end code excerpt
.de CE
.fi
.RE
..
'\" END IGNORE
.BS
.SH "NAME"
Tdbc_Init, Tdbc_MapSqlState, Tdbc_TokenizeSql \- C procedures to facilitate writing TDBC drivers
.SH SYNOPSIS
.nf
\fB#include <tdbc.h>\fR
int
\fBTdbc_Init\fR(\fIinterp\fR)
Tcl_Obj *
\fBTdbc_TokenizeSql\fR(\fIinterp, sqlcode\fR)
const char *
\fBTdbc_MapSqlState\fR(\fIstate\fR)
.fi
.SH ARGUMENTS
.AS "Tcl_Interp" statement in/out
.AP Tcl_Interp *interp in/out
Pointer to a Tcl interpreter.
.AP "const char" *state in
Pointer to a character string containing a 'SQL state' from a database error.
.AP "const char" *sqlcode in
Pointer to a character string containing a SQL statement.
.BE
.SH DESCRIPTION
.PP
The TDBC library provides several C procedures that simplify writing a TDBC
driver. They include a procedure that tokenizes a SQL statement, locating
variables to be substituted, and a procedure that accepts a SQL state and
returns an error class for the interpreter error information.
.PP
\fBTdbc_Init\fR must be invoked prior to any other TDBC call. It accepts
a pointer to a Tcl interpreter, and arranges to load the TDBC library. It
returns \fBTCL_OK\fR if the Tcl library was loaded successfully, and
\fBTCL_ERROR\fR otherwise. If \fBTCL_ERROR\fR is returned, the
interpreter's result contains the error message.
.PP
\fBTdbc_TokenizeSql\fR accepts a pointer to a Tcl interpreter, and a
pointer to a character string containing one or more SQL
statements. It tokenizes the SQL statements, and returns a pointer to
a Tcl_Obj that contains a list of the tokens that make up the
statement. Concatenating the tokens together will yield the original
SQL code. The returned Tcl_Obj has a reference count of zero. The
caller is responsible for managing the reference count as needed.
See \fBTOKENS\fR below for a description of what may be in the
returned list of tokens.
.PP
\fBTdbc_MapSqlState\fR accepts a pointer to a string, usually five
characters long, that is the 'SQL state' that resulted from a database
error. It returns a character string that is suitable for inclusion as
the error class when constructing the error code for an error in a
TDBC driver. (By convention, the error code is a list having at least
four elements: "\fBTDBC\fR \fIerrorClass\fR \fIsqlstate\fR
\fIdriverName\fR \fIdetails...\fR".)
.SH TOKENS
Each token returned from \fBTdbc_TokenizeSql\fR may be one of the
following:
.IP [1]
A bound variable, which begins with one of the
characters '\fB:\fR', '\fB@\fR', or '\fB$\fR'. The
remainder of the string is the variable
name and will consist of alphanumeric characters and underscores. (The
leading character will be be non-numeric.)
.IP [2]
A semicolon that separates two SQL statements.
.IP [3]
Something else in a SQL statement. The tokenizer does not attempt to
parse SQL; it merely identifies bound variables (distinguishing them
from similar strings appearing inside quotes or comments) and
statement delimiters.
.SH "SEE ALSO"
tdbc(n), tdbc::mapSqlState(n), tdbc::tokenize(n)
.SH "KEYWORDS"
TDBC, SQL, database, tokenize
.SH "COPYRIGHT"
Copyright (c) 2009 by Kevin B. Kenny.
.\" Local Variables:
.\" mode: nroff
.\" End:
.\"

86
pkgs/tdbc1.1.3/doc/tdbc.n Normal file
View File

@@ -0,0 +1,86 @@
'\"
'\" tdbc.n --
'\"
'\" 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.
.TH "tdbc" n 8.6 Tcl "Tcl Database Connectivity"
'\" .so man.macros
'\" IGNORE
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\" # BS - start boxed text
'\" # ^y = starting y location
'\" # ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
'\" Draw four-sided box normally, but don't draw top of
'\" box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\" END IGNORE
.BS
.SH "NAME"
tdbc \- Tcl Database Connectivity
.SH "SYNOPSIS"
.nf
package require \fBtdbc 1.0\fR
package require \fBtdbc::\fIdriver version\fR
\fBtdbc::\fIdriver\fB::connection create \fIdb\fR ?\fI\-option value\fR...?
.fi
.BE
.SH "DESCRIPTION"
.PP
Tcl Database Connectivity (TDBC) is a common interface for Tcl
programs to access SQL databases. It is implemented by a series of
database \fIdrivers\fR: separate modules, each of which adapts Tcl to
the interface of one particular database system. All of the drivers
implement a common series of commands for manipulating the database.
These commands are all named dynamically, since they all represent
objects in the database system. They include \fBconnections,\fR
which represent connections to a database; \fBstatements,\fR which
represent SQL statements, and \fBresult sets,\fR which represent
the sets of rows that result from executing statements. All of these
have manual pages of their own, listed under \fBSEE ALSO\fR.
.PP
In addition, TDBC itself has a few service procedures that are chiefly
of interest to driver writers. \fBSEE ALSO\fR also enumerates them.
.SH "SEE ALSO"
Tdbc_Init(3),
tdbc::connection(n), tdbc::mapSqlState(n),
tdbc::resultset(n), tdbc::statement(n), tdbc::tokenize(n),
tdbc::mysql(n), tdbc::odbc(n), tdbc::postgres(n), tdbc::sqlite3(n)
.SH "KEYWORDS"
TDBC, SQL, database, connectivity, connection, resultset, statement
.SH "COPYRIGHT"
Copyright (c) 2008 by Kevin B. Kenny.
'\" Local Variables:
'\" mode: nroff
'\" End:
'\"

View File

@@ -0,0 +1,376 @@
'\"
'\" tdbc::connection.n --
'\"
'\" 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.
.TH "tdbc::connection" n 8.6 Tcl "Tcl Database Connectivity"
'\" .so man.macros
'\" IGNORE
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\" # BS - start boxed text
'\" # ^y = starting y location
'\" # ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
'\" Draw four-sided box normally, but don't draw top of
'\" box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\" END IGNORE
.BS
.SH "NAME"
tdbc::connection \- TDBC connection object
.SH "SYNOPSIS"
.nf
package require \fBtdbc 1.0\fR
package require \fBtdbc::\fIdriver version\fR
\fBtdbc::\fIdriver\fB::connection create \fIdb\fR ?\fI\-option value\fR...?
\fIdb \fBconfigure\fR ?\fI\-option value\fR...?
\fIdb \fBclose\fR
\fIdb \fBforeignkeys\fR ?\fI\-primary tableName\fR? ?\fI\-foreign tableName\fR?
\fIdb \fBprepare\fR \fIsql-code\fR
\fIdb \fBpreparecall\fR \fIcall\fR
\fIdb \fBprimarykeys\fR \fItableName\fR
\fIdb \fBstatements\fR
\fIdb \fBresultsets\fR
\fIdb \fBtables\fR ?\fIpattern\fR?
\fIdb \fBcolumns\fR \fItable\fR ?\fIpattern\fR?
\fIdb \fBbegintransaction\fR
\fIdb \fBcommit\fR
\fIdb \fBrollback\fR
\fIdb \fBtransaction\fR \fIscript\fR
.fi
.ad l
.in 14
.ti 7
\fIdb \fBallrows\fR ?\fB\-as lists\fR|\fBdicts\fR? ?\fB\-columnsvariable \fIname\fR? ?\fB\-\-\fR? \fIsql-code\fR ?\fIdictionary\fR?
.br
.ti 7
\fIdb \fBforeach\fR ?\fB\-as lists\fR|\fBdicts\fR? ?\fB\-columnsvariable \fIname\fR? ?\-\-? \fIvarName sqlcode\fR ?\fIdictionary\fR? \fIscript\fR
.ad b
.BE
.SH "DESCRIPTION"
.PP
Every database driver for TDBC (Tcl DataBase Connectivity) implements
a \fIconnection\fR object that represents a connection to a database.
By convention, this object is created by the command,
\fBtdbc::\fIdriver\fB::connection create\fR.
This command accepts the name of a Tcl command that will represent the
connection and a possible set of options (see \fBCONFIGURATION
OPTIONS\fR). It establishes a connection to the database and returns
the name of the newly-created Tcl command.
.PP
The \fBconfigure\fR object command on a database connection, if
presented with no arguments, returns a list of alternating keywords
and values representing the connection's current configuration. If
presented with a single argument \fI\-option\fR, it returns the
configured value of the given option. Otherwise, it must be given an
even number of arguments which are alternating options and values. The
specified options receive the specified values, and nothing is
returned.
.PP
The \fBclose\fR object command on a database connection closes the
connection. All active statements and result sets on the connection
are closed. Any uncommitted transaction is rolled back. The object
command is deleted.
.PP
The \fBprepare\fR object command on a database connection prepares a SQL
statement for execution. The \fIsql-code\fR argument must contain a
single SQL statement to be executed. Bound variables may be
included. The return value is a
newly-created Tcl command that represents the statement. See
\fBtdbc::statement\fR for more detailed discussion of the
SQL accepted by the \fBprepare\fR object command and the
interface accepted by a statement.
.PP
On a database connection where the underlying database and driver
support stored procedures, the \fBpreparecall\fR
object command prepares a call to a stored procedure for execution.
The syntax of the stored procedure call is:
.PP
.CS
?\fIresultvar\fR =? \fIprocname\fR(?\fIarg\fR ?, \fIarg\fR...?)
.CE
.PP
The return value is a
newly-created Tcl command that represents the statement. See
\fBtdbc::statement\fR for the interface accepted by a statement.
.PP
The \fBstatements\fR object command returns a list of statements
that have been created by \fBprepare\fR and \fBpreparecall\fR
statements against the given connection and have not yet been closed.
.PP
The \fBresultsets\fR object command returns a list of result sets
that have been obtained by executing statements prepared using the
given connection and not yet closed.
.PP
The \fBtables\fR object command allows the program to query the
connection for the names of tables that exist in the database.
The optional \fIpattern\fR parameter is a pattern to match the name of
a table. It may contain the SQL wild-card characters '\fB%\fR' and
'\fB_\fR'. The return value is a dictionary whose keys are table names
and whose values are subdictionaries. See the documentation for the
individual database driver for the interpretation of the values.
.PP
The \fBcolumns\fR object command allows the program to query the
connection for the names of columns that exist in a given table.
The optional \fBpattern\fR parameter is a pattern to match the name of
a column. It may contain the SQL wild-card characters '\fB%\fR' and
'\fB_\fR'. The return value is a dictionary whose keys are column names
and whose values are dictionaries. Each of the subdictionaries will
contain at least the following keys and values (and may contain others
whose usage is determined by a specific database driver).
.IP \fBtype\fR
Contains the data type of the column, and will generally be chosen
from the set,
\fBbigint\fR, \fBbinary\fR, \fBbit\fR, \fBchar\fR, \fBdate\fR,
\fBdecimal\fR, \fBdouble\fR, \fBfloat\fR, \fBinteger\fR,
\fBlongvarbinary\fR, \fBlongvarchar\fR, \fBnumeric\fR, \fBreal\fR,
\fBtime\fR, \fBtimestamp\fR, \fBsmallint\fR, \fBtinyint\fR,
\fBvarbinary\fR, and \fBvarchar\fR. (If the column has a type that
cannot be represented as one of the above, \fBtype\fR will contain
a driver-dependent description of the type.)
.IP \fBprecision\fR
Contains the precision of the column in bits, decimal digits, or the
width in characters, according to the type.
.IP \fBscale\fR
Contains the scale of the column (the number of digits after the radix
point), for types that support the concept.
.IP \fBnullable\fR
Contains 1 if the column can contain NULL values, and 0 otherwise.
.PP
The \fBprimarykeys\fR object command allows the program to query the
connection for the primary keys belonging to a given table. The
\fItableName\fR parameter identifies the table being interrogated. The result
is a list of dictionaries enumerating the keys (in a similar format to the
list returned by \fI$connection\fR \fBallrows -as dicts\fR). The keys of the
dictionary may include at least the following. Values that are NULL or
meaningless in a given database are omitted.
.IP \fBtableCatalog\fR
Name of the catalog in which the table appears.
.IP \fBtableSchema\fR
Name of the schema in which the table appears.
.IP \fBtableName\fR
Name of the table owning the primary key.
.IP \fBconstraintCatalog\fR
Name of the catalog in which the primary key constraint appears. In some
database systems, this may not be the same as the table's catalog.
.IP \fBconstraintSchema\fR
Name of the schema in which the primary key constraint appears. In some
database systems, this may not be the same as the table's schema.
.IP \fBconstraintName\fR
Name of the primary key constraint,
.IP \fBcolumnName\fR
Name of a column that is a member of the primary key.
.IP \fBordinalPosition\fR
Ordinal position of the column within the primary key.
.PP
To these columns may be added additional ones that are specific to
a particular database system.
.PP
The \fBforeignkeys\fR object command allows the program to query the
connection for foreign key relationships that apply to a particular table.
The relationships may be constrained to the keys that appear in a
particular table (\fB-foreign\fR \fItableName\fR), the keys that
refer to a particular table (\fB-primary\fR \fItableName\fR), or both.
At least one of \fB-primary\fR and \fB-foreign\fR should be specified,
although some drivers will enumerate all foreign keys in the current
catalog if both options are omitted. The result of the \fBforeignkeys\fR
object command is a list of dictionaries, with one list element per key
(in a similar format to the
list returned by \fI$connection\fR \fBallrows -as dicts\fR). The keys of the
dictionary may include at least the following. Values that are NULL or
meaningless in a given database are omitted.
.IP \fBforeignConstraintCatalog\fR
Catalog in which the foreign key constraint appears.
.IP \fBforeignConstraintSchema\fR
Schema in which the foreign key constraint appears.
.IP \fBforeignConstraintName\fR
Name of the foreign key constraint.
.IP \fBprimaryConstraintCatalog\fR
Catalog holding the primary key constraint (or unique key constraint) on the
column to which the foreign key refers.
.IP \fBprimaryConstraintSchema\fR
Schema holding the primary key constraint (or unique key constraint) on the
column to which the foreign key refers.
.IP \fBprimaryConstraintName\fR
Name of the primary key constraint (or unique key constraint) on the
column to which the foreign key refers.
.IP \fBupdateAction\fR
Action to take when an UPDATE statement invalidates the constraint.
The value will be \fBCASCADE\fR, \fBSET DEFAULT\fR, \fBSET NULL\fR,
\fBRESTRICT\fR, or \fBNO ACTION\fR.
.IP \fBdeleteAction\fR
Action to take when a DELETE statement invalidates the constraint.
The value will be \fBCASCADE\fR, \fBSET DEFAULT\fR, \fBSET NULL\fR,
\fBRESTRICT\fR, or \fBNO ACTION\fR.
.IP \fBprimaryCatalog\fR
Catalog name in which the primary table (the one to which the foreign key
refers) appears.
.IP \fBprimarySchema\fR
Schema name in which the primary table (the one to which the foreign key
refers) appears.
.PP
.IP \fBprimaryTable\fR
Table name of the primary table (the one to which the foreign key
refers).
.IP \fBprimaryColumn\fR
Name of the column to which the foreign key refers.
.IP \fBforeignCatalog\fR
Name of the catalog in which the table containing the foreign key appears.
.IP \fBforeignSchema\fR
Name of the schema in which the table containing the foreign key appears.
.IP \fBforeignTable\fR
Name of the table containing the foreign key.
.IP \fBforeignColumn\fR
Name of the column appearing in the foreign key.
.IP \fBordinalPosition\fR
Position of the column in the foreign key, if the key is a compound key.
.PP
The \fBbegintransaction\fR object command on a database connection
begins a transaction on the database. If the underlying database does
not support atomic, consistent, isolated, durable transactions, the
\fBbegintransaction\fR object command returns an error reporting the
fact. Similarly, if multiple \fBbegintransaction\fR commands are executed
withough an intervening \fBcommit\fR or \fBrollback\fR command, an
error is returned unless the underlying database supports nested
transactions.
.PP
The \fBcommit\fR object command on a database connection ends the most
recent transaction started by \fBbegintransaction\fR and commits
changes to the database.
.PP
The \fBrollback\fR object command on a database connection rolls back
the most recent transaction started by \fBbegintransaction\fR. The
state of the database is as if nothing happened during the
transaction.
.PP
The \fBtransaction\fR object command on a database connection
presents a simple way of bundling a database transaction. It begins a
transaction, and evaluates the supplied \fIscript\fR argument as a Tcl
script in the caller's scope. If \fIscript\fR terminates normally, or
by \fBbreak\fR, \fBcontinue\fR, or \fBreturn\fR, the transaction is
committed (and any action requested by \fBbreak\fR, \fBcontinue\fR, or
\fBreturn\fR takes place). If the commit fails for any reason,
the error in the commit is treated as an error in the \fIscript\fR.
In the case of an error in \fIscript\fR or in the commit,
the transaction is rolled back and the error is
rethrown. Any nonstandard return code from the script
causes the transaction to be rolled back and then is rethrown.
.PP
The \fBallrows\fR object command prepares a SQL statement (given by
the \fIsql-code\fR parameter) to execute against the database.
It then executes it (see \fBtdbc::statement\fR for details) with the
optional \fIdictionary\fR parameter giving bind variables. Finally,
it uses the \fIallrows\fR object command on the result set (see
\fBtdbc::resultset\fR) to construct a list of the results. Finally, both
result set and statement are closed. The return value is the list of
results.
.PP
The \fBforeach\fR object command prepares a SQL statement (given by
the \fIsql-code\fR parameter) to execute against the database.
It then executes it (see \fBtdbc::statement\fR for details) with the
optional \fIdictionary\fR parameter giving bind variables. Finally,
it uses the \fIforeach\fR object command on the result set (see
\fBtdbc::resultset\fR) to evaluate the given \fIscript\fR for each row of
the results. Finally, both result set and statement are closed, even
if the given \fIscript\fR results in a \fBreturn\fR, an error, or
an unusual return code.
.SH "CONFIGURATION OPTIONS"
The configuration options accepted when the connection is created and
on the connection's \fBconfigure\fR object command include the
following, and may include others specific to a database driver.
.IP "\fB\-encoding \fIname\fR"
Specifies the encoding to be used in connecting to the database.
The \fIname\fR should be one of the names accepted by the
\fBencoding\fR command. This option is usually unnecessary; most
database drivers can figure out the encoding in use by themselves.
.IP "\fB\-isolation \fIlevel\fR"
Specifies the transaction isolation level needed for transactions on
the database. The acceptable values for \fIlevel\fR are shown under
\fBTRANSACTION ISOLATION LEVELS\fR.
.IP "\fB\-timeout \fIms\fR"
Specifies the maximum time to wait for a an operation database engine before
reporting an error to the caller. The \fIms\fR argument gives the
maximum time in milliseconds. A value of zero (the default) specifies
that the calling process is to wait indefinitely for database
operations.
.IP "\fB\-readonly \fIflag\fR"
Specifies that the connection will not modify the database (if the
Boolean parameter \fIflag\fR is true), or that it may modify the
database (if \fIflag\fR is false). If \fIflag\fR is true, this option
may have the effect of raising the transaction isolation level to
\fIreadonly\fR.
.SS "TRANSACTION ISOLATION LEVELS"
The acceptable values for the \fB\-isolation\fR configuration option
are as follows:
.IP \fBreaduncommitted\fR
Allows the transaction to read "dirty", that is, uncommitted
data. This isolation level may compromise data integrity, does not
guarantee that foreign keys or uniqueness constraints are satisfied,
and in general does not guarantee data consistency.
.IP \fBreadcommitted\fR
Forbids the transaction from reading "dirty" data, but does not
guarantee repeatable reads; if a transaction reads a row of a database
at a given time, there is no guarantee that the same row will be
available at a later time in the same transaction.
.IP \fBrepeatableread\fR
Guarantees that any row of the database, once read, will have the same
values for the life of a transaction. Still permits "phantom reads"
(that is, newly-added rows appearing if a table is queried a second
time).
.IP \fBserializable\fR
The most restrictive (and most expensive) level of transaction isolation. Any query to the database, if repeated, will return precisely the same results for the life of the transaction, exactly as if the transaction is the only user of the database.
.IP \fBreadonly\fR
Behaves like \fBserializable\fR in that the only results visible to
the transaction are those that were committed prior to the start of
the transaction, but forbids the transaction from modifying the
database.
.PP
A database that does not implement one of these isolation levels
will instead use the next more restrictive isolation level. If the
given level of isolation cannot be obtained, the database interface
throws an error reporting the fact. The default isolation level
is \fBreadcommitted\fR.
.PP
A script should not the isolation level when a transaction is in
progress.
.SH "SEE ALSO"
encoding(n), tdbc(n), tdbc::resultset(n), tdbc::statement(n), tdbc::tokenize(n)
.SH "KEYWORDS"
TDBC, SQL, database, connectivity, connection, resultset, statement
.SH "COPYRIGHT"
Copyright (c) 2008 by Kevin B. Kenny.
'\" Local Variables:
'\" mode: nroff
'\" End:
'\"

View File

@@ -0,0 +1,93 @@
'\"
'\" tdbc_mapSqlState.n --
'\"
'\" Copyright (c) 2009 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.
'\"
.TH "tdbc::mapSqlState" n 8.6 Tcl "Tcl Database Connectivity"
'\" .so man.macros
'\" IGNORE
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\" # BS - start boxed text
'\" # ^y = starting y location
'\" # ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
'\" Draw four-sided box normally, but don't draw top of
'\" box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\" # CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
'\" # CE - end code excerpt
.de CE
.fi
.RE
..
'\" END IGNORE
.BS
.SH "NAME"
tdbc::mapSqlState \- Map SQLSTATE to error class
.SH "SYNOPSIS"
.nf
package require \fBtdbc 1.0\fR
\fBtdbc::mapSqlState\fR \fIsqlstate\fR
.fi
.BE
.SH "DESCRIPTION"
.PP
The \fBtdbc::mapSqlState\fR command accepts a string that is expected
to be a five-character 'SQL state' as returned from a SQL database when
an error occurs. It examines the first two characters of the string,
and returns an error class as a human- and machine-readable name (for example,
\fBFEATURE_NOT_SUPPORTED\fR, \fBDATA_EXCEPTION\fR or
\fBINVALID_CURSOR_STATE\fR).
.PP
The TDBC specification requires database drivers to return a description
of an error in the error code when an error occurs. The description is
a string that has at least four elements: "\fBTDBC\fR \fIerrorClass\fR
\fIsqlstate\fR \fIdriverName\fR \fIdetails...\fR". The \fBtdbc::mapSqlState\fR
command gives a convenient way for a TDBC driver to generate the
\fIerrorClass\fR element given the SQL state returned from a database.
.SH "SEE ALSO"
tdbc(n), tdbc::tokenize, tdbc::connection(n), tdbc::statement(n), tdbc::resultset(n)
.SH "KEYWORDS"
TDBC, SQL, database, state
.SH "COPYRIGHT"
Copyright (c) 2009 by Kevin B. Kenny.
'\" Local Variables:
'\" mode: nroff
'\" End:
'\"

View File

@@ -0,0 +1,191 @@
'\"
'\" tdbc_resultset.n --
'\"
'\" 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.
'\"
.TH "tdbc::resultset" n 8.6 Tcl "Tcl Database Connectivity"
'\" .so man.macros
'\" IGNORE
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\" # BS - start boxed text
'\" # ^y = starting y location
'\" # ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
'\" Draw four-sided box normally, but don't draw top of
'\" box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\" # CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
'\" # CE - end code excerpt
.de CE
.fi
.RE
..
'\" END IGNORE
.BS
.SH "NAME"
tdbc::resultset \- TDBC result set object
.SH "SYNOPSIS"
.nf
package require \fBtdbc 1.0\fR
package require \fBtdbc::\fR\fIdriver version\fR
\fBtdbc::\fR\fIdriver\fR\fB::connection create \fR\fIdb\fR \fI?\-option value\fR...?
\fBset\fR \fIstmt\fR \fB[\fR\fIdb\fR \fBprepare\fR \fIsql-code\fR\fB]\fR
\fBset\fR \fIresultset\fR \fB[\fR\fI$stmt\fR \fBexecute\fR ?\fIargs...\fR?\fB]\fR
\fI$resultset\fR \fBcolumns\fR
\fI$resultset\fR \fBrowcount\fR
\fI$resultset\fR \fBnextrow\fR ?\fB-as\fR \fBlists\fR|\fBdicts\fR? ?\fB--\fR? \fIvarname\fR
\fI$resultset\fR \fBnextlist\fR \fIvarname\fR
\fI$resultset\fR \fBnextdict\fR \fIvarname\fR
\fI$resultset\fR \fBnextresults\fR
.fi
.ad l
.in 14
.ti 7
\fI$resultset\fR \fBallrows\fR ?\fB-as lists|dicts\fR? ?\fB-columnsvariable\fR \fIname\fR? ?\fB--\fR?
.br
.ti 7
\fI$resultset\fR \fBforeach\fR ?\fB-as lists|dicts\fR? ?\fB-columnsvariable\fR \fIname\fR? ?\fB--\fR? \fIvarname\fR \fIscript\fR
.br
.ti 7
\fI$resultset\fR \fBclose\fR
.ad b
.BE
.SH "DESCRIPTION"
.PP
Every database driver for TDBC (Tcl DataBase Connectivity) implements
a \fIresult set\fR object that represents a the results returned from
executing SQL statement in a database. Instances of this object are created
by executing the \fBexecute\fR object command on a statement object.
.PP
The \fBcolumns\fR object command returns a list of the names of the columns
in the result set. The columns will appear in the same order as they appeared
in the SQL statement that performed the database query. If the SQL statement
does not return a set of columns (for instance, if it is an INSERT,
UPDATE, or DELETE statement), the \fBcolumns\fR command will return an empty
list.
.PP
The \fBrowcount\fR object command returns the number of rows in the database
that were affected by the execution of an INSERT, UPDATE or DELETE statement.
For a SELECT statement, the row count is unspecified.
.PP
The \fBnextlist\fR object command sets the variable given by \fIvarname\fR
in the caller's scope to the next row of the results, expressed as a list
of column values. NULL values are replaced by empty strings. The
columns of the result row appear in the same order in which they
appeared on the SELECT statement. The
return of \fBnextlist\fR is \fB1\fR if the operation succeeded, and
\fB0\fR if the end of the result set was reached.
.PP
The \fBnextdict\fR object command sets the variable given by \fIvarname\fR
in the caller's scope to the next row of the results, expressed as a
dictionary. The dictionary's keys are column names, and the values are
the values of those columns in the row. If a column's value in the row
is NULL, its key is omitted from the dictionary.
The keys appear in the dictionary in the same order in which the
columns appeared on the SELECT statement. The
return of \fBnextdict\fR is \fB1\fR if the operation succeeded, and
\fB0\fR if the end of the result set was reached.
.PP
The \fBnextrow\fR object command is precisely equivalent to the
\fBnextdict\fR or \fBnextlist\fR object command, depending on whether
\fB-as dicts\fR (the default) or \fB-as lists\fR is specified.
.PP
Some databases support the idea of a single statement that returns multiple
sets of results. The \fBnextresults\fR object command is executed, typically
after the \fBnextlist\fR of \fBnextdict\fR object command has returned
\fB0\fR, to advance to the next result set. It returns \fB1\fR if there
is another result set to process, and \fB0\fR if the result set just
processed was the last. After calling \fBnextresults\fR and getting
the return value of \fB1\fR, the caller may once again call \fBcolumns\fR
to get the column descriptions of the next result set, and then return to
calling \fBnextdict\fR or \fBnextlist\fR to process the rows of the
next result set. It is an error to call \fBcolumns\fR, \fBnextdict\fR,
\fBnextlist\fR or \fBnextrow\fR after \fBnextresults\fR has returned \fB0\fR.
.PP
The \fBallrows\fR object command sets the variable designated by the
\fB-columnsvariable\fR option (if present) to the result of the \fBcolumns\fR
object command. It then executes the \fBnextrow\fR object command
repeatedly until the end of the result set is reached. If \fBnextresults\fR
returns a nonzero value, it executes the above two steps (\fBcolumns\fR
followed by iterated \fBnextrow\fR calls) as long as further results are
available. The rows returned by \fBnextrow\fR
are assembled into a Tcl list and become the return value of the
\fBallrows\fR command; the last value returned from \fBcolumns\fR is what
the application will see in \fB-columnsvariable\fR.
.PP
The \fBforeach\fR object command sets the variable designated by the
\fB-columnsvariable\fR option (if present) to the result of the \fBcolumns\fR
object command. It then executes the \fBnextrow\fR object command
repeatedly until the end of the result set is reached, storing the
successive rows in the variable designated by \fIvarName\fR. For each
row, it executes the given \fIscript\fR. If the script terminates with
an error, the error is reported by the \fBforeach\fR command, and
iteration stops. If the script performs a \fBbreak\fR operation, the
iteration terminates prematurely. If the script performs a
\fBcontinue\fR operation, the iteration recommences with the next row.
If the script performs a \fBreturn\fR, results are the same as if a
script outside the control of \fBforeach\fR had returned. Any other
unusual return code terminates the iteration and is reported from the
\fBforeach\fR.
.PP
Once \fBnextrow\fR returns \fB0\fR, the \fBforeach\fR object command
tries to advance to the next result set using \fBnextresults\fR. If
\fBnextresults\fR returns \fB1\fR, the above steps (\fBcolumns\fR and
\fBnextrow\fR, with script invocation) are repeated as long as more
result sets remain. The \fIscript\fR will always see the correct description
of the columns of the current result set in the variable designated
byt \fB-columnsvariable\fR. At the end of the call, the variable
designated by \fB-columnsvariable\fR will have the description of the
columns of the last result set.
.PP
The \fBclose\fR object command deletes the result set and frees any
associated system resources.
.SH "SEE ALSO"
encoding(n), tdbc(n), tdbc::connection(n), tdbc::statement(n), tdbc::tokenize(n)
.SH "KEYWORDS"
TDBC, SQL, database, connectivity, connection, resultset, statement,
bound variable, stored procedure, call
.SH "COPYRIGHT"
Copyright (c) 2008 by Kevin B. Kenny.
'\" Local Variables:
'\" mode: nroff
'\" End:
'\"

View File

@@ -0,0 +1,236 @@
'\"
'\" tdbc_statement.n --
'\"
'\" 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.
.TH "tdbc::statement" n 8.6 Tcl "Tcl Database Connectivity"
'\" .so man.macros
'\" IGNORE
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\" # BS - start boxed text
'\" # ^y = starting y location
'\" # ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
'\" Draw four-sided box normally, but don't draw top of
'\" box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\" # CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
'\" # CE - end code excerpt
.de CE
.fi
.RE
..
'\" END IGNORE
.BS
.SH "NAME"
tdbc::statement \- TDBC statement object
.SH "SYNOPSIS"
.nf
package require \fBtdbc 1.0\fR
package require \fBtdbc::\fR\fIdriver version\fR
\fBtdbc::\fR\fIdriver\fR\fB::connection create \fR\fIdb\fR \fI?\-option value\fR...?
\fBset\fR \fIstmt\fR \fB[\fR\fIdb\fR \fBprepare\fR \fIsql-code\fR\fB]\fR
\fBset\fR \fIstmt\fR \fB[\fR\fIdb\fR \fBpreparecall\fR \fIcall\fR\fB]\fR
\fI$stmt\fR \fBparams\fR
\fI$stmt\fR \fBparamtype\fR ?\fIdirection\fR? \fItype\fR ?\fIprecision\fR? ?\fIscale\fR?
\fI$stmt\fR \fBexecute\fR ?\fIdict\fR?
\fI$stmt\fR \fBresultsets\fR
.fi
.ad l
.in 14
.ti 7
\fI$stmt\fR \fBallrows\fR ?\fB-as lists|dicts\fR? ?\fB-columnsvariable\fR \fIname\fR? ?\fB--\fR? ?\fIdict\fR
.br
.ti 7
\fI$stmt\fR \fBforeach\fR ?\fB-as lists|dicts\fR? ?\fB-columnsvariable\fR \fIname\fR? ?\fB--\fR? \fIvarName\fR ?\fIdict\fR? \fIscript\fR
.br
.ti 7
\fI$stmt\fR \fBclose\fR
.ad b
.BE
.SH "DESCRIPTION"
.PP
Every database driver for TDBC (Tcl DataBase Connectivity) implements
a \fIstatement\fR object that represents a SQL statement in a
database. Instances of this object are created by executing the
\fBprepare\fR or \fBpreparecall\fR object command on a database
connection.
.PP
The \fBprepare\fR object command against the connection
accepts arbitrary SQL code to be
executed against the database. The SQL code may contain \fIbound
variables\fR, which are strings of alphanumeric characters or
underscores (the first character of the string may not be numeric),
prefixed with a colon (\fB:\fR). If a bound variable appears in the
SQL statement, and is not in a string set off by single or double
quotes, nor in a comment introduced by \fB--\fR, it becomes a value
that is substituted when the statement is executed. A bound variable
becomes a single value (string or numeric) in the resulting
statement. \fIDrivers are responsible for ensuring that the mechanism
for binding variables prevents SQL injection.\fR
.PP
The \fBpreparecall\fR object command against the connection accepts a
stylized statement in the form:
.PP
.CS
\fIprocname\fR \fB(\fR?\fB:\fR\fIvarname\fR? ?\fB,:\fR\fIvarname\fR...?\fB)\fR
.CE
.PP
or
.PP
.CS
\fIvarname\fR \fB=\fR \fIprocname\fR \fB(\fR?\fB:\fR\fIvarname\fR? ?\fB,:\fR\fIvarname\fR...?\fB)\fR
.CE
.PP
This statement represents a call to a stored procedure \fIprocname\fR in the
database. The variable name to the left of the equal sign (if
present), and all variable names that are parameters inside
parentheses, become bound variables.
.PP
The \fBparams\fR method against a statement object enumerates the
bound variables that appear in the statement. The result returned from
the \fBparams\fR method is a dictionary whose keys are the names of
bound variables (listed in the order in which the variables first
appear in the statement), and whose values are dictionaries. The
subdictionaries include at least the following keys (database drivers
may add additional keys that are not in this list).
.IP \fBdirection\fR
Contains one of the keywords, \fBin\fR, \fBout\fR or \fBinout\fR
according to whether the variable is an input to or output from the
statement. Only stored procedure calls will have \fBout\fR or
\fBinout\fR parameters.
.IP \fBtype\fR
Contains the data type of the column, and will generally be chosen
from the set,
\fBbigint\fR, \fBbinary\fR, \fBbit\fR, \fBchar\fR, \fBdate\fR,
\fBdecimal\fR, \fBdouble\fR, \fBfloat\fR, \fBinteger\fR,
\fBlongvarbinary\fR, \fBlongvarchar\fR, \fBnumeric\fR, \fBreal\fR,
\fBtime\fR, \fBtimestamp\fR, \fBsmallint\fR, \fBtinyint\fR,
\fBvarbinary\fR, and \fBvarchar\fR. (If the variable has a type that
cannot be represented as one of the above, \fBtype\fR will contain
a driver-dependent description of the type.)
.IP \fBprecision\fR
Contains the precision of the column in bits, decimal digits, or the
width in characters, according to the type.
.IP \fBscale\fR
Contains the scale of the column (the number of digits after the radix
point), for types that support the concept.
.IP \fBnullable\fR
Contains 1 if the column can contain NULL values, and 0 otherwise.
.PP
The \fBparamtype\fR object command allows the script to specify the
type and direction of parameter transmission of a variable in a
statement. (Some databases provide no method to determine this
information automatically and place the burden on the caller to do
so.) The \fIdirection\fR, \fItype\fR, \fIprecision\fR, \fIscale\fR,
and \fInullable\fR arguments have the same meaning as the
corresponding dictionary values in the \fBparams\fR object command.
.PP
The \fBexecute\fR object command executes the statement. Prior to
executing the statement, values are provided for the bound variables
that appear in it. If the \fIdict\fR parameter is supplied, it is
searched for a key whose name matches the name of the bound
variable. If the key is present, its value becomes the substituted
variable. If not, the value of the substituted variable becomes a SQL
NULL. If the \fIdict\fR parameter is \fInot\fR supplied, the
\fBexecute\fR object command searches for a variable in the caller's
scope whose name matches the name of the bound variable. If one is
found, its value becomes the bound variable's value. If none is found,
the bound variable is assigned a SQL NULL as its value. Once
substitution is finished, the resulting statement is executed. The
return value is a result set object (see \fBtdbc::resultset\fR for
details).
.PP
The \fBresultsets\fR method returns a list of all the result sets that
have been returned by executing the statement and have not yet been
closed.
.PP
The \fBallrows\fR object command executes the statement as with the
\fBexecute\fR object command, accepting an
optional \fIdict\fR parameter giving bind variables. After executing
the statement,
it uses the \fIallrows\fR object command on the result set (see
\fBtdbc::resultset\fR) to construct a list of the results. Finally,
the result set is closed. The return value is the list of
results.
.PP
The \fBforeach\fR object command executes the statement as with the
\fBexecute\fR object command, accepting an
optional \fIdict\fR parameter giving bind variables. After executing
the statement,
it uses the \fIforeach\fR object command on the result set (see
\fBtdbc::resultset\fR) to evaluate the given \fIscript\fR for each row of
the results. Finally, the result set is closed, even
if the given \fIscript\fR results in a \fBreturn\fR, an error, or
an unusual return code.
.PP
The \fBclose\fR object command removes a statement and any result sets
that it has created. All system resources associated with the objects
are freed.
.SH "EXAMPLES"
The following code would look up a telephone number in a directory,
assuming an appropriate SQL schema:
.PP
.CS
package require tdbc::sqlite3
tdbc::sqlite3::connection create db phonebook.sqlite3
set statement [db prepare {
select phone_num from directory
where first_name = :firstname and last_name = :lastname
}]
set firstname Fred
set lastname Flintstone
$statement foreach row {
puts [dict get $row phone_num]
}
$statement close
db close
.CE
.SH "SEE ALSO"
encoding(n), tdbc(n), tdbc::connection(n), tdbc::resultset(n), tdbc::tokenize(n)
.SH "KEYWORDS"
TDBC, SQL, database, connectivity, connection, resultset, statement,
bound variable, stored procedure, call
.SH "COPYRIGHT"
Copyright (c) 2008 by Kevin B. Kenny.
'\" Local Variables:
'\" mode: nroff
'\" End:
'\"

View File

@@ -0,0 +1,101 @@
'\"
'\" tdbc_tokenize.n --
'\"
'\" 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.
'\"
.TH "tdbc::tokenize" n 8.6 Tcl "Tcl Database Connectivity"
'\" .so man.macros
'\" IGNORE
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\" # BS - start boxed text
'\" # ^y = starting y location
'\" # ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
'\" Draw four-sided box normally, but don't draw top of
'\" box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\" # CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
'\" # CE - end code excerpt
.de CE
.fi
.RE
..
'\" END IGNORE
.BS
.SH "NAME"
tdbc::tokenize \- TDBC SQL tokenizer
.SH "SYNOPSIS"
.nf
package require \fBtdbc 1.0\fR
\fBtdbc::tokenize\fR \fIstring\fR
.fi
.BE
.SH "DESCRIPTION"
.PP
As a convenience to database drivers, Tcl Database Connectivity (TDBC)
provides a command to break SQL code apart into tokens so that bound
variables can readily be identified and substituted.
.PP
The \fBtdbc::tokenize\fR command accepts as its parameter a string
that is expected to contain one or more SQL statements. It returns a
list of substrings; concatenating these substrings together will yield
the original string. Each substring is one of the following:
.IP [1]
A bound variable, which begins with one of the
characters '\fB:\fR', '\fB@\fR', or '\fB$\fR'. The
remainder of the string is the variable
name and will consist of alphanumeric characters and underscores. (The
leading character will be be non-numeric.)
.IP [2]
A semicolon that separates two SQL statements.
.IP [3]
Something else in a SQL statement. The tokenizer does not attempt to
parse SQL; it merely identifies bound variables (distinguishing them
from similar strings appearing inside quotes or comments) and
statement delimiters.
.SH "SEE ALSO"
tdbc(n), tdbc::connection(n), tdbc::statement(n), tdbc::resultset(n)
.SH "KEYWORDS"
TDBC, SQL, database, tokenize
.SH "COPYRIGHT"
Copyright (c) 2008 by Kevin B. Kenny.
'\" Local Variables:
'\" mode: nroff
'\" End:
'\"

View 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 */

View 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)
}

View 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"
#define TDBC_PATCHLEVEL "1.1.3"
/*
* 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:
*/

View 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. */

View 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

View 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. */

View 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;
}

View 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;
}

View File

@@ -0,0 +1,922 @@
# tdbc.tcl --
#
# Definitions of base classes from which TDBC drivers' connections,
# statements and result sets may inherit.
#
# 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$
#
#------------------------------------------------------------------------------
package require TclOO
namespace eval ::tdbc {
namespace export connection statement resultset
variable generalError [list TDBC GENERAL_ERROR HY000 {}]
}
#------------------------------------------------------------------------------
#
# tdbc::ParseConvenienceArgs --
#
# Parse the convenience arguments to a TDBC 'execute',
# 'executewithdictionary', or 'foreach' call.
#
# Parameters:
# argv - Arguments to the call
# optsVar -- Name of a variable in caller's scope that will receive
# a dictionary of the supplied options
#
# Results:
# Returns any args remaining after parsing the options.
#
# Side effects:
# Sets the 'opts' dictionary to the options.
#
#------------------------------------------------------------------------------
proc tdbc::ParseConvenienceArgs {argv optsVar} {
variable generalError
upvar 1 $optsVar opts
set opts [dict create -as dicts]
set i 0
# Munch keyword options off the front of the command arguments
foreach {key value} $argv {
if {[string index $key 0] eq {-}} {
switch -regexp -- $key {
-as? {
if {$value ne {dicts} && $value ne {lists}} {
set errorcode $generalError
lappend errorcode badVarType $value
return -code error \
-errorcode $errorcode \
"bad variable type \"$value\":\
must be lists or dicts"
}
dict set opts -as $value
}
-c(?:o(?:l(?:u(?:m(?:n(?:s(?:v(?:a(?:r(?:i(?:a(?:b(?:le?)?)?)?)?)?)?)?)?)?)?)?)?) {
dict set opts -columnsvariable $value
}
-- {
incr i
break
}
default {
set errorcode $generalError
lappend errorcode badOption $key
return -code error \
-errorcode $errorcode \
"bad option \"$key\":\
must be -as or -columnsvariable"
}
}
} else {
break
}
incr i 2
}
return [lrange $argv[set argv {}] $i end]
}
#------------------------------------------------------------------------------
#
# tdbc::connection --
#
# Class that represents a generic connection to a database.
#
#-----------------------------------------------------------------------------
oo::class create ::tdbc::connection {
# statementSeq is the sequence number of the last statement created.
# statementClass is the name of the class that implements the
# 'statement' API.
# primaryKeysStatement is the statement that queries primary keys
# foreignKeysStatement is the statement that queries foreign keys
variable statementSeq primaryKeysStatement foreignKeysStatement
# The base class constructor accepts no arguments. It sets up the
# machinery to do the bookkeeping to keep track of what statements
# are associated with the connection. The derived class constructor
# is expected to set the variable, 'statementClass' to the name
# of the class that represents statements, so that the 'prepare'
# method can invoke it.
constructor {} {
set statementSeq 0
namespace eval Stmt {}
}
# The 'close' method is simply an alternative syntax for destroying
# the connection.
method close {} {
my destroy
}
# The 'prepare' method creates a new statement against the connection,
# giving its constructor the current statement and the SQL code to
# prepare. It uses the 'statementClass' variable set by the constructor
# to get the class to instantiate.
method prepare {sqlcode} {
return [my statementCreate Stmt::[incr statementSeq] [self] $sqlcode]
}
# The 'statementCreate' method delegates to the constructor
# of the class specified by the 'statementClass' variable. It's
# intended for drivers designed before tdbc 1.0b10. Current ones
# should forward this method to the constructor directly.
method statementCreate {name instance sqlcode} {
my variable statementClass
return [$statementClass create $name $instance $sqlcode]
}
# Derived classes are expected to implement the 'prepareCall' method,
# and have it call 'prepare' as needed (or do something else and
# install the resulting statement)
# The 'statements' method lists the statements active against this
# connection.
method statements {} {
info commands Stmt::*
}
# The 'resultsets' method lists the result sets active against this
# connection.
method resultsets {} {
set retval {}
foreach statement [my statements] {
foreach resultset [$statement resultsets] {
lappend retval $resultset
}
}
return $retval
}
# The 'transaction' method executes a block of Tcl code as an
# ACID transaction against the database.
method transaction {script} {
my begintransaction
set status [catch {uplevel 1 $script} result options]
if {$status in {0 2 3 4}} {
set status2 [catch {my commit} result2 options2]
if {$status2 == 1} {
set status 1
set result $result2
set options $options2
}
}
switch -exact -- $status {
0 {
# do nothing
}
2 - 3 - 4 {
set options [dict merge {-level 1} $options[set options {}]]
dict incr options -level
}
default {
my rollback
}
}
return -options $options $result
}
# The 'allrows' method prepares a statement, then executes it with
# a given set of substituents, returning a list of all the rows
# that the statement returns. Optionally, it stores the names of
# the columns in '-columnsvariable'.
# Usage:
# $db allrows ?-as lists|dicts? ?-columnsvariable varName? ?--?
# sql ?dictionary?
method allrows args {
variable ::tdbc::generalError
# Grab keyword-value parameters
set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
# Check postitional parameters
set cmd [list [self] prepare]
if {[llength $args] == 1} {
set sqlcode [lindex $args 0]
} elseif {[llength $args] == 2} {
lassign $args sqlcode dict
} else {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?... ?--? sqlcode ?dictionary?"
}
lappend cmd $sqlcode
# Prepare the statement
set stmt [uplevel 1 $cmd]
# Delegate to the statement to accumulate the results
set cmd [list $stmt allrows {*}$opts --]
if {[info exists dict]} {
lappend cmd $dict
}
set status [catch {
uplevel 1 $cmd
} result options]
# Destroy the statement
catch {
$stmt close
}
return -options $options $result
}
# The 'foreach' method prepares a statement, then executes it with
# a supplied set of substituents. For each row of the result,
# it sets a variable to the row and invokes a script in the caller's
# scope.
#
# Usage:
# $db foreach ?-as lists|dicts? ?-columnsVariable varName? ?--?
# varName sql ?dictionary? script
method foreach args {
variable ::tdbc::generalError
# Grab keyword-value parameters
set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
# Check postitional parameters
set cmd [list [self] prepare]
if {[llength $args] == 3} {
lassign $args varname sqlcode script
} elseif {[llength $args] == 4} {
lassign $args varname sqlcode dict script
} else {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?... ?--? varname sqlcode ?dictionary? script"
}
lappend cmd $sqlcode
# Prepare the statement
set stmt [uplevel 1 $cmd]
# Delegate to the statement to iterate over the results
set cmd [list $stmt foreach {*}$opts -- $varname]
if {[info exists dict]} {
lappend cmd $dict
}
lappend cmd $script
set status [catch {
uplevel 1 $cmd
} result options]
# Destroy the statement
catch {
$stmt close
}
# Adjust return level in the case that the script [return]s
if {$status == 2} {
set options [dict merge {-level 1} $options[set options {}]]
dict incr options -level
}
return -options $options $result
}
# The 'BuildPrimaryKeysStatement' method builds a SQL statement to
# retrieve the primary keys from a database. (It executes once the
# first time the 'primaryKeys' method is executed, and retains the
# prepared statement for reuse.)
method BuildPrimaryKeysStatement {} {
# On some databases, CONSTRAINT_CATALOG is always NULL and
# JOINing to it fails. Check for this case and include that
# JOIN only if catalog names are supplied.
set catalogClause {}
if {[lindex [set count [my allrows -as lists {
SELECT COUNT(*)
FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS
WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} {
set catalogClause \
{AND xtable.CONSTRAINT_CATALOG = xcolumn.CONSTRAINT_CATALOG}
}
set primaryKeysStatement [my prepare "
SELECT xtable.TABLE_SCHEMA AS \"tableSchema\",
xtable.TABLE_NAME AS \"tableName\",
xtable.CONSTRAINT_CATALOG AS \"constraintCatalog\",
xtable.CONSTRAINT_SCHEMA AS \"constraintSchema\",
xtable.CONSTRAINT_NAME AS \"constraintName\",
xcolumn.COLUMN_NAME AS \"columnName\",
xcolumn.ORDINAL_POSITION AS \"ordinalPosition\"
FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS xtable
INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE xcolumn
ON xtable.CONSTRAINT_SCHEMA = xcolumn.CONSTRAINT_SCHEMA
AND xtable.TABLE_NAME = xcolumn.TABLE_NAME
AND xtable.CONSTRAINT_NAME = xcolumn.CONSTRAINT_NAME
$catalogClause
WHERE xtable.TABLE_NAME = :tableName
AND xtable.CONSTRAINT_TYPE = 'PRIMARY KEY'
"]
}
# The default implementation of the 'primarykeys' method uses the
# SQL INFORMATION_SCHEMA to retrieve primary key information. Databases
# that might not have INFORMATION_SCHEMA must overload this method.
method primarykeys {tableName} {
if {![info exists primaryKeysStatement]} {
my BuildPrimaryKeysStatement
}
tailcall $primaryKeysStatement allrows [list tableName $tableName]
}
# The 'BuildForeignKeysStatements' method builds a SQL statement to
# retrieve the foreign keys from a database. (It executes once the
# first time the 'foreignKeys' method is executed, and retains the
# prepared statements for reuse.)
method BuildForeignKeysStatement {} {
# On some databases, CONSTRAINT_CATALOG is always NULL and
# JOINing to it fails. Check for this case and include that
# JOIN only if catalog names are supplied.
set catalogClause1 {}
set catalogClause2 {}
if {[lindex [set count [my allrows -as lists {
SELECT COUNT(*)
FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS
WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} {
set catalogClause1 \
{AND fkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG}
set catalogClause2 \
{AND pkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG}
}
foreach {exists1 clause1} {
0 {}
1 { AND pkc.TABLE_NAME = :primary}
} {
foreach {exists2 clause2} {
0 {}
1 { AND fkc.TABLE_NAME = :foreign}
} {
set stmt [my prepare "
SELECT rc.CONSTRAINT_CATALOG AS \"foreignConstraintCatalog\",
rc.CONSTRAINT_SCHEMA AS \"foreignConstraintSchema\",
rc.CONSTRAINT_NAME AS \"foreignConstraintName\",
rc.UNIQUE_CONSTRAINT_CATALOG
AS \"primaryConstraintCatalog\",
rc.UNIQUE_CONSTRAINT_SCHEMA AS \"primaryConstraintSchema\",
rc.UNIQUE_CONSTRAINT_NAME AS \"primaryConstraintName\",
rc.UPDATE_RULE AS \"updateAction\",
rc.DELETE_RULE AS \"deleteAction\",
pkc.TABLE_CATALOG AS \"primaryCatalog\",
pkc.TABLE_SCHEMA AS \"primarySchema\",
pkc.TABLE_NAME AS \"primaryTable\",
pkc.COLUMN_NAME AS \"primaryColumn\",
fkc.TABLE_CATALOG AS \"foreignCatalog\",
fkc.TABLE_SCHEMA AS \"foreignSchema\",
fkc.TABLE_NAME AS \"foreignTable\",
fkc.COLUMN_NAME AS \"foreignColumn\",
pkc.ORDINAL_POSITION AS \"ordinalPosition\"
FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE fkc
ON fkc.CONSTRAINT_NAME = rc.CONSTRAINT_NAME
AND fkc.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA
$catalogClause1
INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE pkc
ON pkc.CONSTRAINT_NAME = rc.UNIQUE_CONSTRAINT_NAME
AND pkc.CONSTRAINT_SCHEMA = rc.UNIQUE_CONSTRAINT_SCHEMA
$catalogClause2
AND pkc.ORDINAL_POSITION = fkc.ORDINAL_POSITION
WHERE 1=1
$clause1
$clause2
ORDER BY \"foreignConstraintCatalog\", \"foreignConstraintSchema\", \"foreignConstraintName\", \"ordinalPosition\"
"]
dict set foreignKeysStatement $exists1 $exists2 $stmt
}
}
}
# The default implementation of the 'foreignkeys' method uses the
# SQL INFORMATION_SCHEMA to retrieve primary key information. Databases
# that might not have INFORMATION_SCHEMA must overload this method.
method foreignkeys {args} {
variable ::tdbc::generalError
# Check arguments
set argdict {}
if {[llength $args] % 2 != 0} {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?..."
}
foreach {key value} $args {
if {$key ni {-primary -foreign}} {
set errorcode $generalError
lappend errorcode badOption
return -code error -errorcode $errorcode \
"bad option \"$key\", must be -primary or -foreign"
}
set key [string range $key 1 end]
if {[dict exists $argdict $key]} {
set errorcode $generalError
lappend errorcode dupOption
return -code error -errorcode $errorcode \
"duplicate option \"$key\" supplied"
}
dict set argdict $key $value
}
# Build the statements that query foreign keys. There are four
# of them, one for each combination of whether -primary
# and -foreign is specified.
if {![info exists foreignKeysStatement]} {
my BuildForeignKeysStatement
}
set stmt [dict get $foreignKeysStatement \
[dict exists $argdict primary] \
[dict exists $argdict foreign]]
tailcall $stmt allrows $argdict
}
# Derived classes are expected to implement the 'begintransaction',
# 'commit', and 'rollback' methods.
# Derived classes are expected to implement 'tables' and 'columns' method.
}
#------------------------------------------------------------------------------
#
# Class: tdbc::statement
#
# Class that represents a SQL statement in a generic database
#
#------------------------------------------------------------------------------
oo::class create tdbc::statement {
# resultSetSeq is the sequence number of the last result set created.
# resultSetClass is the name of the class that implements the 'resultset'
# API.
variable resultSetClass resultSetSeq
# The base class constructor accepts no arguments. It initializes
# the machinery for tracking the ownership of result sets. The derived
# constructor is expected to invoke the base constructor, and to
# set a variable 'resultSetClass' to the fully-qualified name of the
# class that represents result sets.
constructor {} {
set resultSetSeq 0
namespace eval ResultSet {}
}
# The 'execute' method on a statement runs the statement with
# a particular set of substituted variables. It actually works
# by creating the result set object and letting that objects
# constructor do the work of running the statement. The creation
# is wrapped in an [uplevel] call because the substitution proces
# may need to access variables in the caller's scope.
# WORKAROUND: Take out the '0 &&' from the next line when
# Bug 2649975 is fixed
if {0 && [package vsatisfies [package provide Tcl] 8.6]} {
method execute args {
tailcall my resultSetCreate \
[namespace current]::ResultSet::[incr resultSetSeq] \
[self] {*}$args
}
} else {
method execute args {
return \
[uplevel 1 \
[list \
[self] resultSetCreate \
[namespace current]::ResultSet::[incr resultSetSeq] \
[self] {*}$args]]
}
}
# The 'ResultSetCreate' method is expected to be a forward to the
# appropriate result set constructor. If it's missing, the driver must
# have been designed for tdbc 1.0b9 and earlier, and the 'resultSetClass'
# variable holds the class name.
method resultSetCreate {name instance args} {
return [uplevel 1 [list $resultSetClass create \
$name $instance {*}$args]]
}
# The 'resultsets' method returns a list of result sets produced by
# the current statement
method resultsets {} {
info commands ResultSet::*
}
# The 'allrows' method executes a statement with a given set of
# substituents, and returns a list of all the rows that the statement
# returns. Optionally, it stores the names of columns in
# '-columnsvariable'.
#
# Usage:
# $statement allrows ?-as lists|dicts? ?-columnsvariable varName? ?--?
# ?dictionary?
method allrows args {
variable ::tdbc::generalError
# Grab keyword-value parameters
set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
# Check postitional parameters
set cmd [list [self] execute]
if {[llength $args] == 0} {
# do nothing
} elseif {[llength $args] == 1} {
lappend cmd [lindex $args 0]
} else {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?... ?--? ?dictionary?"
}
# Get the result set
set resultSet [uplevel 1 $cmd]
# Delegate to the result set's [allrows] method to accumulate
# the rows of the result.
set cmd [list $resultSet allrows {*}$opts]
set status [catch {
uplevel 1 $cmd
} result options]
# Destroy the result set
catch {
rename $resultSet {}
}
# Adjust return level in the case that the script [return]s
if {$status == 2} {
set options [dict merge {-level 1} $options[set options {}]]
dict incr options -level
}
return -options $options $result
}
# The 'foreach' method executes a statement with a given set of
# substituents. It runs the supplied script, substituting the supplied
# named variable. Optionally, it stores the names of columns in
# '-columnsvariable'.
#
# Usage:
# $statement foreach ?-as lists|dicts? ?-columnsvariable varName? ?--?
# variableName ?dictionary? script
method foreach args {
variable ::tdbc::generalError
# Grab keyword-value parameters
set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
# Check positional parameters
set cmd [list [self] execute]
if {[llength $args] == 2} {
lassign $args varname script
} elseif {[llength $args] == 3} {
lassign $args varname dict script
lappend cmd $dict
} else {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?... ?--? varName ?dictionary? script"
}
# Get the result set
set resultSet [uplevel 1 $cmd]
# Delegate to the result set's [foreach] method to evaluate
# the script for each row of the result.
set cmd [list $resultSet foreach {*}$opts -- $varname $script]
set status [catch {
uplevel 1 $cmd
} result options]
# Destroy the result set
catch {
rename $resultSet {}
}
# Adjust return level in the case that the script [return]s
if {$status == 2} {
set options [dict merge {-level 1} $options[set options {}]]
dict incr options -level
}
return -options $options $result
}
# The 'close' method is syntactic sugar for invoking the destructor
method close {} {
my destroy
}
# Derived classes are expected to implement their own constructors,
# plus the following methods:
# paramtype paramName ?direction? type ?scale ?precision??
# Declares the type of a parameter in the statement
}
#------------------------------------------------------------------------------
#
# Class: tdbc::resultset
#
# Class that represents a result set in a generic database.
#
#------------------------------------------------------------------------------
oo::class create tdbc::resultset {
constructor {} { }
# The 'allrows' method returns a list of all rows that a given
# result set returns.
method allrows args {
variable ::tdbc::generalError
# Parse args
set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
if {[llength $args] != 0} {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?... ?--? varName script"
}
# Do -columnsvariable if requested
if {[dict exists $opts -columnsvariable]} {
upvar 1 [dict get $opts -columnsvariable] columns
}
# Assemble the results
if {[dict get $opts -as] eq {lists}} {
set delegate nextlist
} else {
set delegate nextdict
}
set results [list]
while {1} {
set columns [my columns]
while {[my $delegate row]} {
lappend results $row
}
if {![my nextresults]} break
}
return $results
}
# The 'foreach' method runs a script on each row from a result set.
method foreach args {
variable ::tdbc::generalError
# Grab keyword-value parameters
set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
# Check positional parameters
if {[llength $args] != 2} {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?... ?--? varName script"
}
# Do -columnsvariable if requested
if {[dict exists $opts -columnsvariable]} {
upvar 1 [dict get $opts -columnsvariable] columns
}
# Iterate over the groups of results
while {1} {
# Export column names to caller
set columns [my columns]
# Iterate over the rows of one group of results
upvar 1 [lindex $args 0] row
if {[dict get $opts -as] eq {lists}} {
set delegate nextlist
} else {
set delegate nextdict
}
while {[my $delegate row]} {
set status [catch {
uplevel 1 [lindex $args 1]
} result options]
switch -exact -- $status {
0 - 4 { # OK or CONTINUE
}
2 { # RETURN
set options \
[dict merge {-level 1} $options[set options {}]]
dict incr options -level
return -options $options $result
}
3 { # BREAK
set broken 1
break
}
default { # ERROR or unknown status
return -options $options $result
}
}
}
# Advance to the next group of results if there is one
if {[info exists broken] || ![my nextresults]} {
break
}
}
return
}
# The 'nextrow' method retrieves a row in the form of either
# a list or a dictionary.
method nextrow {args} {
variable ::tdbc::generalError
set opts [dict create -as dicts]
set i 0
# Munch keyword options off the front of the command arguments
foreach {key value} $args {
if {[string index $key 0] eq {-}} {
switch -regexp -- $key {
-as? {
dict set opts -as $value
}
-- {
incr i
break
}
default {
set errorcode $generalError
lappend errorcode badOption $key
return -code error -errorcode $errorcode \
"bad option \"$key\":\
must be -as or -columnsvariable"
}
}
} else {
break
}
incr i 2
}
set args [lrange $args $i end]
if {[llength $args] != 1} {
set errorcode $generalError
lappend errorcode wrongNumArgs
return -code error -errorcode $errorcode \
"wrong # args: should be [lrange [info level 0] 0 1]\
?-option value?... ?--? varName"
}
upvar 1 [lindex $args 0] row
if {[dict get $opts -as] eq {lists}} {
set delegate nextlist
} else {
set delegate nextdict
}
return [my $delegate row]
}
# Derived classes must override 'nextresults' if a single
# statement execution can yield multiple sets of results
method nextresults {} {
return 0
}
# Derived classes must override 'outputparams' if statements can
# have output parameters.
method outputparams {} {
return {}
}
# The 'close' method is syntactic sugar for destroying the result set.
method close {} {
my destroy
}
# Derived classes are expected to implement the following methods:
# constructor and destructor.
# Constructor accepts a statement and an optional
# a dictionary of substituted parameters and
# executes the statement against the database. If
# the dictionary is not supplied, then the default
# is to get params from variables in the caller's scope).
# columns
# -- Returns a list of the names of the columns in the result.
# nextdict variableName
# -- Stores the next row of the result set in the given variable
# in caller's scope, in the form of a dictionary that maps
# column names to values.
# nextlist variableName
# -- Stores the next row of the result set in the given variable
# in caller's scope, in the form of a list of cells.
# rowcount
# -- Returns a count of rows affected by the statement, or -1
# if the count of rows has not been determined.
}

View File

@@ -0,0 +1,38 @@
This software is copyrighted by Kevin B. Kenny, and by other parties.
The following terms apply to all files associated with the software
unless explicitly disclaimed in individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.
IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.
GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license.

View File

@@ -0,0 +1,26 @@
# -*- tcl -*-
# Tcl package index file, version 1.1
#
# Make sure that TDBC is running in a compatible version of Tcl, and
# that TclOO is available.
if {![package vsatisfies [package provide Tcl] 8.6-]} {
return
}
apply {{dir} {
set libraryfile [file join $dir @PACKAGE_NAME@.tcl]
if {![file exists $libraryfile] && [info exists ::env(TDBC_LIBRARY)]} {
set libraryfile [file join $::env(TDBC_LIBRARY) @PACKAGE_NAME@.tcl]
}
if {[package vsatisfies [package provide Tcl] 9.0-]} {
package ifneeded @PACKAGE_NAME@ @PACKAGE_VERSION@ \
"package require TclOO;\
[list load [file join $dir @PKG_LIB_FILE9@] [string totitle @PACKAGE_NAME@]]\;\
[list source $libraryfile]"
} else {
package ifneeded @PACKAGE_NAME@ @PACKAGE_VERSION@ \
"package require TclOO;\
[list load [file join $dir @PKG_LIB_FILE8@] [string totitle @PACKAGE_NAME@]]\;\
[list source $libraryfile]"
}
}} $dir

View File

@@ -0,0 +1,26 @@
These files comprise the basic building blocks for a Tcl Extension
Architecture (TEA) extension. For more information on TEA see:
http://www.tcl.tk/doc/tea/
This package is part of the Tcl project at SourceForge, but sources
and bug/patch database are hosted on fossil here:
https://core.tcl-lang.org/tclconfig
This package is a freely available open source package. You can do
virtually anything you like with it, such as modifying it, redistributing
it, and selling it either in whole or in part.
CONTENTS
========
The following is a short description of the files you will find in
the sample extension.
README.txt This file
install-sh Program used for copying binaries and script files
to their install locations.
tcl.m4 Collection of Tcl autoconf macros. Included by a package's
aclocal.m4 to define TEA_* macros.

View File

@@ -0,0 +1,518 @@
#!/bin/sh
# install - install a program, script, or datafile
scriptversion=2020-07-26.22; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
# following copyright and license.
#
# Copyright (C) 1994 X Consortium
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# Except as contained in this notice, the name of the X Consortium shall not
# be used in advertising or otherwise to promote the sale, use or other deal-
# ings in this Software without prior written authorization from the X Consor-
# tium.
#
#
# FSF changes to this file are in the public domain.
#
# Calling this script install-sh is preferred over install.sh, to prevent
# 'make' implicit rules from creating a file called install from it
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.
tab=' '
nl='
'
IFS=" $tab$nl"
# Set DOITPROG to "echo" to test this script.
doit=${DOITPROG-}
doit_exec=${doit:-exec}
# Put in absolute file names if you don't have them in your path;
# or use environment vars.
chgrpprog=${CHGRPPROG-chgrp}
chmodprog=${CHMODPROG-chmod}
chownprog=${CHOWNPROG-chown}
cmpprog=${CMPPROG-cmp}
cpprog=${CPPROG-cp}
mkdirprog=${MKDIRPROG-mkdir}
mvprog=${MVPROG-mv}
rmprog=${RMPROG-rm}
stripprog=${STRIPPROG-strip}
posix_mkdir=
# Desired mode of installed file.
mode=0755
# Create dirs (including intermediate dirs) using mode 755.
# This is like GNU 'install' as of coreutils 8.32 (2020).
mkdir_umask=22
chgrpcmd=
chmodcmd=$chmodprog
chowncmd=
mvcmd=$mvprog
rmcmd="$rmprog -f"
stripcmd=
src=
dst=
dir_arg=
dst_arg=
copy_on_change=false
is_target_a_directory=possibly
usage="\
Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
or: $0 [OPTION]... SRCFILES... DIRECTORY
or: $0 [OPTION]... -t DIRECTORY SRCFILES...
or: $0 [OPTION]... -d DIRECTORIES...
In the 1st form, copy SRCFILE to DSTFILE.
In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
In the 4th, create DIRECTORIES.
Options:
--help display this help and exit.
--version display version info and exit.
-c (ignored)
-C install only if different (preserve the last data modification time)
-d create directories instead of installing files.
-g GROUP $chgrpprog installed files to GROUP.
-m MODE $chmodprog installed files to MODE.
-o USER $chownprog installed files to USER.
-s $stripprog installed files.
-S OPTION $stripprog installed files using OPTION.
-t DIRECTORY install into DIRECTORY.
-T report an error if DSTFILE is a directory.
Environment variables override the default commands:
CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
RMPROG STRIPPROG
"
while test $# -ne 0; do
case $1 in
-c) ;;
-C) copy_on_change=true;;
-d) dir_arg=true;;
-g) chgrpcmd="$chgrpprog $2"
shift;;
--help) echo "$usage"; exit $?;;
-m) mode=$2
case $mode in
*' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
echo "$0: invalid mode: $mode" >&2
exit 1;;
esac
shift;;
-o) chowncmd="$chownprog $2"
shift;;
-s) stripcmd=$stripprog;;
-S) stripcmd="$stripprog $2"
shift;;
-t)
is_target_a_directory=always
dst_arg=$2
# Protect names problematic for 'test' and other utilities.
case $dst_arg in
-* | [=\(\)!]) dst_arg=./$dst_arg;;
esac
shift;;
-T) is_target_a_directory=never;;
--version) echo "$0 $scriptversion"; exit $?;;
--) shift
break;;
-*) echo "$0: invalid option: $1" >&2
exit 1;;
*) break;;
esac
shift
done
# We allow the use of options -d and -T together, by making -d
# take the precedence; this is for compatibility with GNU install.
if test -n "$dir_arg"; then
if test -n "$dst_arg"; then
echo "$0: target directory not allowed when installing a directory." >&2
exit 1
fi
fi
if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
# When -d is used, all remaining arguments are directories to create.
# When -t is used, the destination is already specified.
# Otherwise, the last argument is the destination. Remove it from $@.
for arg
do
if test -n "$dst_arg"; then
# $@ is not empty: it contains at least $arg.
set fnord "$@" "$dst_arg"
shift # fnord
fi
shift # arg
dst_arg=$arg
# Protect names problematic for 'test' and other utilities.
case $dst_arg in
-* | [=\(\)!]) dst_arg=./$dst_arg;;
esac
done
fi
if test $# -eq 0; then
if test -z "$dir_arg"; then
echo "$0: no input file specified." >&2
exit 1
fi
# It's OK to call 'install-sh -d' without argument.
# This can happen when creating conditional directories.
exit 0
fi
if test -z "$dir_arg"; then
if test $# -gt 1 || test "$is_target_a_directory" = always; then
if test ! -d "$dst_arg"; then
echo "$0: $dst_arg: Is not a directory." >&2
exit 1
fi
fi
fi
if test -z "$dir_arg"; then
do_exit='(exit $ret); exit $ret'
trap "ret=129; $do_exit" 1
trap "ret=130; $do_exit" 2
trap "ret=141; $do_exit" 13
trap "ret=143; $do_exit" 15
# Set umask so as not to create temps with too-generous modes.
# However, 'strip' requires both read and write access to temps.
case $mode in
# Optimize common cases.
*644) cp_umask=133;;
*755) cp_umask=22;;
*[0-7])
if test -z "$stripcmd"; then
u_plus_rw=
else
u_plus_rw='% 200'
fi
cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
*)
if test -z "$stripcmd"; then
u_plus_rw=
else
u_plus_rw=,u+rw
fi
cp_umask=$mode$u_plus_rw;;
esac
fi
for src
do
# Protect names problematic for 'test' and other utilities.
case $src in
-* | [=\(\)!]) src=./$src;;
esac
if test -n "$dir_arg"; then
dst=$src
dstdir=$dst
test -d "$dstdir"
dstdir_status=$?
else
# Waiting for this to be detected by the "$cpprog $src $dsttmp" command
# might cause directories to be created, which would be especially bad
# if $src (and thus $dsttmp) contains '*'.
if test ! -f "$src" && test ! -d "$src"; then
echo "$0: $src does not exist." >&2
exit 1
fi
if test -z "$dst_arg"; then
echo "$0: no destination specified." >&2
exit 1
fi
dst=$dst_arg
# If destination is a directory, append the input filename.
if test -d "$dst"; then
if test "$is_target_a_directory" = never; then
echo "$0: $dst_arg: Is a directory" >&2
exit 1
fi
dstdir=$dst
dstbase=`basename "$src"`
case $dst in
*/) dst=$dst$dstbase;;
*) dst=$dst/$dstbase;;
esac
dstdir_status=0
else
dstdir=`dirname "$dst"`
test -d "$dstdir"
dstdir_status=$?
fi
fi
case $dstdir in
*/) dstdirslash=$dstdir;;
*) dstdirslash=$dstdir/;;
esac
obsolete_mkdir_used=false
if test $dstdir_status != 0; then
case $posix_mkdir in
'')
# With -d, create the new directory with the user-specified mode.
# Otherwise, rely on $mkdir_umask.
if test -n "$dir_arg"; then
mkdir_mode=-m$mode
else
mkdir_mode=
fi
posix_mkdir=false
# The $RANDOM variable is not portable (e.g., dash). Use it
# here however when possible just to lower collision chance.
tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
trap '
ret=$?
rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
exit $ret
' 0
# Because "mkdir -p" follows existing symlinks and we likely work
# directly in world-writeable /tmp, make sure that the '$tmpdir'
# directory is successfully created first before we actually test
# 'mkdir -p'.
if (umask $mkdir_umask &&
$mkdirprog $mkdir_mode "$tmpdir" &&
exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
then
if test -z "$dir_arg" || {
# Check for POSIX incompatibilities with -m.
# HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
# other-writable bit of parent directory when it shouldn't.
# FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
test_tmpdir="$tmpdir/a"
ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
case $ls_ld_tmpdir in
d????-?r-*) different_mode=700;;
d????-?--*) different_mode=755;;
*) false;;
esac &&
$mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
}
}
then posix_mkdir=:
fi
rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
else
# Remove any dirs left behind by ancient mkdir implementations.
rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
fi
trap '' 0;;
esac
if
$posix_mkdir && (
umask $mkdir_umask &&
$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
)
then :
else
# mkdir does not conform to POSIX,
# or it failed possibly due to a race condition. Create the
# directory the slow way, step by step, checking for races as we go.
case $dstdir in
/*) prefix='/';;
[-=\(\)!]*) prefix='./';;
*) prefix='';;
esac
oIFS=$IFS
IFS=/
set -f
set fnord $dstdir
shift
set +f
IFS=$oIFS
prefixes=
for d
do
test X"$d" = X && continue
prefix=$prefix$d
if test -d "$prefix"; then
prefixes=
else
if $posix_mkdir; then
(umask $mkdir_umask &&
$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
# Don't fail if two instances are running concurrently.
test -d "$prefix" || exit 1
else
case $prefix in
*\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
*) qprefix=$prefix;;
esac
prefixes="$prefixes '$qprefix'"
fi
fi
prefix=$prefix/
done
if test -n "$prefixes"; then
# Don't fail if two instances are running concurrently.
(umask $mkdir_umask &&
eval "\$doit_exec \$mkdirprog $prefixes") ||
test -d "$dstdir" || exit 1
obsolete_mkdir_used=true
fi
fi
fi
if test -n "$dir_arg"; then
{ test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
{ test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
{ test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
else
# Make a couple of temp file names in the proper directory.
dsttmp=${dstdirslash}_inst.$$_
rmtmp=${dstdirslash}_rm.$$_
# Trap to clean up those temp files at exit.
trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
# Copy the file name to the temp name.
(umask $cp_umask &&
{ test -z "$stripcmd" || {
# Create $dsttmp read-write so that cp doesn't create it read-only,
# which would cause strip to fail.
if test -z "$doit"; then
: >"$dsttmp" # No need to fork-exec 'touch'.
else
$doit touch "$dsttmp"
fi
}
} &&
$doit_exec $cpprog "$src" "$dsttmp") &&
# and set any options; do chmod last to preserve setuid bits.
#
# If any of these fail, we abort the whole thing. If we want to
# ignore errors from any of these, just make sure not to ignore
# errors from the above "$doit $cpprog $src $dsttmp" command.
#
{ test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
{ test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
{ test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
{ test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
# If -C, don't bother to copy if it wouldn't change the file.
if $copy_on_change &&
old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
set -f &&
set X $old && old=:$2:$4:$5:$6 &&
set X $new && new=:$2:$4:$5:$6 &&
set +f &&
test "$old" = "$new" &&
$cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
then
rm -f "$dsttmp"
else
# Rename the file to the real destination.
$doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
# The rename failed, perhaps because mv can't rename something else
# to itself, or perhaps because mv is so ancient that it does not
# support -f.
{
# Now remove or move aside any old file at destination location.
# We try this two ways since rm can't unlink itself on some
# systems and the destination file might be busy for other
# reasons. In this case, the final cleanup might fail but the new
# file should still install successfully.
{
test ! -f "$dst" ||
$doit $rmcmd -f "$dst" 2>/dev/null ||
{ $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
{ $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
} ||
{ echo "$0: cannot unlink or rename $dst" >&2
(exit 1); exit 1
}
} &&
# Now rename the file to the real destination.
$doit $mvcmd "$dsttmp" "$dst"
}
fi || exit 1
trap '' 0
fi
done
# Local variables:
# eval: (add-hook 'before-save-hook 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC0"
# time-stamp-end: "; # UTC"
# End:

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,81 @@
# tdbcConfig.sh --
#
# This shell script (for sh) is generated automatically by TDBC's configure
# script. It will create shell variables for most of the configuration options
# discovered by the configure script. This script is intended to be included
# by the configure scripts for TDBC extensions so that they don't have to
# figure this all out for themselves.
#
# The information in this file is specific to a single platform.
#
# RCS: @(#) $Id$
# TDBC's version number
tdbc_VERSION=@PACKAGE_VERSION@
TDBC_VERSION=@PACKAGE_VERSION@
# Name of the TDBC library - may be either a static or shared library
tdbc_LIB_FILE=@PKG_LIB_FILE@
TDBC_LIB_FILE=@PKG_LIB_FILE@
# String to pass to the linker to pick up the TDBC library from its build dir
tdbc_BUILD_LIB_SPEC="@tdbc_BUILD_LIB_SPEC@"
TDBC_BUILD_LIB_SPEC="@tdbc_BUILD_LIB_SPEC@"
# String to pass to the linker to pick up the TDBC library from its installed
# dir.
tdbc_LIB_SPEC="@tdbc_LIB_SPEC@"
TDBC_LIB_SPEC="@tdbc_LIB_SPEC@"
# Name of the TBDC stub library
tdbc_STUB_LIB_FILE="@PKG_STUB_LIB_FILE@"
TDBC_STUB_LIB_FILE="@PKG_STUB_LIB_FILE@"
# String to pass to the linker to pick up the TDBC stub library from its
# build directory
tdbc_BUILD_STUB_LIB_SPEC="@tdbc_BUILD_STUB_LIB_SPEC@"
TDBC_BUILD_STUB_LIB_SPEC="@tdbc_BUILD_STUB_LIB_SPEC@"
# String to pass to the linker to pick up the TDBC stub library from its
# installed directory
tdbc_STUB_LIB_SPEC="@tdbc_STUB_LIB_SPEC@"
TDBC_STUB_LIB_SPEC="@tdbc_STUB_LIB_SPEC@"
# Path name of the TDBC stub library in its build directory
tdbc_BUILD_STUB_LIB_PATH="@tdbc_BUILD_STUB_LIB_PATH@"
TDBC_BUILD_STUB_LIB_PATH="@tdbc_BUILD_STUB_LIB_PATH@"
# Path name of the TDBC stub library in its installed directory
tdbc_STUB_LIB_PATH="@tdbc_STUB_LIB_PATH@"
TDBC_STUB_LIB_PATH="@tdbc_STUB_LIB_PATH@"
# Location of the top-level source directories from which TDBC was built.
# This is the directory that contains doc/, generic/ and so on. If TDBC
# was compiled in a directory other than the source directory, this still
# points to the location of the sources, not the location where TDBC was
# compiled.
tdbc_SRC_DIR="@tdbc_SRC_DIR@"
TDBC_SRC_DIR="@tdbc_SRC_DIR@"
# String to pass to the compiler so that an extension can find installed TDBC
# headers
tdbc_INCLUDE_SPEC="@tdbc_INCLUDE_SPEC@"
TDBC_INCLUDE_SPEC="@tdbc_INCLUDE_SPEC@"
# String to pass to the compiler so that an extension can find TDBC headers
# in the source directory
tdbc_BUILD_INCLUDE_SPEC="@tdbc_BUILD_INCLUDE_SPEC@"
TDBC_BUILD_INCLUDE_SPEC="@tdbc_BUILD_INCLUDE_SPEC@"
# Path name where .tcl files in the tdbc package appear at run time.
tdbc_LIBRARY_PATH="@tdbc_LIB_DIR@"
TDBC_LIBRARY_PATH="@tdbc_LIB_DIR@"
# Path name where .tcl files in the tdbc package appear at build time.
tdbc_BUILD_LIBRARY_PATH="@tdbc_SRC_DIR@/library"
TDBC_BUILD_LIBRARY_PATH="@tdbc_SRC_DIR@/library"
# Additional flags that must be passed to the C compiler to use tdbc
tdbc_CFLAGS=
TDBC_CFLAGS=

View File

@@ -0,0 +1,17 @@
# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests. Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id$
package require Tcl 8.5-
package require tcltest 2.2
::tcltest::configure \
-testdir [file dirname [file normalize [info script]]] \
{*}$argv
::tcltest::runAllTests

View File

@@ -0,0 +1,50 @@
# tdbc.test --
#
# Tests for convenience commands in TDBC
#
# Copyright (c) 2009 by Kevin B. Kenny.
#
# $Id: $
package require tcltest 2
namespace import -force ::tcltest::*
tcltest::loadTestedCommands
package require tdbc
test tdbc-1.1 {tdbc::mapSqlState, wrong args} {*}{
-body {
list [catch {tdbc::mapSqlState} result] $result
}
-match glob
-result {1 {wrong # args:*}}
}
test tdbc-1.2 {tdbc::mapSqlState, wrong args} {*}{
-body {
list [catch {tdbc::mapSqlState 00000 ?} result] $result
}
-match glob
-result {1 {wrong # args:*}}
}
test tdbc-1.3 {tdbc::mapSqlState, known state} {*}{
-body {
tdbc::mapSqlState 22012
}
-result {DATA_EXCEPTION}
}
test tdbc-1.4 {tdbc::mapSqlState, known state} {*}{
-body {
tdbc::mapSqlState *****
}
-result {UNKNOWN_SQLSTATE}
}
cleanupTests
return
# Local Variables:
# mode: tcl
# End:

View File

@@ -0,0 +1,69 @@
# tokenize.test --
#
# Tests for the tokenizer in TDBC
package require tcltest 2
namespace import -force ::tcltest::*
tcltest::loadTestedCommands
package require tdbc
test tokenize-1.0 {wrong args} \
-body {
::tdbc::tokenize
} \
-returnCodes error \
-result {wrong # args: should be "::tdbc::tokenize statement"}
test tokenize-1.1 {wrong args} \
-body {
::tdbc::tokenize foo bar
} \
-returnCodes error \
-result {wrong # args: should be "::tdbc::tokenize statement"}
test tokenize-2.0 {colon substitution, unquoted and quoted} {
::tdbc::tokenize {SELECT :a, ':b' FROM y}
} [list {SELECT } {:a} {, ':b' FROM y}]
test tokenize-2.1 {PostgreSQL cast syntax, not a colon substitution} {
::tdbc::tokenize {SELECT :foo::VARCHAR}
} [list {SELECT } :foo {::VARCHAR}]
test tokenize-3.0 {complex set of statements} {
::tdbc::tokenize {-- begin with a comment :hi;
SELECT :a, ':b', ":c", [:d], /* :e, */ :f FROM y;
INSERT INTO y VALUES(1,2,oracle$name,:g);}
} [list \
"-- begin with a comment :hi;\n\tSELECT " \
:a \
{, ':b', ":c", [:d], /* :e, */ } \
:f \
{ FROM y} \
\; \
"\n\tINSERT INTO y VALUES(1,2,oracle\$name," \
:g \
")" \
";"]
test tokenize-4.0 {unterminated comment} {
::tdbc::tokenize {-- unterminated comment}
} {{-- unterminated comment}}
test tokenize-4.1 {unterminated quote} {
::tdbc::tokenize {' unterminated quote}
} {{' unterminated quote}}
test tokenize-4.2 {unterminated quote} {
::tdbc::tokenize "\" unterminated quote"
} [list "\" unterminated quote"]
test tokenize-4.3 {unterminated quote} {
::tdbc::tokenize "\[ unterminated quote"
} [list "\[ unterminated quote"]
cleanupTests
return
# Local Variables:
# mode: tcl
# End:

View File

@@ -0,0 +1,352 @@
# genExtStubs.tcl --
#
# Generates an import table for one or more external dynamic
# link libraries.
#
# Usage:
#
# tclsh genExtStubs.tcl stubDefs.txt stubStruct.h stubInit.c
#
# Parameters:
#
# stubsDefs.txt --
# Name of a file containing declarations of functions
# to be stubbed. The functions are expected to be in
# stylized C where exach appears on a single line, and
# has the form 'returnType name(param,param,...);'
# In addition, comments of the following forms
# are expected to precede the function declarations.
# /* LIBRARY: name1 name2... */
# These comments give the rootnames of dynamic link
# libraries that are expected to contain the functions,
# in order of preference.
# /* STUBSTRUCT: prefix */
# String to be prepended to the function name that translates
# to its reference in the stub table.
# stubStruct.h --
# Name of a file that will contain (a) the declaration
# of a structure that contains pointers to the stubbed
# functions, and (b) #defines replacing the function name
# with references into the stub table
# parseImports --
#
# Parse the import declarations in a given file
#
# Parameters:
# stubDefs -- Name of the file to parse
#
# Results:
#
# Returns a list of tuples. The possible tuples are:
#
# libraries NAME NAME...
# Sets the names of the
# prefix NAME
# Sets the name of the stub structure to NAME and prefixes
# all the definitions of the stubbed routines with NAME
# import TYPE NAME PARAMS
# Declares the imported routine NAME to return data of type
# TYPE and accept parmeters PARAMS.
proc parseImports {stubDefs} {
set defsFile [open $stubDefs r]
set imports {}
set lineNo 0
while {[gets $defsFile line] >= 0} {
incr lineNo
if {[string is space $line]} {
# do nothing
} elseif {[regexp -expanded -- {
^\s*\*\s*LIBRARY:\s+
([a-zA-Z0-9_]+(?:\s+[a-zA-Z0-9_]+)*) # List of library names
} $line -> m]} {
set libNames $m
lappend imports [linsert $libNames 0 libraries]
} elseif {[regexp {^\s*\*\s*STUBSTRUCT:\s*(.*)} $line -> m]} {
set stubPrefix $m
lappend imports [list prefix $m]
} elseif {[regexp {^\s*\*\s*CONVENTION:\s*(.*)} $line -> c]} {
lappend imports [list convention $c]
} elseif {[regexp -nocase -- {^\s*#} $line]} {
# do nothing
} elseif {[regexp -nocase -expanded -- {
\s*(.*)\s+ # Return type
([[:alpha:]_][[:alnum:]_]+) # Function name
\s*\((.*)\); # Parameters
} $line -> type name params]} {
lappend imports [list import $type $name $params]
} else {
puts stderr "$stubDefs:$lineNo: unrecognized syntax"
}
}
close $defsFile
return $imports
}
# writeStructHeader --
#
# Writes the header of the stubs structure to the '.h' file
#
# Parameters:
# stubDefs -- Name of the input file from which stubs are being
# generated
# stubStruct -- Name of the file .h being written
# structFile -- Channel ID of the .h file being written
#
# Results:
# None.
#
# Side effects:
# Writes the 'struct' header to the .h file
proc writeStructHeader {stubDefs stubStruct structFile} {
chan puts $structFile "/*"
chan puts $structFile " *[string repeat - 77]"
chan puts $structFile " *"
chan puts $structFile " * $stubStruct --"
chan puts $structFile " *"
chan puts $structFile " *\tStubs for procedures in [file tail $stubDefs]"
chan puts $structFile " *"
chan puts $structFile " * Generated by [file tail $::argv0]: DO NOT EDIT"
chan puts $structFile " * [clock format [clock seconds] \
-format {%Y-%m-%d %H:%M:%SZ} -gmt true]"
chan puts $structFile " *"
chan puts $structFile " *[string repeat - 77]"
chan puts $structFile " */"
chan puts $structFile ""
chan puts $structFile "typedef struct [file rootname [file tail $stubDefs]] \{"
return
}
# writeStubDeclarations --
#
# Writes the declarations of the stubs in the table to the .h file.
#
# Parameters:
# structFile -- Channel ID of the .h file
# imports -- List of tuples returned from 'parseImports'
#
# Results:
# None.
#
# Side effects:
# C pointer-to-function declarations are written to the given file.
proc writeStubDeclarations {structFile imports} {
set convention {}
foreach i $imports {
set key [lindex $i 0]
switch -exact -- $key {
convention {
set convention [lindex $i 1]
}
import {
lassign $i key type name params
chan puts $structFile \
" $type (${convention}*${name}Ptr)($params);"
}
libraries {
chan puts $structFile {}
chan puts $structFile \
" /* Functions from libraries: [lrange $i 1 end] */"
chan puts $structFile {}
}
default {
}
}
}
return
}
# writeStructFooter --
#
# Writes the close of the 'struct' declaration to the .h file
#
# Parameters:
# stubDefs -- Name of the struct
# structFile -- Channel handle of the .h file
#
# Results:
# None
#
# Side effects:
# Structure declaration is closed.
proc writeStructFooter {stubDefs structFile} {
chan puts $structFile "\} [file rootname [file tail $stubDefs]]\;"
return
}
# writeStubDefines --
#
# Write the #define directives that replace stub function calls with
# indirections through the stubs table.
#
# Parameters:
# structFile -- Channel id of the .h file
# imports -- Table of imports from parseImports
proc writeStubDefines {structFile imports} {
set stubPrefix {}
foreach i $imports {
switch -exact -- [lindex $i 0] {
prefix {
lassign $i -> stubPrefix
}
import {
lassign $i -> type name params
chan puts $structFile "#define $name ($stubPrefix->${name}Ptr)"
}
}
}
return $stubPrefix
}
# accumulateLibNames --
#
# Accumulates the list of library names into the Stub initialization
#
# Parameters:
# codeVar - Name of variable in caller's scope containing the code
# under construction
# imports - Import definitions from 'parseImports'
#
# Results:
# Returns the code burst for the initialization file.
proc accumulateLibNames {codeVar imports} {
upvar 1 $codeVar code
set sep "\n "
foreach i $imports {
if {[lindex $i 0] eq {libraries}} {
foreach lib [lrange $i 1 end] {
append code $sep \" $lib \"
set sep ", "
}
}
}
append code $sep "NULL"
}
# accumulateSymNames --
#
# Accumulates the list of import symbols into the Stub initialization
#
# Parameters:
# codeVar - Name of variable in caller's scope containing the code
# under construction
# imports - Import definitions from 'parseImports'
#
# Results:
# Returns the code burst for the initialization file.
proc accumulateSymNames {codeVar imports} {
upvar 1 $codeVar code
set inLibrary 0
set sep {}
foreach i $imports {
switch -exact -- [lindex $i 0] {
import {
lassign $i key type name args
append code $sep \n { } \" $name \"
set sep ,
}
}
}
append code $sep \n { NULL}
}
# rewriteInitProgram --
#
# Rewrite the 'stubInit.c' program to contain new definitions
# of imported routines
#
# Parameters:
# oldProgram -- Previous content of the 'stubInit.c' file
# imports -- Import definitions from 'parseImports'
#
# Results:
# Returns the new import program
proc rewriteInitProgram {stubDefs oldProgram imports} {
set newProgram {}
set sep {}
set state {}
foreach piece [split $oldProgram \n] {
switch -exact -- $state {
{} {
switch -regexp -- $piece {
@CREATED@ {
regsub @CREATED@.* $piece {@CREATED@ } piece
append piece [clock format [clock seconds] \
-format {%Y-%m-%d %H:%M:%SZ} \
-gmt 1]
append piece " by " [file tail $::argv0]
append piece " from " $stubDefs
}
@LIBNAMES@ {
set state ignoring
accumulateLibNames piece $imports
}
@SYMNAMES@ {
set state ignoring
accumulateSymNames piece $imports
}
}
append newProgram $sep $piece
set sep \n
}
ignoring {
if {[regexp -- @END@ $piece]} {
set state {}
append newProgram $sep $piece
set sep \n
}
}
}
}
return $newProgram
}
# MAIN PROGRAM - see file header for calling sequence
proc main {stubDefs stubStruct stubInit} {
# Parse the import definitions
set imports [parseImports $stubDefs]
# Write the Stub structure declarations
set structFile [open $stubStruct w]
chan configure $structFile -translation lf
writeStructHeader $stubDefs $stubStruct $structFile
writeStubDeclarations $structFile $imports
writeStructFooter $stubDefs $structFile
set stubPrefix [writeStubDefines $structFile $imports]
chan puts $structFile "MODULE_SCOPE const [file rootname [file tail $stubDefs]]\
*${stubPrefix};"
close $structFile
# Write the initializations of the function names to import
set initFile [open $stubInit r+]
set initProgram [chan read $initFile]
set initProgram [rewriteInitProgram $stubDefs $initProgram $imports]
chan seek $initFile 0
chan truncate $initFile
chan configure $initFile -translation lf
chan puts -nonewline $initFile $initProgram
close $initFile
}
main {*}$argv

View File

@@ -0,0 +1,875 @@
# genStubs.tcl --
#
# This script generates a set of stub files for a given
# interface.
#
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# $Id: genStubs.tcl,v 1.1 2007/05/18 13:35:56 dkf Exp $
#
# SOURCE: tcl/tools/genStubs.tcl, revision 1.17
#
# CHANGES:
# + Don't use _ANSI_ARGS_ macro
# + Remove xxx_TCL_DECLARED #ifdeffery
# + Use application-defined storage class specifier instead of "EXTERN"
# + Add "epoch" and "revision" fields to stubs table record
# + Remove dead code related to USE_*_STUB_PROCS (emitStubs, makeStub)
# + Second argument to "declare" is used as a status guard
# instead of a platform guard.
# + Use void (*reserved$i)(void) = 0 instead of void *reserved$i = NULL
# for unused stub entries, in case pointer-to-function and
# pointer-to-object are different sizes.
# + Allow trailing semicolon in function declarations
# + stubs table is const-qualified
#
package require Tcl 8.5-
namespace eval genStubs {
# libraryName --
#
# The name of the entire library. This value is used to compute
# the USE_*_STUBS macro, the name of the init file, and others.
variable libraryName "UNKNOWN"
# interfaces --
#
# An array indexed by interface name that is used to maintain
# the set of valid interfaces. The value is empty.
array set interfaces {}
# curName --
#
# The name of the interface currently being defined.
variable curName "UNKNOWN"
# scspec --
#
# Storage class specifier for external function declarations.
# Normally "extern", may be set to something like XYZAPI
#
variable scspec "extern"
# epoch, revision --
#
# The epoch and revision numbers of the interface currently being defined.
# (@@@TODO: should be an array mapping interface names -> numbers)
#
variable epoch 0
variable revision 0
# hooks --
#
# An array indexed by interface name that contains the set of
# subinterfaces that should be defined for a given interface.
array set hooks {}
# stubs --
#
# This three dimensional array is indexed first by interface name,
# second by field name, and third by a numeric offset or the
# constant "lastNum". The lastNum entry contains the largest
# numeric offset used for a given interface.
#
# Field "decl,$i" contains the C function specification that
# should be used for the given entry in the stub table. The spec
# consists of a list in the form returned by parseDecl.
# Other fields TBD later.
array set stubs {}
# outDir --
#
# The directory where the generated files should be placed.
variable outDir .
}
# genStubs::library --
#
# This function is used in the declarations file to set the name
# of the library that the interfaces are associated with (e.g. "tcl").
# This value will be used to define the inline conditional macro.
#
# Arguments:
# name The library name.
#
# Results:
# None.
proc genStubs::library {name} {
variable libraryName $name
}
# genStubs::interface --
#
# This function is used in the declarations file to set the name
# of the interface currently being defined.
#
# Arguments:
# name The name of the interface.
#
# Results:
# None.
proc genStubs::interface {name} {
variable curName $name
variable interfaces
variable stubs
set interfaces($name) {}
set stubs($name,lastNum) 0
return
}
# genStubs::scspec --
#
# Define the storage class macro used for external function declarations.
# Typically, this will be a macro like XYZAPI or EXTERN that
# expands to either DLLIMPORT or DLLEXPORT, depending on whether
# -DBUILD_XYZ has been set.
#
proc genStubs::scspec {value} {
variable scspec $value
}
# genStubs::epoch --
#
# Define the epoch number for this library. The epoch
# should be incrememented when a release is made that
# contains incompatible changes to the public API.
#
proc genStubs::epoch {value} {
variable epoch $value
}
# genStubs::hooks --
#
# This function defines the subinterface hooks for the current
# interface.
#
# Arguments:
# names The ordered list of interfaces that are reachable through the
# hook vector.
#
# Results:
# None.
proc genStubs::hooks {names} {
variable curName
variable hooks
set hooks($curName) $names
return
}
# genStubs::declare --
#
# This function is used in the declarations file to declare a new
# interface entry.
#
# Arguments:
# index The index number of the interface.
# status Status of the interface: one of "current",
# "deprecated", or "obsolete".
# decl The C function declaration, or {} for an undefined
# entry.
#
proc genStubs::declare {index status decl} {
variable stubs
variable curName
variable revision
incr revision
# Check for duplicate declarations, then add the declaration and
# bump the lastNum counter if necessary.
if {[info exists stubs($curName,decl,$index)]} {
puts stderr "Duplicate entry: $index"
}
regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
set decl [parseDecl $decl]
set stubs($curName,status,$index) $status
set stubs($curName,decl,$index) $decl
if {$index > $stubs($curName,lastNum)} {
set stubs($curName,lastNum) $index
}
return
}
# genStubs::rewriteFile --
#
# This function replaces the machine generated portion of the
# specified file with new contents. It looks for the !BEGIN! and
# !END! comments to determine where to place the new text.
#
# Arguments:
# file The name of the file to modify.
# text The new text to place in the file.
#
# Results:
# None.
proc genStubs::rewriteFile {file text} {
if {![file exists $file]} {
puts stderr "Cannot find file: $file"
return
}
set in [open ${file} r]
set out [open ${file}.new w]
fconfigure $out -translation lf
while {![eof $in]} {
set line [gets $in]
if {[string match "*!BEGIN!*" $line]} {
break
}
puts $out $line
}
puts $out "/* !BEGIN!: Do not edit below this line. */"
puts $out $text
while {![eof $in]} {
set line [gets $in]
if {[string match "*!END!*" $line]} {
break
}
}
puts $out "/* !END!: Do not edit above this line. */"
puts -nonewline $out [read $in]
close $in
close $out
file rename -force ${file}.new ${file}
return
}
# genStubs::addPlatformGuard --
#
# Wrap a string inside a platform #ifdef.
#
# Arguments:
# plat Platform to test.
#
# Results:
# Returns the original text inside an appropriate #ifdef.
proc genStubs::addPlatformGuard {plat text} {
switch $plat {
win {
return "#ifdef _WIN32\n${text}#endif /* _WIN32 */\n"
}
unix {
return "#if !defined(_WIN32) /* UNIX */\n${text}#endif /* UNIX */\n"
}
macosx {
return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n"
}
aqua {
return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n"
}
x11 {
return "#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n"
}
}
return "$text"
}
# genStubs::emitSlots --
#
# Generate the stub table slots for the given interface.
#
# Arguments:
# name The name of the interface being emitted.
# textVar The variable to use for output.
#
# Results:
# None.
proc genStubs::emitSlots {name textVar} {
upvar $textVar text
forAllStubs $name makeSlot noGuard text {" void (*reserved$i)(void);\n"}
return
}
# genStubs::parseDecl --
#
# Parse a C function declaration into its component parts.
#
# Arguments:
# decl The function declaration.
#
# Results:
# Returns a list of the form {returnType name args}. The args
# element consists of a list of type/name pairs, or a single
# element "void". If the function declaration is malformed
# then an error is displayed and the return value is {}.
proc genStubs::parseDecl {decl} {
if {![regexp {^(.*)\((.*)\);?$} $decl all prefix args]} {
puts stderr "Malformed declaration: $decl"
return
}
set prefix [string trim $prefix]
if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} {
puts stderr "Bad return type: $decl"
return
}
set rtype [string trim $rtype]
foreach arg [split $args ,] {
lappend argList [string trim $arg]
}
if {![string compare [lindex $argList end] "..."]} {
if {[llength $argList] != 2} {
puts stderr "Only one argument is allowed in varargs form: $decl"
}
set arg [parseArg [lindex $argList 0]]
if {$arg == "" || ([llength $arg] != 2)} {
puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'"
return
}
set args [list TCL_VARARGS $arg]
} else {
set args {}
foreach arg $argList {
set argInfo [parseArg $arg]
if {![string compare $argInfo "void"]} {
lappend args "void"
break
} elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
lappend args $argInfo
} else {
puts stderr "Bad argument: '$arg' in '$decl'"
return
}
}
}
return [list $rtype $fname $args]
}
# genStubs::parseArg --
#
# This function parses a function argument into a type and name.
#
# Arguments:
# arg The argument to parse.
#
# Results:
# Returns a list of type and name with an optional third array
# indicator. If the argument is malformed, returns "".
proc genStubs::parseArg {arg} {
if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
if {$arg == "void"} {
return $arg
} else {
return
}
}
set result [list [string trim $type] $name]
if {$array != ""} {
lappend result $array
}
return $result
}
# genStubs::makeDecl --
#
# Generate the prototype for a function.
#
# Arguments:
# name The interface name.
# decl The function declaration.
# index The slot index for this function.
#
# Results:
# Returns the formatted declaration string.
proc genStubs::makeDecl {name decl index} {
variable scspec
lassign $decl rtype fname args
append text "/* $index */\n"
set line "$scspec $rtype"
set count [expr {2 - ([string length $line] / 8)}]
append line [string range "\t\t\t" 0 $count]
set pad [expr {24 - [string length $line]}]
if {$pad <= 0} {
append line " "
set pad 0
}
append line "$fname "
set arg1 [lindex $args 0]
switch -exact $arg1 {
void {
append line "(void)"
}
TCL_VARARGS {
set arg [lindex $args 1]
append line "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
}
default {
set sep "("
foreach arg $args {
append line $sep
set next {}
append next [lindex $arg 0] " " [lindex $arg 1] \
[lindex $arg 2]
if {[string length $line] + [string length $next] \
+ $pad > 76} {
append text [string trimright $line] \n
set line "\t\t\t\t"
set pad 28
}
append line $next
set sep ", "
}
append line ")"
}
}
append text $line
append text ";\n"
return $text
}
# genStubs::makeMacro --
#
# Generate the inline macro for a function.
#
# Arguments:
# name The interface name.
# decl The function declaration.
# index The slot index for this function.
#
# Results:
# Returns the formatted macro definition.
proc genStubs::makeMacro {name decl index} {
lassign $decl rtype fname args
set lfname [string tolower [string index $fname 0]]
append lfname [string range $fname 1 end]
set text "#define $fname"
set arg1 [lindex $args 0]
set argList ""
switch -exact $arg1 {
void {
set argList "()"
}
TCL_VARARGS {
}
default {
set sep "("
foreach arg $args {
append argList $sep [lindex $arg 1]
set sep ", "
}
append argList ")"
}
}
append text " \\\n\t(${name}StubsPtr->$lfname)"
append text " /* $index */\n"
return $text
}
# genStubs::makeSlot --
#
# Generate the stub table entry for a function.
#
# Arguments:
# name The interface name.
# decl The function declaration.
# index The slot index for this function.
#
# Results:
# Returns the formatted table entry.
proc genStubs::makeSlot {name decl index} {
lassign $decl rtype fname args
set lfname [string tolower [string index $fname 0]]
append lfname [string range $fname 1 end]
set text " "
append text $rtype " (*" $lfname ") "
set arg1 [lindex $args 0]
switch -exact $arg1 {
void {
append text "(void)"
}
TCL_VARARGS {
set arg [lindex $args 1]
append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
}
default {
set sep "("
foreach arg $args {
append text $sep [lindex $arg 0] " " [lindex $arg 1] \
[lindex $arg 2]
set sep ", "
}
append text ")"
}
}
append text "; /* $index */\n"
return $text
}
# genStubs::makeInit --
#
# Generate the prototype for a function.
#
# Arguments:
# name The interface name.
# decl The function declaration.
# index The slot index for this function.
#
# Results:
# Returns the formatted declaration string.
proc genStubs::makeInit {name decl index} {
append text " " [lindex $decl 1] ", /* " $index " */\n"
return $text
}
# genStubs::forAllStubs --
#
# This function iterates over all of the slots and invokes
# a callback for each slot. The result of the callback is then
# placed inside appropriate guards.
#
# Arguments:
# name The interface name.
# slotProc The proc to invoke to handle the slot. It will
# have the interface name, the declaration, and
# the index appended.
# guardProc The proc to invoke to add guards. It will have
# the slot status and text appended.
# textVar The variable to use for output.
# skipString The string to emit if a slot is skipped. This
# string will be subst'ed in the loop so "$i" can
# be used to substitute the index value.
#
# Results:
# None.
proc genStubs::forAllStubs {name slotProc guardProc textVar
{skipString {"/* Slot $i is reserved */\n"}}} {
variable stubs
upvar $textVar text
set lastNum $stubs($name,lastNum)
for {set i 0} {$i <= $lastNum} {incr i} {
if {[info exists stubs($name,decl,$i)]} {
append text [$guardProc $stubs($name,status,$i) \
[$slotProc $name $stubs($name,decl,$i) $i]]
} else {
eval {append text} $skipString
}
}
}
proc genStubs::noGuard {status text} { return $text }
proc genStubs::addGuard {status text} {
variable libraryName
set upName [string toupper $libraryName]
switch -- $status {
current {
# No change
}
deprecated {
set text [ifdeffed "${upName}_DEPRECATED" $text]
}
obsolete {
set text ""
}
default {
puts stderr "Unrecognized status code $status"
}
}
return $text
}
proc genStubs::ifdeffed {macro text} {
join [list "#ifdef $macro" $text "#endif" ""] \n
}
# genStubs::emitDeclarations --
#
# This function emits the function declarations for this interface.
#
# Arguments:
# name The interface name.
# textVar The variable to use for output.
#
# Results:
# None.
proc genStubs::emitDeclarations {name textVar} {
upvar $textVar text
append text "\n/*\n * Exported function declarations:\n */\n\n"
forAllStubs $name makeDecl noGuard text
return
}
# genStubs::emitMacros --
#
# This function emits the inline macros for an interface.
#
# Arguments:
# name The name of the interface being emitted.
# textVar The variable to use for output.
#
# Results:
# None.
proc genStubs::emitMacros {name textVar} {
variable libraryName
upvar $textVar text
set upName [string toupper $libraryName]
append text "\n#if defined(USE_${upName}_STUBS)\n"
append text "\n/*\n * Inline function declarations:\n */\n\n"
forAllStubs $name makeMacro addGuard text
append text "\n#endif /* defined(USE_${upName}_STUBS) */\n"
return
}
# genStubs::emitHeader --
#
# This function emits the body of the <name>Decls.h file for
# the specified interface.
#
# Arguments:
# name The name of the interface being emitted.
#
# Results:
# None.
proc genStubs::emitHeader {name} {
variable outDir
variable hooks
variable epoch
variable revision
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
set CAPName [string toupper $name]
append text "\n"
append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
append text "#define ${CAPName}_STUBS_REVISION $revision\n"
append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
emitDeclarations $name text
if {[info exists hooks($name)]} {
append text "\ntypedef struct {\n"
foreach hook $hooks($name) {
set capHook [string toupper [string index $hook 0]]
append capHook [string range $hook 1 end]
append text " const struct ${capHook}Stubs *${hook}Stubs;\n"
}
append text "} ${capName}StubHooks;\n"
}
append text "\ntypedef struct ${capName}Stubs {\n"
append text " int magic;\n"
append text " int epoch;\n"
append text " int revision;\n"
if {[info exists hooks($name)]} {
append text " const ${capName}StubHooks *hooks;\n\n"
} else {
append text " void *hooks;\n\n"
}
emitSlots $name text
append text "} ${capName}Stubs;\n\n"
append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n"
append text "#ifdef __cplusplus\n}\n#endif\n"
emitMacros $name text
rewriteFile [file join $outDir ${name}Decls.h] $text
return
}
# genStubs::emitInit --
#
# Generate the table initializers for an interface.
#
# Arguments:
# name The name of the interface to initialize.
# textVar The variable to use for output.
#
# Results:
# Returns the formatted output.
proc genStubs::emitInit {name textVar} {
variable hooks
variable interfaces
variable epoch
upvar $textVar text
set root 1
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
set CAPName [string toupper $name]
if {[info exists hooks($name)]} {
append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
set sep " "
foreach sub $hooks($name) {
append text $sep "&${sub}Stubs"
set sep ",\n "
}
append text "\n\};\n"
}
foreach intf [array names interfaces] {
if {[info exists hooks($intf)]} {
if {[lsearch -exact $hooks($intf) $name] >= 0} {
set root 0
break
}
}
}
append text "\n"
if {!$root} {
append text "static "
}
append text "const ${capName}Stubs ${name}Stubs = \{\n"
append text " TCL_STUB_MAGIC,\n"
append text " ${CAPName}_STUBS_EPOCH,\n"
append text " ${CAPName}_STUBS_REVISION,\n"
if {[info exists hooks($name)]} {
append text " &${name}StubHooks,\n"
} else {
append text " 0,\n"
}
forAllStubs $name makeInit noGuard text {" 0, /* $i */\n"}
append text "\};\n"
return
}
# genStubs::emitInits --
#
# This function emits the body of the <name>StubInit.c file for
# the specified interface.
#
# Arguments:
# name The name of the interface being emitted.
#
# Results:
# None.
proc genStubs::emitInits {} {
variable hooks
variable outDir
variable libraryName
variable interfaces
# Assuming that dependencies only go one level deep, we need to emit
# all of the leaves first to avoid needing forward declarations.
set leaves {}
set roots {}
foreach name [lsort [array names interfaces]] {
if {[info exists hooks($name)]} {
lappend roots $name
} else {
lappend leaves $name
}
}
foreach name $leaves {
emitInit $name text
}
foreach name $roots {
emitInit $name text
}
rewriteFile [file join $outDir ${libraryName}StubInit.c] $text
}
# genStubs::init --
#
# This is the main entry point.
#
# Arguments:
# None.
#
# Results:
# None.
proc genStubs::init {} {
global argv argv0
variable outDir
variable interfaces
if {[llength $argv] < 2} {
puts stderr "usage: $argv0 outDir declFile ?declFile...?"
exit 1
}
set outDir [lindex $argv 0]
foreach file [lrange $argv 1 end] {
source $file
}
foreach name [lsort [array names interfaces]] {
puts "Emitting $name"
emitHeader $name
}
emitInits
}
# lassign --
#
# This function emulates the TclX lassign command.
#
# Arguments:
# valueList A list containing the values to be assigned.
# args The list of variables to be assigned.
#
# Results:
# Returns any values that were not assigned to variables.
proc lassign {valueList args} {
if {[llength $args] == 0} {
error "wrong # args: lassign list varname ?varname..?"
}
uplevel [list foreach $args $valueList {break}]
return [lrange $valueList [llength $args] end]
}
genStubs::init

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,103 @@
#------------------------------------------------------------- -*- makefile -*-
#
# Makefile for TBDC Core
#
# Basic build, test and install
# nmake /s /nologo /f makefile.vc INSTALLDIR=c:\path\to\installdir
# nmake /s /nologo /f makefile.vc INSTALLDIR=c:\path\to\installdir
# nmake /s /nologo /f makefile.vc INSTALLDIR=c:\path\to\installdir
#
# For other build options (debug, static etc.)
# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for
# detailed documentation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------
PROJECT = tdbc
RCFILE = tdbc.rc
!include "rules-ext.vc"
!if [echo REM = This file is generated from Makefile.vc > versions.vc]
!endif
!if [echo TCL_VERSION_REQ = \>> versions.vc] \
&& [nmakehlp -V ..\configure.ac TCL_VERSION_REQ >> versions.vc]
!endif
!if [echo TCL_VERSION_DESIRED = \>> versions.vc] \
&& [nmakehlp -V ..\configure.ac TCL_VERSION_DESIRED >> versions.vc]
!endif
!if [echo TCLOO_VERSION_REQ = \>> versions.vc] \
&& [nmakehlp -V ..\configure.ac TCLOO_VERSION_REQ >> versions.vc]
!endif
!include "versions.vc"
PRJ_OBJS = \
$(TMP_DIR)\tdbc.obj \
$(TMP_DIR)\tdbcStubInit.obj \
$(TMP_DIR)\tdbcTokenize.obj
PRJ_STUBOBJS = \
$(TMP_DIR)\tdbcStubLib.obj
PRJ_HEADERS_PUBLIC = \
$(GENERICDIR)\tdbc.h \
$(GENERICDIR)\tdbcDecls.h
PRJ_HEADERS = \
$(PRJ_HEADERS_PUBLIC) \
$(GENERICDIR)\tdbcInt.h
# Define the standard targets including install, test, shell
!include "$(_RULESDIR)\targets.vc"
# The TIP 477 generation of pkgIndex.tcl from pkgIndex.tcl.in does not include
# all replacements below so define our own it.
pkgindex: $(OUT_DIR)\pkgIndex.tcl
$(OUT_DIR)\pkgIndex.tcl: $(ROOT)\pkgIndex.tcl.in
@nmakehlp -s << $** > $@
@PACKAGE_NAME@ $(PROJECT)
@PACKAGE_VERSION@ $(DOTVERSION)
@TCL_VERSION_REQ@ $(TCL_VERSION_REQ)
@TCL_VERSION_DESIRED@ $(TCL_VERSION_DESIRED)
@TCLOO_VERSION_REQ@ $(TCLOO_VERSION_REQ)
@PKG_LIB_FILE@ $(PRJLIBNAME)
@PKG_LIB_FILE8@ $(PRJLIBNAME8)
@PKG_LIB_FILE9@ $(PRJLIBNAME9)
@TCL_VERSION@ $(TCL_DOTVERSION)
<<
.PHONY: $(OUT_DIR)\tdbcConfig.sh
# TBD - this (meaning using nmake builds for autoconf) does not really work
# and never has. Perhaps it should be removed.
$(OUT_DIR)\tdbcConfig.sh: $(ROOT)\tdbcConfig.sh.in
nmakehlp -s << $** > $@
@PACKAGE_VERSION@ $(DOTVERSION)
@PKG_LIB_FILE@ $(PRJLIBNAME)
@PKG_LIB_FILE8@ $(PRJLIBNAME8)
@PKG_LIB_FILE9@ $(PRJLIBNAME9)
@tdbc_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PRJLIBNAME)
@PKG_STUB_LIB_FILE@ $(PRJSTUBLIBNAME)
@tdbc_BUILD_STUB_LIB_SPEC@ $(PRJSTUBLIB)
@tdbc_STUB_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PRJSTUBLIBNAME)
@tdbc_BUILD_STUB_LIB_PATH@ $(PRJSTUBLIB)
@tdbc_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(PRJSTUBLIBNAME)
@tdbc_SRC_DIR@ $(ROOT)
@tdbc_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
@tdbc_BUILD_INCLUDE_SPEC@ -I$(GENERICDIR)
@tdbc_LIB_DIR@ $(LIB_INSTALL_DIR)
<<
# TDBC has additional installation in addition to that provided by
# the default installation targets.
install: default-install-docs-n
default-install-libraries: install-tdbc-extras
install-tdbc-extras: $(OUT_DIR)\tdbcConfig.sh
@$(CPY) $(OUT_DIR)\tdbcConfig.sh "$(LIB_INSTALL_DIR)"

View File

@@ -0,0 +1,815 @@
/*
* ----------------------------------------------------------------------------
* nmakehlp.c --
*
* This is used to fix limitations within nmake and the environment.
*
* Copyright (c) 2002 by David Gravereaux.
* Copyright (c) 2006 by Pat Thoyts
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
* ----------------------------------------------------------------------------
*/
#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#endif
#include <stdio.h>
#include <math.h>
/*
* This library is required for x64 builds with _some_ versions of MSVC
*/
#if defined(_M_IA64) || defined(_M_AMD64)
#if _MSC_VER >= 1400 && _MSC_VER < 1500
#pragma comment(lib, "bufferoverflowU")
#endif
#endif
/* ISO hack for dumb VC++ */
#ifdef _MSC_VER
#define snprintf _snprintf
#endif
/* protos */
static int CheckForCompilerFeature(const char *option);
static int CheckForLinkerFeature(char **options, int count);
static int IsIn(const char *string, const char *substring);
static int SubstituteFile(const char *substs, const char *filename);
static int QualifyPath(const char *path);
static int LocateDependency(const char *keyfile);
static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
static DWORD WINAPI ReadFromPipe(LPVOID args);
/* globals */
#define CHUNK 25
#define STATICBUFFERSIZE 1000
typedef struct {
HANDLE pipe;
char buffer[STATICBUFFERSIZE];
} pipeinfo;
pipeinfo Out = {INVALID_HANDLE_VALUE, ""};
pipeinfo Err = {INVALID_HANDLE_VALUE, ""};
/*
* exitcodes: 0 == no, 1 == yes, 2 == error
*/
int
main(
int argc,
char *argv[])
{
char msg[300];
DWORD dwWritten;
int chars;
const char *s;
/*
* Make sure children (cl.exe and link.exe) are kept quiet.
*/
SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);
/*
* Make sure the compiler and linker aren't effected by the outside world.
*/
SetEnvironmentVariable("CL", "");
SetEnvironmentVariable("LINK", "");
if (argc > 1 && *argv[1] == '-') {
switch (*(argv[1]+1)) {
case 'c':
if (argc != 3) {
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -c <compiler option>\n"
"Tests for whether cl.exe supports an option\n"
"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
&dwWritten, NULL);
return 2;
}
return CheckForCompilerFeature(argv[2]);
case 'l':
if (argc < 3) {
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -l <linker option> ?<mandatory option> ...?\n"
"Tests for whether link.exe supports an option\n"
"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
&dwWritten, NULL);
return 2;
}
return CheckForLinkerFeature(&argv[2], argc-2);
case 'f':
if (argc == 2) {
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -f <string> <substring>\n"
"Find a substring within another\n"
"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
&dwWritten, NULL);
return 2;
} else if (argc == 3) {
/*
* If the string is blank, there is no match.
*/
return 0;
} else {
return IsIn(argv[2], argv[3]);
}
case 's':
if (argc == 2) {
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -s <substitutions file> <file>\n"
"Perform a set of string map type substutitions on a file\n"
"exitcodes: 0\n",
argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
&dwWritten, NULL);
return 2;
}
return SubstituteFile(argv[2], argv[3]);
case 'V':
if (argc != 4) {
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -V filename matchstring\n"
"Extract a version from a file:\n"
"eg: pkgIndex.tcl \"package ifneeded http\"",
argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
&dwWritten, NULL);
return 0;
}
s = GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0');
if (s && *s) {
printf("%s\n", s);
return 0;
} else
return 1; /* Version not found. Return non-0 exit code */
case 'Q':
if (argc != 3) {
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -Q path\n"
"Emit the fully qualified path\n"
"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
&dwWritten, NULL);
return 2;
}
return QualifyPath(argv[2]);
case 'L':
if (argc != 3) {
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -L keypath\n"
"Emit the fully qualified path of directory containing keypath\n"
"exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
&dwWritten, NULL);
return 2;
}
return LocateDependency(argv[2]);
}
}
chars = snprintf(msg, sizeof(msg) - 1,
"usage: %s -c|-f|-l|-Q|-s|-V ...\n"
"This is a little helper app to equalize shell differences between WinNT and\n"
"Win9x and get nmake.exe to accomplish its job.\n",
argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
return 2;
}
static int
CheckForCompilerFeature(
const char *option)
{
STARTUPINFO si;
PROCESS_INFORMATION pi;
SECURITY_ATTRIBUTES sa;
DWORD threadID;
char msg[300];
BOOL ok;
HANDLE hProcess, h, pipeThreads[2];
char cmdline[100];
hProcess = GetCurrentProcess();
ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
ZeroMemory(&si, sizeof(STARTUPINFO));
si.cb = sizeof(STARTUPINFO);
si.dwFlags = STARTF_USESTDHANDLES;
si.hStdInput = INVALID_HANDLE_VALUE;
ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
sa.nLength = sizeof(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor = NULL;
sa.bInheritHandle = FALSE;
/*
* Create a non-inheritible pipe.
*/
CreatePipe(&Out.pipe, &h, &sa, 0);
/*
* Dupe the write side, make it inheritible, and close the original.
*/
DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
/*
* Same as above, but for the error side.
*/
CreatePipe(&Err.pipe, &h, &sa, 0);
DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
/*
* Base command line.
*/
lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch ");
/*
* Append our option for testing
*/
lstrcat(cmdline, option);
/*
* Filename to compile, which exists, but is nothing and empty.
*/
lstrcat(cmdline, " .\\nul");
ok = CreateProcess(
NULL, /* Module name. */
cmdline, /* Command line. */
NULL, /* Process handle not inheritable. */
NULL, /* Thread handle not inheritable. */
TRUE, /* yes, inherit handles. */
DETACHED_PROCESS, /* No console for you. */
NULL, /* Use parent's environment block. */
NULL, /* Use parent's starting directory. */
&si, /* Pointer to STARTUPINFO structure. */
&pi); /* Pointer to PROCESS_INFORMATION structure. */
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
(300-chars), 0);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
/*
* Close our references to the write handles that have now been inherited.
*/
CloseHandle(si.hStdOutput);
CloseHandle(si.hStdError);
WaitForInputIdle(pi.hProcess, 5000);
CloseHandle(pi.hThread);
/*
* Start the pipe reader threads.
*/
pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
/*
* Block waiting for the process to end.
*/
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
/*
* Wait for our pipe to get done reading, should it be a little slow.
*/
WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
CloseHandle(pipeThreads[0]);
CloseHandle(pipeThreads[1]);
/*
* Look for the commandline warning code in both streams.
* - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
*/
return !(strstr(Out.buffer, "D4002") != NULL
|| strstr(Err.buffer, "D4002") != NULL
|| strstr(Out.buffer, "D9002") != NULL
|| strstr(Err.buffer, "D9002") != NULL
|| strstr(Out.buffer, "D2021") != NULL
|| strstr(Err.buffer, "D2021") != NULL);
}
static int
CheckForLinkerFeature(
char **options,
int count)
{
STARTUPINFO si;
PROCESS_INFORMATION pi;
SECURITY_ATTRIBUTES sa;
DWORD threadID;
char msg[300];
BOOL ok;
HANDLE hProcess, h, pipeThreads[2];
int i;
char cmdline[255];
hProcess = GetCurrentProcess();
ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
ZeroMemory(&si, sizeof(STARTUPINFO));
si.cb = sizeof(STARTUPINFO);
si.dwFlags = STARTF_USESTDHANDLES;
si.hStdInput = INVALID_HANDLE_VALUE;
ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
sa.nLength = sizeof(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor = NULL;
sa.bInheritHandle = TRUE;
/*
* Create a non-inheritible pipe.
*/
CreatePipe(&Out.pipe, &h, &sa, 0);
/*
* Dupe the write side, make it inheritible, and close the original.
*/
DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
/*
* Same as above, but for the error side.
*/
CreatePipe(&Err.pipe, &h, &sa, 0);
DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
/*
* Base command line.
*/
lstrcpy(cmdline, "link.exe -nologo ");
/*
* Append our option for testing.
*/
for (i = 0; i < count; i++) {
lstrcat(cmdline, " \"");
lstrcat(cmdline, options[i]);
lstrcat(cmdline, "\"");
}
ok = CreateProcess(
NULL, /* Module name. */
cmdline, /* Command line. */
NULL, /* Process handle not inheritable. */
NULL, /* Thread handle not inheritable. */
TRUE, /* yes, inherit handles. */
DETACHED_PROCESS, /* No console for you. */
NULL, /* Use parent's environment block. */
NULL, /* Use parent's starting directory. */
&si, /* Pointer to STARTUPINFO structure. */
&pi); /* Pointer to PROCESS_INFORMATION structure. */
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
(300-chars), 0);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
/*
* Close our references to the write handles that have now been inherited.
*/
CloseHandle(si.hStdOutput);
CloseHandle(si.hStdError);
WaitForInputIdle(pi.hProcess, 5000);
CloseHandle(pi.hThread);
/*
* Start the pipe reader threads.
*/
pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
/*
* Block waiting for the process to end.
*/
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
/*
* Wait for our pipe to get done reading, should it be a little slow.
*/
WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
CloseHandle(pipeThreads[0]);
CloseHandle(pipeThreads[1]);
/*
* Look for the commandline warning code in the stderr stream.
*/
return !(strstr(Out.buffer, "LNK1117") != NULL ||
strstr(Err.buffer, "LNK1117") != NULL ||
strstr(Out.buffer, "LNK4044") != NULL ||
strstr(Err.buffer, "LNK4044") != NULL ||
strstr(Out.buffer, "LNK4224") != NULL ||
strstr(Err.buffer, "LNK4224") != NULL);
}
static DWORD WINAPI
ReadFromPipe(
LPVOID args)
{
pipeinfo *pi = (pipeinfo *) args;
char *lastBuf = pi->buffer;
DWORD dwRead;
BOOL ok;
again:
if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) {
CloseHandle(pi->pipe);
return (DWORD)-1;
}
ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L);
if (!ok || dwRead == 0) {
CloseHandle(pi->pipe);
return 0;
}
lastBuf += dwRead;
goto again;
return 0; /* makes the compiler happy */
}
static int
IsIn(
const char *string,
const char *substring)
{
return (strstr(string, substring) != NULL);
}
/*
* GetVersionFromFile --
* Looks for a match string in a file and then returns the version
* following the match where a version is anything acceptable to
* package provide or package ifneeded.
*/
static const char *
GetVersionFromFile(
const char *filename,
const char *match,
int numdots)
{
static char szBuffer[100];
char *szResult = NULL;
FILE *fp = fopen(filename, "rt");
if (fp != NULL) {
/*
* Read data until we see our match string.
*/
while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
LPSTR p, q;
p = strstr(szBuffer, match);
if (p != NULL) {
/*
* Skip to first digit after the match.
*/
p += strlen(match);
while (*p && !isdigit((unsigned char)*p)) {
++p;
}
/*
* Find ending whitespace.
*/
q = p;
while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q)
&& !strchr("ab", q[-1])) || --numdots))) {
++q;
}
*q = 0;
szResult = p;
break;
}
}
fclose(fp);
}
return szResult;
}
/*
* List helpers for the SubstituteFile function
*/
typedef struct list_item_t {
struct list_item_t *nextPtr;
char * key;
char * value;
} list_item_t;
/* insert a list item into the list (list may be null) */
static list_item_t *
list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
{
list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t));
if (itemPtr) {
itemPtr->key = strdup(key);
itemPtr->value = strdup(value);
itemPtr->nextPtr = NULL;
while(*listPtrPtr) {
listPtrPtr = &(*listPtrPtr)->nextPtr;
}
*listPtrPtr = itemPtr;
}
return itemPtr;
}
static void
list_free(list_item_t **listPtrPtr)
{
list_item_t *tmpPtr, *listPtr = *listPtrPtr;
while (listPtr) {
tmpPtr = listPtr;
listPtr = listPtr->nextPtr;
free(tmpPtr->key);
free(tmpPtr->value);
free(tmpPtr);
}
}
/*
* SubstituteFile --
* As windows doesn't provide anything useful like sed and it's unreliable
* to use the tclsh you are building against (consider x-platform builds -
* eg compiling AMD64 target from IX86) we provide a simple substitution
* option here to handle autoconf style substitutions.
* The substitution file is whitespace and line delimited. The file should
* consist of lines matching the regular expression:
* \s*\S+\s+\S*$
*
* Usage is something like:
* nmakehlp -S << $** > $@
* @PACKAGE_NAME@ $(PACKAGE_NAME)
* @PACKAGE_VERSION@ $(PACKAGE_VERSION)
* <<
*/
static int
SubstituteFile(
const char *substitutions,
const char *filename)
{
static char szBuffer[1024], szCopy[1024];
list_item_t *substPtr = NULL;
FILE *fp, *sp;
fp = fopen(filename, "rt");
if (fp != NULL) {
/*
* Build a list of substutitions from the first filename
*/
sp = fopen(substitutions, "rt");
if (sp != NULL) {
while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) {
unsigned char *ks, *ke, *vs, *ve;
ks = (unsigned char*)szBuffer;
while (ks && *ks && isspace(*ks)) ++ks;
ke = ks;
while (ke && *ke && !isspace(*ke)) ++ke;
vs = ke;
while (vs && *vs && isspace(*vs)) ++vs;
ve = vs;
while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve;
*ke = 0, *ve = 0;
list_insert(&substPtr, (char*)ks, (char*)vs);
}
fclose(sp);
}
/* debug: dump the list */
#ifndef NDEBUG
{
int n = 0;
list_item_t *p = NULL;
for (p = substPtr; p != NULL; p = p->nextPtr, ++n) {
fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value);
}
}
#endif
/*
* Run the substitutions over each line of the input
*/
while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
list_item_t *p = NULL;
for (p = substPtr; p != NULL; p = p->nextPtr) {
char *m = strstr(szBuffer, p->key);
if (m) {
char *cp, *op, *sp;
cp = szCopy;
op = szBuffer;
while (op != m) *cp++ = *op++;
sp = p->value;
while (sp && *sp) *cp++ = *sp++;
op += strlen(p->key);
while (*op) *cp++ = *op++;
*cp = 0;
memcpy(szBuffer, szCopy, sizeof(szCopy));
}
}
printf("%s", szBuffer);
}
list_free(&substPtr);
}
fclose(fp);
return 0;
}
BOOL FileExists(LPCTSTR szPath)
{
#ifndef INVALID_FILE_ATTRIBUTES
#define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
#endif
DWORD pathAttr = GetFileAttributes(szPath);
return (pathAttr != INVALID_FILE_ATTRIBUTES &&
!(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
}
/*
* QualifyPath --
*
* This composes the current working directory with a provided path
* and returns the fully qualified and normalized path.
* Mostly needed to setup paths for testing.
*/
static int
QualifyPath(
const char *szPath)
{
char szCwd[MAX_PATH + 1];
GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
printf("%s\n", szCwd);
return 0;
}
/*
* Implements LocateDependency for a single directory. See that command
* for an explanation.
* Returns 0 if found after printing the directory.
* Returns 1 if not found but no errors.
* Returns 2 on any kind of error
* Basically, these are used as exit codes for the process.
*/
static int LocateDependencyHelper(const char *dir, const char *keypath)
{
HANDLE hSearch;
char path[MAX_PATH+1];
size_t dirlen;
int keylen, ret;
WIN32_FIND_DATA finfo;
if (dir == NULL || keypath == NULL)
return 2; /* Have no real error reporting mechanism into nmake */
dirlen = strlen(dir);
if ((dirlen + 3) > sizeof(path))
return 2;
strncpy(path, dir, dirlen);
strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */
keylen = strlen(keypath);
#if 0 /* This function is not available in Visual C++ 6 */
/*
* Use numerics 0 -> FindExInfoStandard,
* 1 -> FindExSearchLimitToDirectories,
* as these are not defined in Visual C++ 6
*/
hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
#else
hSearch = FindFirstFile(path, &finfo);
#endif
if (hSearch == INVALID_HANDLE_VALUE)
return 1; /* Not found */
/* Loop through all subdirs checking if the keypath is under there */
ret = 1; /* Assume not found */
do {
int sublen;
/*
* We need to check it is a directory despite the
* FindExSearchLimitToDirectories in the above call. See SDK docs
*/
if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
continue;
sublen = strlen(finfo.cFileName);
if ((dirlen+1+sublen+1+keylen+1) > sizeof(path))
continue; /* Path does not fit, assume not matched */
strncpy(path+dirlen+1, finfo.cFileName, sublen);
path[dirlen+1+sublen] = '\\';
strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
if (FileExists(path)) {
/* Found a match, print to stdout */
path[dirlen+1+sublen] = '\0';
QualifyPath(path);
ret = 0;
break;
}
} while (FindNextFile(hSearch, &finfo));
FindClose(hSearch);
return ret;
}
/*
* LocateDependency --
*
* Locates a dependency for a package.
* keypath - a relative path within the package directory
* that is used to confirm it is the correct directory.
* The search path for the package directory is currently only
* the parent and grandparent of the current working directory.
* If found, the command prints
* name_DIRPATH=<full path of located directory>
* and returns 0. If not found, does not print anything and returns 1.
*/
static int LocateDependency(const char *keypath)
{
size_t i;
int ret;
static const char *paths[] = {"..", "..\\..", "..\\..\\.."};
for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
ret = LocateDependencyHelper(paths[i], keypath);
if (ret == 0)
return ret;
}
return ret;
}
/*
* Local variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* indent-tabs-mode: t
* tab-width: 8
* End:
*/

View File

@@ -0,0 +1,118 @@
# This file should only be included in makefiles for Tcl extensions,
# NOT in the makefile for Tcl itself.
!ifndef _RULES_EXT_VC
# We need to run from the directory the parent makefile is located in.
# nmake does not tell us what makefile was used to invoke it so parent
# makefile has to set the MAKEFILEVC macro or we just make a guess and
# warn if we think that is not the case.
!if "$(MAKEFILEVC)" == ""
!if exist("$(PROJECT).vc")
MAKEFILEVC = $(PROJECT).vc
!elseif exist("makefile.vc")
MAKEFILEVC = makefile.vc
!endif
!endif # "$(MAKEFILEVC)" == ""
!if !exist("$(MAKEFILEVC)")
MSG = ^
You must run nmake from the directory containing the project makefile.^
If you are doing that and getting this message, set the MAKEFILEVC^
macro to the name of the project makefile.
!message WARNING: $(MSG)
!endif
!if "$(PROJECT)" == "tcl"
!error The rules-ext.vc file is not intended for Tcl itself.
!endif
# We extract version numbers using the nmakehlp program. For now use
# the local copy of nmakehlp. Once we locate Tcl, we will use that
# one if it is newer.
!if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul]
!endif
# First locate the Tcl directory that we are working with.
!if "$(TCLDIR)" != ""
_RULESDIR = $(TCLDIR:/=\)
!else
# If an installation path is specified, that is also the Tcl directory.
# Also Tk never builds against an installed Tcl, it needs Tcl sources
!if defined(INSTALLDIR) && "$(PROJECT)" != "tk"
_RULESDIR=$(INSTALLDIR:/=\)
!else
# Locate Tcl sources
!if [echo _RULESDIR = \> nmakehlp.out] \
|| [nmakehlp -L generic\tcl.h >> nmakehlp.out]
_RULESDIR = ..\..\tcl
!else
!include nmakehlp.out
!endif
!endif # defined(INSTALLDIR)....
!endif # ifndef TCLDIR
# Now look for the targets.vc file under the Tcl root. Note we check this
# file and not rules.vc because the latter also exists on older systems.
!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl
_RULESDIR = $(_RULESDIR)\lib\nmake
!elseif exist("$(_RULESDIR)\win\targets.vc") # Building against Tcl sources
_RULESDIR = $(_RULESDIR)\win
!else
# If we have not located Tcl's targets file, most likely we are compiling
# against an older version of Tcl and so must use our own support files.
_RULESDIR = .
!endif
!if "$(_RULESDIR)" != "."
# Potentially using Tcl's support files. If this extension has its own
# nmake support files, need to compare the versions and pick newer.
!if exist("rules.vc") # The extension has its own copy
!if [echo TCL_RULES_MAJOR = \> versions.vc] \
&& [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc]
!endif
!if [echo TCL_RULES_MINOR = \>> versions.vc] \
&& [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc]
!endif
!if [echo OUR_RULES_MAJOR = \>> versions.vc] \
&& [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc]
!endif
!if [echo OUR_RULES_MINOR = \>> versions.vc] \
&& [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc]
!endif
!include versions.vc
# We have a newer version of the support files, use them
!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR))
_RULESDIR = .
!endif
!endif # if exist("rules.vc")
!endif # if $(_RULESDIR) != "."
# Let rules.vc know what copy of nmakehlp.c to use.
NMAKEHLPC = $(_RULESDIR)\nmakehlp.c
# Get rid of our internal defines before calling rules.vc
!undef TCL_RULES_MAJOR
!undef TCL_RULES_MINOR
!undef OUR_RULES_MAJOR
!undef OUR_RULES_MINOR
!if exist("$(_RULESDIR)\rules.vc")
!message *** Using $(_RULESDIR)\rules.vc
!include "$(_RULESDIR)\rules.vc"
!else
!error *** Could not locate rules.vc in $(_RULESDIR)
!endif
!endif # _RULES_EXT_VC

1869
pkgs/tdbc1.1.3/win/rules.vc Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,98 @@
#------------------------------------------------------------- -*- makefile -*-
# targets.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file defines some standard targets for the convenience of extensions
# and can be optionally included by the extension makefile.
# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for docs.
$(PROJECT): setup pkgindex $(PRJLIB)
!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
$(PRJSTUBLIB): $(PRJ_STUBOBJS)
$(LIBCMD) $**
$(PRJ_STUBOBJS):
$(CCSTUBSCMD) %s
!endif # PRJ_STUBOBJS
!ifdef PRJ_MANIFEST
$(PROJECT): $(PRJLIB).manifest
$(PRJLIB).manifest: $(PRJ_MANIFEST)
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
<<
!endif
!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
$(PRJLIB): $(PRJ_OBJS) $(RESFILE)
!if $(STATIC_BUILD)
$(LIBCMD) $**
!else
$(DLLCMD) $**
$(_VC_MANIFEST_EMBED_DLL)
!endif
-@del $*.exp
!endif
!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != ""
$(PRJ_OBJS): $(PRJ_HEADERS)
!endif
# If parent makefile has defined stub objects, add their installation
# to the default install
!if "$(PRJ_STUBOBJS)" != ""
default-install: default-install-stubs
!endif
# Unlike the other default targets, these cannot be in rules.vc because
# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
# that the parent makefile will not define until after including rules-ext.vc
!if "$(PRJ_HEADERS_PUBLIC)" != ""
default-install: default-install-headers
default-install-headers:
@echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
@for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
!endif
!if "$(DISABLE_STANDARD_TARGETS)" == ""
DISABLE_STANDARD_TARGETS = 0
!endif
!if "$(DISABLE_TARGET_setup)" == ""
DISABLE_TARGET_setup = 0
!endif
!if "$(DISABLE_TARGET_install)" == ""
DISABLE_TARGET_install = 0
!endif
!if "$(DISABLE_TARGET_clean)" == ""
DISABLE_TARGET_clean = 0
!endif
!if "$(DISABLE_TARGET_test)" == ""
DISABLE_TARGET_test = 0
!endif
!if "$(DISABLE_TARGET_shell)" == ""
DISABLE_TARGET_shell = 0
!endif
!if !$(DISABLE_STANDARD_TARGETS)
!if !$(DISABLE_TARGET_setup)
setup: default-setup
!endif
!if !$(DISABLE_TARGET_install)
install: default-install
!endif
!if !$(DISABLE_TARGET_clean)
clean: default-clean
realclean: hose
hose: default-hose
distclean: realclean default-distclean
!endif
!if !$(DISABLE_TARGET_test)
test: default-test
!endif
!if !$(DISABLE_TARGET_shell)
shell: default-shell
!endif
!endif # DISABLE_STANDARD_TARGETS

View File

@@ -0,0 +1,39 @@
// tdbc.rc - Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
//
// There is no need to modify this file.
//
#include <winver.h>
VS_VERSION_INFO VERSIONINFO
FILEVERSION COMMAVERSION
PRODUCTVERSION COMMAVERSION
FILEFLAGSMASK 0x3fL
#ifdef DEBUG
FILEFLAGS VS_FF_DEBUG
#else
FILEFLAGS 0x0L
#endif
FILEOS VOS__WINDOWS32
FILETYPE VFT_DLL
FILESUBTYPE 0x0L
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "040904b0"
BEGIN
VALUE "FileDescription", "Tcl Database Connectivity " DOTVERSION "\0"
VALUE "OriginalFilename", PRJLIBNAME
VALUE "CompanyName", "The Tcl Development Community\0"
VALUE "FileVersion", DOTVERSION "\0"
VALUE "LegalCopyright", "Copyright \251 2008 Kevin Kenny et al.\0"
VALUE "Copyright", "Copyright \251 2008 Kevin Kenny et al.\0"
VALUE "ProductName", "Tcl Database Connectivity " DOTVERSION "\0"
VALUE "ProductVersion", DOTVERSION "\0"
END
END
BLOCK "VarFileInfo"
BEGIN
VALUE "Translation", 0x409, 1200
END
END