mirror of
https://git.postgresql.org/git/postgresql.git
synced 2024-11-21 03:13:05 +08:00
Remove all of the libpgtcl and pgtclsh files, including all references to
them within the various makefiles with_tcl is still required for the src/pl/tcl language
This commit is contained in:
PostgreSQL Daemon
parent
d1b3915ce1
commit
41fa9e9bae
@ -1,7 +1,7 @@
|
||||
#
|
||||
# PostgreSQL top level makefile
|
||||
#
|
||||
# $PostgreSQL: pgsql/GNUmakefile.in,v 1.37 2004/01/19 21:20:04 tgl Exp $
|
||||
# $PostgreSQL: pgsql/GNUmakefile.in,v 1.38 2004/04/20 00:33:44 pgsql Exp $
|
||||
#
|
||||
|
||||
subdir =
|
||||
@ -71,8 +71,6 @@ $(distdir).tar: distdir
|
||||
|
||||
opt_files := \
|
||||
src/tools src/corba src/tutorial \
|
||||
src/bin/pgtclsh \
|
||||
$(addprefix src/interfaces/, libpgtcl) \
|
||||
$(addprefix src/pl/, plperl plpython tcl)
|
||||
|
||||
docs_files := doc/postgres.tar.gz doc/src doc/TODO.detail
|
||||
|
||||
121
configure
vendored
121
configure
vendored
@ -859,9 +859,7 @@ Optional Packages:
|
||||
--with-libs=DIRS alternative spelling of --with-libraries
|
||||
--with-pgport=PORTNUM change default port number 5432
|
||||
--with-tcl build Tcl and Tk interfaces
|
||||
--without-tk do not build Tk interfaces if Tcl is enabled
|
||||
--with-tclconfig=DIR tclConfig.sh and tkConfig.sh are in DIR
|
||||
--with-tkconfig=DIR tkConfig.sh is in DIR
|
||||
--with-tclconfig=DIR tclConfig.sh is in DIR
|
||||
--with-perl build Perl modules (PL/Perl)
|
||||
--with-python build Python modules (PL/Python)
|
||||
--with-krb4 build with Kerberos 4 support
|
||||
@ -2999,44 +2997,6 @@ echo "$as_me:$LINENO: result: $with_tcl" >&5
|
||||
echo "${ECHO_T}$with_tcl" >&6
|
||||
|
||||
|
||||
# If Tcl is enabled (above) then Tk is also, unless the user disables it using --without-tk
|
||||
echo "$as_me:$LINENO: checking whether to build with Tk" >&5
|
||||
echo $ECHO_N "checking whether to build with Tk... $ECHO_C" >&6
|
||||
if test "$with_tcl" = yes; then
|
||||
|
||||
|
||||
|
||||
# Check whether --with-tk or --without-tk was given.
|
||||
if test "${with_tk+set}" = set; then
|
||||
withval="$with_tk"
|
||||
|
||||
case $withval in
|
||||
yes)
|
||||
:
|
||||
;;
|
||||
no)
|
||||
:
|
||||
;;
|
||||
*)
|
||||
{ { echo "$as_me:$LINENO: error: no argument expected for --with-tk option" >&5
|
||||
echo "$as_me: error: no argument expected for --with-tk option" >&2;}
|
||||
{ (exit 1); exit 1; }; }
|
||||
;;
|
||||
esac
|
||||
|
||||
else
|
||||
with_tk=yes
|
||||
|
||||
fi;
|
||||
|
||||
else
|
||||
with_tk=no
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $with_tk" >&5
|
||||
echo "${ECHO_T}$with_tk" >&6
|
||||
|
||||
|
||||
|
||||
# We see if the path to the Tcl/Tk configuration scripts is specified.
|
||||
# This will override the use of tclsh to find the paths to search.
|
||||
|
||||
@ -3066,35 +3026,6 @@ echo "$as_me: error: argument required for --with-tclconfig option" >&2;}
|
||||
fi;
|
||||
|
||||
|
||||
# We see if the path to the Tk configuration scripts is specified.
|
||||
# This will override the use of tclsh to find the paths to search.
|
||||
|
||||
|
||||
|
||||
|
||||
# Check whether --with-tkconfig or --without-tkconfig was given.
|
||||
if test "${with_tkconfig+set}" = set; then
|
||||
withval="$with_tkconfig"
|
||||
|
||||
case $withval in
|
||||
yes)
|
||||
{ { echo "$as_me:$LINENO: error: argument required for --with-tkconfig option" >&5
|
||||
echo "$as_me: error: argument required for --with-tkconfig option" >&2;}
|
||||
{ (exit 1); exit 1; }; }
|
||||
;;
|
||||
no)
|
||||
{ { echo "$as_me:$LINENO: error: argument required for --with-tkconfig option" >&5
|
||||
echo "$as_me: error: argument required for --with-tkconfig option" >&2;}
|
||||
{ (exit 1); exit 1; }; }
|
||||
;;
|
||||
*)
|
||||
|
||||
;;
|
||||
esac
|
||||
|
||||
fi;
|
||||
|
||||
|
||||
#
|
||||
# Optionally build Perl modules (PL/Perl)
|
||||
#
|
||||
@ -17233,51 +17164,6 @@ eval TCL_SHARED_BUILD=\"$TCL_SHARED_BUILD\"
|
||||
|
||||
fi
|
||||
|
||||
# Check for Tk configuration script tkConfig.sh
|
||||
if test "$with_tk" = yes; then
|
||||
echo "$as_me:$LINENO: checking for tkConfig.sh" >&5
|
||||
echo $ECHO_N "checking for tkConfig.sh... $ECHO_C" >&6
|
||||
# Let user override test
|
||||
if test -z "$TK_CONFIG_SH"; then
|
||||
pgac_test_dirs="$with_tkconfig $with_tclconfig"
|
||||
|
||||
set X $pgac_test_dirs; shift
|
||||
if test $# -eq 0; then
|
||||
test -z "$TCLSH" && { { echo "$as_me:$LINENO: error: unable to locate tkConfig.sh because no Tcl shell was found" >&5
|
||||
echo "$as_me: error: unable to locate tkConfig.sh because no Tcl shell was found" >&2;}
|
||||
{ (exit 1); exit 1; }; }
|
||||
set X `echo 'puts $auto_path' | $TCLSH`; shift
|
||||
fi
|
||||
|
||||
for pgac_dir do
|
||||
if test -r "$pgac_dir/tkConfig.sh"; then
|
||||
TK_CONFIG_SH=$pgac_dir/tkConfig.sh
|
||||
break
|
||||
fi
|
||||
done
|
||||
fi
|
||||
|
||||
if test -z "$TK_CONFIG_SH"; then
|
||||
echo "$as_me:$LINENO: result: no" >&5
|
||||
echo "${ECHO_T}no" >&6
|
||||
{ { echo "$as_me:$LINENO: error: file 'tkConfig.sh' is required for Tk" >&5
|
||||
echo "$as_me: error: file 'tkConfig.sh' is required for Tk" >&2;}
|
||||
{ (exit 1); exit 1; }; }
|
||||
else
|
||||
echo "$as_me:$LINENO: result: $TK_CONFIG_SH" >&5
|
||||
echo "${ECHO_T}$TK_CONFIG_SH" >&6
|
||||
fi
|
||||
|
||||
|
||||
|
||||
. "$TK_CONFIG_SH"
|
||||
eval TK_LIBS=\"$TK_LIBS\"
|
||||
eval TK_LIB_SPEC=\"$TK_LIB_SPEC\"
|
||||
eval TK_XINCLUDES=\"$TK_XINCLUDES\"
|
||||
|
||||
fi
|
||||
|
||||
|
||||
#
|
||||
# Check for DocBook and tools
|
||||
#
|
||||
@ -18197,7 +18083,6 @@ s,@autodepend@,$autodepend,;t t
|
||||
s,@INCLUDES@,$INCLUDES,;t t
|
||||
s,@enable_thread_safety@,$enable_thread_safety,;t t
|
||||
s,@with_tcl@,$with_tcl,;t t
|
||||
s,@with_tk@,$with_tk,;t t
|
||||
s,@with_perl@,$with_perl,;t t
|
||||
s,@with_python@,$with_python,;t t
|
||||
s,@with_krb4@,$with_krb4,;t t
|
||||
@ -18253,10 +18138,6 @@ s,@TCL_LIBS@,$TCL_LIBS,;t t
|
||||
s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t
|
||||
s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t
|
||||
s,@TCL_SHLIB_LD_LIBS@,$TCL_SHLIB_LD_LIBS,;t t
|
||||
s,@TK_CONFIG_SH@,$TK_CONFIG_SH,;t t
|
||||
s,@TK_LIBS@,$TK_LIBS,;t t
|
||||
s,@TK_LIB_SPEC@,$TK_LIB_SPEC,;t t
|
||||
s,@TK_XINCLUDES@,$TK_XINCLUDES,;t t
|
||||
s,@NSGMLS@,$NSGMLS,;t t
|
||||
s,@JADE@,$JADE,;t t
|
||||
s,@have_docbook@,$have_docbook,;t t
|
||||
|
||||
27
configure.in
27
configure.in
@ -1,5 +1,5 @@
|
||||
dnl Process this file with autoconf to produce a configure script.
|
||||
dnl $PostgreSQL: pgsql/configure.in,v 1.322 2004/03/24 03:54:16 momjian Exp $
|
||||
dnl $PostgreSQL: pgsql/configure.in,v 1.323 2004/04/20 00:33:45 pgsql Exp $
|
||||
dnl
|
||||
dnl Developers, please strive to achieve this order:
|
||||
dnl
|
||||
@ -372,26 +372,10 @@ PGAC_ARG_BOOL(with, tcl, no, [ --with-tcl build Tcl and Tk interfa
|
||||
AC_MSG_RESULT([$with_tcl])
|
||||
AC_SUBST([with_tcl])
|
||||
|
||||
# If Tcl is enabled (above) then Tk is also, unless the user disables it using --without-tk
|
||||
AC_MSG_CHECKING([whether to build with Tk])
|
||||
if test "$with_tcl" = yes; then
|
||||
PGAC_ARG_BOOL(with, tk, yes, [ --without-tk do not build Tk interfaces if Tcl is enabled])
|
||||
else
|
||||
with_tk=no
|
||||
fi
|
||||
AC_MSG_RESULT([$with_tk])
|
||||
AC_SUBST([with_tk])
|
||||
|
||||
|
||||
# We see if the path to the Tcl/Tk configuration scripts is specified.
|
||||
# This will override the use of tclsh to find the paths to search.
|
||||
|
||||
PGAC_ARG_REQ(with, tclconfig, [ --with-tclconfig=DIR tclConfig.sh and tkConfig.sh are in DIR])
|
||||
|
||||
# We see if the path to the Tk configuration scripts is specified.
|
||||
# This will override the use of tclsh to find the paths to search.
|
||||
|
||||
PGAC_ARG_REQ(with, tkconfig, [ --with-tkconfig=DIR tkConfig.sh is in DIR])
|
||||
PGAC_ARG_REQ(with, tclconfig, [ --with-tclconfig=DIR tclConfig.sh is in DIR])
|
||||
|
||||
#
|
||||
# Optionally build Perl modules (PL/Perl)
|
||||
@ -1189,13 +1173,6 @@ if test "$with_tcl" = yes; then
|
||||
AC_SUBST(TCL_SHLIB_LD_LIBS)dnl don't want to double-evaluate that one
|
||||
fi
|
||||
|
||||
# Check for Tk configuration script tkConfig.sh
|
||||
if test "$with_tk" = yes; then
|
||||
PGAC_PATH_TKCONFIGSH([$with_tkconfig $with_tclconfig])
|
||||
PGAC_EVAL_TCLCONFIGSH([$TK_CONFIG_SH], [TK_LIBS,TK_LIB_SPEC,TK_XINCLUDES])
|
||||
fi
|
||||
|
||||
|
||||
#
|
||||
# Check for DocBook and tools
|
||||
#
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# -*-makefile-*-
|
||||
# $PostgreSQL: pgsql/src/Makefile.global.in,v 1.176 2004/03/10 21:12:46 momjian Exp $
|
||||
# $PostgreSQL: pgsql/src/Makefile.global.in,v 1.177 2004/04/20 00:33:46 pgsql Exp $
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# All PostgreSQL makefiles include this file and use the variables it sets,
|
||||
@ -123,7 +123,6 @@ localedir := @localedir@
|
||||
with_perl = @with_perl@
|
||||
with_python = @with_python@
|
||||
with_tcl = @with_tcl@
|
||||
with_tk = @with_tk@
|
||||
enable_shared = @enable_shared@
|
||||
enable_rpath = @enable_rpath@
|
||||
enable_nls = @enable_nls@
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
# Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group
|
||||
# Portions Copyright (c) 1994, Regents of the University of California
|
||||
#
|
||||
# $PostgreSQL: pgsql/src/bin/Makefile,v 1.41 2003/12/17 18:44:08 petere Exp $
|
||||
# $PostgreSQL: pgsql/src/bin/Makefile,v 1.42 2004/04/20 00:33:47 pgsql Exp $
|
||||
#
|
||||
#-------------------------------------------------------------------------
|
||||
|
||||
@ -17,10 +17,6 @@ DIRS := initdb initlocation ipcclean pg_ctl pg_dump \
|
||||
psql scripts pg_config pg_controldata pg_resetxlog \
|
||||
pg_encoding
|
||||
|
||||
ifeq ($(with_tcl), yes)
|
||||
DIRS += pgtclsh
|
||||
endif
|
||||
|
||||
all install installdirs uninstall depend distprep:
|
||||
@for dir in $(DIRS); do $(MAKE) -C $$dir $@ || exit; done
|
||||
|
||||
|
||||
@ -1,58 +0,0 @@
|
||||
#-------------------------------------------------------------------------
|
||||
#
|
||||
# Makefile for src/bin/pgtclsh
|
||||
# (a tclsh workalike with pgtcl commands installed)
|
||||
#
|
||||
# Portions Copyright (c) 1996-2002, PostgreSQL Global Development Group
|
||||
# Portions Copyright (c) 1994, Regents of the University of California
|
||||
#
|
||||
# $PostgreSQL: pgsql/src/bin/pgtclsh/Makefile,v 1.43 2003/12/19 11:54:25 petere Exp $
|
||||
#
|
||||
#-------------------------------------------------------------------------
|
||||
|
||||
subdir = src/bin/pgtclsh
|
||||
top_builddir = ../../..
|
||||
include $(top_builddir)/src/Makefile.global
|
||||
|
||||
|
||||
libpgtcl_srcdir = $(top_srcdir)/src/interfaces/libpgtcl
|
||||
libpgtcl_builddir = $(top_builddir)/src/interfaces/libpgtcl
|
||||
libpgtcl = -L$(libpgtcl_builddir) -lpgtcl
|
||||
|
||||
override CPPFLAGS := -I$(libpgtcl_srcdir) $(TK_XINCLUDES) $(TCL_INCLUDE_SPEC) $(CPPFLAGS)
|
||||
|
||||
|
||||
# If we are here then Tcl is available
|
||||
PROGRAMS = pgtclsh
|
||||
|
||||
# Add Tk targets if Tk is available
|
||||
ifeq ($(with_tk), yes)
|
||||
PROGRAMS += pgtksh
|
||||
endif
|
||||
|
||||
all: submake $(PROGRAMS)
|
||||
|
||||
pgtclsh: pgtclAppInit.o
|
||||
$(CC) $(CFLAGS) $^ $(libpgtcl) $(libpq) $(TCL_LIB_SPEC) $(TCL_LIBS) $(LDFLAGS) $(LIBS) -o $@
|
||||
|
||||
pgtksh: pgtkAppInit.o
|
||||
$(CC) $(CFLAGS) $^ $(libpgtcl) $(libpq) $(TK_LIB_SPEC) $(TK_LIBS) $(TCL_LIB_SPEC) $(LDFLAGS) $(LIBS) -o $@
|
||||
|
||||
.PHONY: submake
|
||||
submake:
|
||||
$(MAKE) -C $(libpgtcl_builddir) all
|
||||
|
||||
install: all installdirs
|
||||
$(INSTALL_PROGRAM) pgtclsh$(X) $(DESTDIR)$(bindir)/pgtclsh$(X)
|
||||
ifeq ($(with_tk), yes)
|
||||
$(INSTALL_PROGRAM) pgtksh$(X) $(DESTDIR)$(bindir)/pgtksh$(X)
|
||||
endif
|
||||
|
||||
installdirs:
|
||||
$(mkinstalldirs) $(DESTDIR)$(bindir)
|
||||
|
||||
uninstall:
|
||||
rm -f $(DESTDIR)$(bindir)/pgtclsh$(X) $(DESTDIR)$(bindir)/pgtksh$(X)
|
||||
|
||||
clean distclean maintainer-clean:
|
||||
rm -f pgtclAppInit.o pgtkAppInit.o pgtclsh pgtksh
|
||||
@ -1,10 +0,0 @@
|
||||
pgtclsh is an example of a tclsh extended with the new Tcl
|
||||
commands provided by the libpgtcl library. By using pgtclsh, one can
|
||||
write front-end applications to PostgreSQL in Tcl without having to
|
||||
deal with any libpq programming at all.
|
||||
|
||||
The pgtclsh is an enhanced version of tclsh. Similarly, pgtksh is a
|
||||
wish replacement with PostgreSQL bindings.
|
||||
|
||||
For details of the libpgtcl interface, please see the Programmer's
|
||||
Guide.
|
||||
@ -1,112 +0,0 @@
|
||||
/*
|
||||
* pgtclAppInit.c
|
||||
* a skeletal Tcl_AppInit that provides pgtcl initialization
|
||||
* to create a tclsh that can talk to pglite backends
|
||||
*
|
||||
* Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
|
||||
* Portions Copyright (c) 1993 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include <tcl.h>
|
||||
|
||||
#include "libpgtcl.h"
|
||||
|
||||
/*
|
||||
* The following variable is a special hack that is needed in order for
|
||||
* Sun shared libraries to be used for Tcl.
|
||||
*/
|
||||
|
||||
#ifdef NEED_MATHERR
|
||||
extern int matherr();
|
||||
int *tclDummyMathPtr = (int *) matherr;
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* main
|
||||
*
|
||||
* This is the main program for the application.
|
||||
*
|
||||
* Results:
|
||||
* None: Tcl_Main never returns here, so this procedure never
|
||||
* returns either.
|
||||
*
|
||||
* Side effects:
|
||||
* Whatever the application does.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
Tcl_Main(argc, argv, Tcl_AppInit);
|
||||
return 0; /* Needed only to prevent compiler
|
||||
* warning. */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_AppInit
|
||||
*
|
||||
* This procedure performs application-specific initialization.
|
||||
* Most applications, especially those that incorporate additional
|
||||
* packages, will have their own version of this procedure.
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl completion code, and leaves an error
|
||||
* message in interp->result if an error occurs.
|
||||
*
|
||||
* Side effects:
|
||||
* Depends on the startup script.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_AppInit(Tcl_Interp *interp)
|
||||
{
|
||||
if (Tcl_Init(interp) == TCL_ERROR)
|
||||
return TCL_ERROR;
|
||||
|
||||
/*
|
||||
* Call the init procedures for included packages. Each call should
|
||||
* look like this:
|
||||
*
|
||||
* if (Mod_Init(interp) == TCL_ERROR) { return TCL_ERROR; }
|
||||
*
|
||||
* where "Mod" is the name of the module.
|
||||
*/
|
||||
|
||||
if (Pgtcl_Init(interp) == TCL_ERROR)
|
||||
return TCL_ERROR;
|
||||
|
||||
/*
|
||||
* Call Tcl_CreateCommand for application-specific commands, if they
|
||||
* weren't already created by the init procedures called above.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Specify a user-specific startup file to invoke if the application
|
||||
* is run interactively. Typically the startup file is "~/.apprc"
|
||||
* where "app" is the name of the application. If this line is
|
||||
* deleted then no user-specific startup file will be run under any
|
||||
* conditions.
|
||||
*/
|
||||
|
||||
#if (TCL_MAJOR_VERSION <= 7) && (TCL_MINOR_VERSION < 5)
|
||||
tcl_RcFileName = "~/.tclshrc";
|
||||
#else
|
||||
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
|
||||
#endif
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
@ -1,17 +0,0 @@
|
||||
# getDBs :
|
||||
# get the names of all the databases at a given host and port number
|
||||
# with the defaults being the localhost and port 5432
|
||||
# return them in alphabetical order
|
||||
proc getDBs { {host "localhost"} {port "5432"} } {
|
||||
# datnames is the list to be result
|
||||
set conn [pg_connect template1 -host $host -port $port]
|
||||
set res [pg_exec $conn "SELECT datname FROM pg_database ORDER BY datname"]
|
||||
set ntups [pg_result $res -numTuples]
|
||||
for {set i 0} {$i < $ntups} {incr i} {
|
||||
lappend datnames [pg_result $res -getTuple $i]
|
||||
}
|
||||
pg_result $res -clear
|
||||
pg_disconnect $conn
|
||||
return $datnames
|
||||
}
|
||||
|
||||
@ -1,114 +0,0 @@
|
||||
/*
|
||||
* pgtkAppInit.c
|
||||
*
|
||||
* a skeletal Tcl_AppInit that provides pgtcl initialization
|
||||
* to create a tclsh that can talk to pglite backends
|
||||
*
|
||||
* Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
|
||||
* Portions Copyright (c) 1993 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include <tk.h>
|
||||
#include "libpgtcl.h"
|
||||
|
||||
/*
|
||||
* The following variable is a special hack that is needed in order for
|
||||
* Sun shared libraries to be used for Tcl.
|
||||
*/
|
||||
|
||||
#ifdef NEED_MATHERR
|
||||
extern int matherr();
|
||||
int *tclDummyMathPtr = (int *) matherr;
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* main
|
||||
*
|
||||
* This is the main program for the application.
|
||||
*
|
||||
* Results:
|
||||
* None: Tk_Main never returns here, so this procedure never
|
||||
* returns either.
|
||||
*
|
||||
* Side effects:
|
||||
* Whatever the application does.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
Tk_Main(argc, argv, Tcl_AppInit);
|
||||
return 0; /* Needed only to prevent compiler
|
||||
* warning. */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_AppInit
|
||||
*
|
||||
* This procedure performs application-specific initialization.
|
||||
* Most applications, especially those that incorporate additional
|
||||
* packages, will have their own version of this procedure.
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl completion code, and leaves an error
|
||||
* message in interp->result if an error occurs.
|
||||
*
|
||||
* Side effects:
|
||||
* Depends on the startup script.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_AppInit(Tcl_Interp *interp)
|
||||
{
|
||||
if (Tcl_Init(interp) == TCL_ERROR)
|
||||
return TCL_ERROR;
|
||||
if (Tk_Init(interp) == TCL_ERROR)
|
||||
return TCL_ERROR;
|
||||
|
||||
/*
|
||||
* Call the init procedures for included packages. Each call should
|
||||
* look like this:
|
||||
*
|
||||
* if (Mod_Init(interp) == TCL_ERROR) { return TCL_ERROR; }
|
||||
*
|
||||
* where "Mod" is the name of the module.
|
||||
*/
|
||||
|
||||
if (Pgtcl_Init(interp) == TCL_ERROR)
|
||||
return TCL_ERROR;
|
||||
|
||||
/*
|
||||
* Call Tcl_CreateCommand for application-specific commands, if they
|
||||
* weren't already created by the init procedures called above.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Specify a user-specific startup file to invoke if the application
|
||||
* is run interactively. Typically the startup file is "~/.apprc"
|
||||
* where "app" is the name of the application. If this line is
|
||||
* deleted then no user-specific startup file will be run under any
|
||||
* conditions.
|
||||
*/
|
||||
|
||||
#if (TCL_MAJOR_VERSION <= 7) && (TCL_MINOR_VERSION < 5)
|
||||
tcl_RcFileName = "~/.wishrc";
|
||||
#else
|
||||
Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
|
||||
#endif
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
@ -1,71 +0,0 @@
|
||||
#
|
||||
# updateStats
|
||||
# updates the statistic of number of distinct attribute values
|
||||
# (this should really be done by the vacuum command)
|
||||
# this is kind of brute force and slow, but it works
|
||||
# since we use SELECT DISTINCT to calculate the number of distinct values
|
||||
# and that does a sort, you need to have plenty of disk space for the
|
||||
# intermediate sort files.
|
||||
#
|
||||
# - jolly 6/8/95
|
||||
|
||||
#
|
||||
# update_attnvals
|
||||
# takes in a table and updates the attnvals columns for the attributes
|
||||
# of that table
|
||||
#
|
||||
# conn is the database connection
|
||||
# rel is the table name
|
||||
proc update_attnvals {conn rel} {
|
||||
|
||||
# first, get the oid of the rel
|
||||
set res [pg_exec $conn "SELECT oid FROM pg_class where relname = '$rel'"]
|
||||
if { [pg_result $res -numTuples] == "0"} {
|
||||
puts stderr "update_attnvals: Relation named $rel was not found"
|
||||
return
|
||||
}
|
||||
set oid [pg_result $res -getTuple 0]
|
||||
pg_result $res -clear
|
||||
|
||||
# use this query to find the names of the attributes
|
||||
set res [pg_exec $conn "SELECT * FROM $rel WHERE 'f'::bool"]
|
||||
set attrNames [pg_result $res -attributes]
|
||||
|
||||
puts "attrNames = $attrNames"
|
||||
foreach att $attrNames {
|
||||
# find how many distinct values there are for this attribute
|
||||
# this may fail if the user-defined type doesn't have
|
||||
# comparison operators defined
|
||||
set res2 [pg_exec $conn "SELECT DISTINCT $att FROM $rel"]
|
||||
set NVALS($att) [pg_result $res2 -numTuples]
|
||||
puts "NVALS($att) is $NVALS($att)"
|
||||
pg_result $res2 -clear
|
||||
}
|
||||
pg_result $res -clear
|
||||
|
||||
# now, update the pg_attribute table
|
||||
foreach att $attrNames {
|
||||
# first find the oid of the row to change
|
||||
set res [pg_exec $conn "SELECT oid FROM pg_attribute a WHERE a.attname = '$att' and a.attrelid = '$oid'"]
|
||||
set attoid [pg_result $res -getTuple 0]
|
||||
set res2 [pg_exec $conn "UPDATE pg_attribute SET attnvals = $NVALS($att) where pg_attribute.oid = '$attoid'::oid"]
|
||||
}
|
||||
}
|
||||
|
||||
# updateStats
|
||||
# takes in a database name
|
||||
# and updates the attnval stat for all the user-defined tables
|
||||
# in the database
|
||||
proc updateStats { dbName } {
|
||||
# datnames is the list to be result
|
||||
set conn [pg_connect $dbName]
|
||||
set res [pg_exec $conn "SELECT relname FROM pg_class WHERE relkind = 'r' and relname !~ '^pg_'"]
|
||||
set ntups [pg_result $res -numTuples]
|
||||
for {set i 0} {$i < $ntups} {incr i} {
|
||||
set rel [pg_result $res -getTuple $i]
|
||||
puts "updating attnvals stats on table $rel"
|
||||
update_attnvals $conn $rel
|
||||
}
|
||||
pg_disconnect $conn
|
||||
}
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
#
|
||||
# Copyright (c) 1994, Regents of the University of California
|
||||
#
|
||||
# $PostgreSQL: pgsql/src/interfaces/Makefile,v 1.52 2004/01/19 21:20:06 tgl Exp $
|
||||
# $PostgreSQL: pgsql/src/interfaces/Makefile,v 1.53 2004/04/20 00:33:51 pgsql Exp $
|
||||
#
|
||||
#-------------------------------------------------------------------------
|
||||
|
||||
@ -14,12 +14,7 @@ include $(top_builddir)/src/Makefile.global
|
||||
|
||||
DIRS := libpq ecpg
|
||||
|
||||
ALLDIRS := $(DIRS) libpgtcl
|
||||
|
||||
ifeq ($(with_tcl), yes)
|
||||
DIRS += libpgtcl
|
||||
endif
|
||||
|
||||
ALLDIRS := $(DIRS)
|
||||
|
||||
all install installdirs uninstall dep depend distprep:
|
||||
@for dir in $(DIRS); do $(MAKE) -C $$dir $@ || exit; done
|
||||
|
||||
@ -1,51 +0,0 @@
|
||||
#-------------------------------------------------------------------------
|
||||
#
|
||||
# Makefile for libpgtcl library
|
||||
#
|
||||
# Copyright (c) 1994, Regents of the University of California
|
||||
#
|
||||
# $PostgreSQL: pgsql/src/interfaces/libpgtcl/Makefile,v 1.36 2004/02/10 07:26:25 tgl Exp $
|
||||
#
|
||||
#-------------------------------------------------------------------------
|
||||
|
||||
subdir = src/interfaces/libpgtcl
|
||||
top_builddir = ../../..
|
||||
include ../../Makefile.global
|
||||
|
||||
NAME= pgtcl
|
||||
SO_MAJOR_VERSION= 2
|
||||
SO_MINOR_VERSION= 5
|
||||
|
||||
override CPPFLAGS := -I$(libpq_srcdir) $(CPPFLAGS) $(TCL_INCLUDE_SPEC)
|
||||
|
||||
OBJS= pgtcl.o pgtclCmds.o pgtclId.o
|
||||
|
||||
SHLIB_LINK = $(libpq) $(TCL_LIB_SPEC) $(TCL_LIBS) \
|
||||
$(filter -lintl -lssl -lcrypto -lkrb5 -lcrypt, $(LIBS)) $(THREAD_LIBS)
|
||||
|
||||
all: submake-libpq all-lib
|
||||
|
||||
# Shared library stuff
|
||||
include $(top_srcdir)/src/Makefile.shlib
|
||||
|
||||
install: all installdirs install-headers install-lib
|
||||
|
||||
.PHONY: install-headers
|
||||
install-headers: libpgtcl.h
|
||||
$(INSTALL_DATA) $< $(DESTDIR)$(includedir)/libpgtcl.h
|
||||
|
||||
installdirs:
|
||||
$(mkinstalldirs) $(DESTDIR)$(libdir) $(DESTDIR)$(includedir)
|
||||
|
||||
uninstall: uninstall-lib
|
||||
rm -f $(DESTDIR)$(includedir)/libpgtcl.h
|
||||
|
||||
clean distclean maintainer-clean: clean-lib
|
||||
rm -f $(OBJS)
|
||||
|
||||
depend dep:
|
||||
$(CC) -MM $(CFLAGS) *.c >depend
|
||||
|
||||
ifeq (depend,$(wildcard depend))
|
||||
include depend
|
||||
endif
|
||||
@ -1,38 +0,0 @@
|
||||
libpgtcl is a library that implements Tcl commands for front-end
|
||||
clients to interact with the Postgresql 6.3 (and perhaps later)
|
||||
backends. See libpgtcl.doc for details.
|
||||
|
||||
For an example of how to build a new tclsh to use libpgtcl, see the
|
||||
directory ../bin/pgtclsh
|
||||
|
||||
Note this version is modified by NeoSoft to have the following additional
|
||||
features:
|
||||
|
||||
1. Postgres connections are a valid Tcl channel, and can therefore
|
||||
be manipulated by the interp command (ie. shared or transfered).
|
||||
A connection handle's results are transfered/shared with it.
|
||||
(Result handles are NOT channels, though it was tempting). Note
|
||||
that a "close $connection" is now functionally identical to a
|
||||
"pg_disconnect $connection", although pg_connect must be used
|
||||
to create a connection.
|
||||
|
||||
2. Result handles are changed in format: ${connection}.<result#>.
|
||||
This just means for a connection 'pgtcl0', they look like pgtcl0.0,
|
||||
pgtcl0.1, etc. Enforcing this syntax makes it easy to look up
|
||||
the real pointer by indexing into an array associated with the
|
||||
connection.
|
||||
|
||||
3. I/O routines are now defined for the connection handle. I/O to/from
|
||||
the connection is only valid under certain circumstances: following
|
||||
the execution of the queries "copy <table> from stdin" or
|
||||
"copy <table> to stdout". In these cases, the result handle obtains
|
||||
an intermediate status of "PGRES_COPY_IN" or "PGRES_COPY_OUT". The
|
||||
programmer is then expected to use Tcl gets or read commands on the
|
||||
database connection (not the result handle) to extract the copy data.
|
||||
For copy outs, read until the standard EOF indication is encountered.
|
||||
For copy ins, puts a single terminator (\.). The statement for this
|
||||
would be
|
||||
puts $conn "\\." or puts $conn {\.}
|
||||
In either case (upon detecting the EOF or putting the `\.', the status
|
||||
of the result handle will change to "PGRES_COMMAND_OK", and any further
|
||||
I/O attempts will cause a Tcl error.
|
||||
@ -1,8 +0,0 @@
|
||||
;libpgtcl.def
|
||||
; The LIBRARY entry must be same as the name of your DLL, the name of
|
||||
; our DLL is libpgtcl.dll
|
||||
LIBRARY libpgtcl
|
||||
EXPORTS
|
||||
|
||||
Pgtcl_Init
|
||||
Pgtcl_SafeInit
|
||||
@ -1,24 +0,0 @@
|
||||
/*-------------------------------------------------------------------------
|
||||
*
|
||||
* libpgtcl.h
|
||||
*
|
||||
* libpgtcl is a tcl package for front-ends to interface with PostgreSQL.
|
||||
* It's a Tcl wrapper for libpq.
|
||||
*
|
||||
* Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
|
||||
* Portions Copyright (c) 1994, Regents of the University of California
|
||||
*
|
||||
* $PostgreSQL: pgsql/src/interfaces/libpgtcl/libpgtcl.h,v 1.17 2003/11/29 22:41:25 pgsql Exp $
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef LIBPGTCL_H
|
||||
#define LIBPGTCL_H
|
||||
|
||||
#include <tcl.h>
|
||||
|
||||
extern int Pgtcl_Init(Tcl_Interp *interp);
|
||||
extern int Pgtcl_SafeInit(Tcl_Interp *interp);
|
||||
|
||||
#endif /* LIBPGTCL_H */
|
||||
@ -1,170 +0,0 @@
|
||||
/*-------------------------------------------------------------------------
|
||||
*
|
||||
* pgtcl.c
|
||||
*
|
||||
* libpgtcl is a tcl package for front-ends to interface with PostgreSQL.
|
||||
* It's a Tcl wrapper for libpq.
|
||||
*
|
||||
* Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
|
||||
* Portions Copyright (c) 1994, Regents of the University of California
|
||||
*
|
||||
*
|
||||
* IDENTIFICATION
|
||||
* $PostgreSQL: pgsql/src/interfaces/libpgtcl/pgtcl.c,v 1.31 2004/02/02 00:35:08 neilc Exp $
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#include "postgres_fe.h"
|
||||
#include "libpgtcl.h"
|
||||
#include "pgtclCmds.h"
|
||||
#include "pgtclId.h"
|
||||
|
||||
/*
|
||||
* Pgtcl_Init
|
||||
* initialization package for the PGTCL Tcl package
|
||||
*
|
||||
*/
|
||||
|
||||
int
|
||||
Pgtcl_Init(Tcl_Interp *interp)
|
||||
{
|
||||
double tclversion;
|
||||
|
||||
/*
|
||||
* finish off the ChannelType struct. Much easier to do it here then
|
||||
* to guess where it might be by position in the struct. This is
|
||||
* needed for Tcl7.6 *only*, which has the getfileproc.
|
||||
*/
|
||||
#if HAVE_TCL_GETFILEPROC
|
||||
Pg_ConnType.getFileProc = PgGetFileProc;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Tcl versions >= 8.1 use UTF-8 for their internal string
|
||||
* representation. Therefore PGCLIENTENCODING must be set to UNICODE
|
||||
* for these versions.
|
||||
*/
|
||||
Tcl_GetDouble(interp, Tcl_GetVar(interp, "tcl_version", TCL_GLOBAL_ONLY), &tclversion);
|
||||
if (tclversion >= 8.1)
|
||||
Tcl_PutEnv("PGCLIENTENCODING=UNICODE");
|
||||
|
||||
/* register all pgtcl commands */
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_conndefaults",
|
||||
Pg_conndefaults,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_connect",
|
||||
Pg_connect,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_disconnect",
|
||||
Pg_disconnect,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_exec",
|
||||
Pg_exec,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_select",
|
||||
Pg_select,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_result",
|
||||
Pg_result,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_execute",
|
||||
Pg_execute,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_open",
|
||||
Pg_lo_open,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_close",
|
||||
Pg_lo_close,
|
||||
NULL, NULL);
|
||||
|
||||
#ifdef PGTCL_USE_TCLOBJ
|
||||
Tcl_CreateObjCommand(interp,
|
||||
"pg_lo_read",
|
||||
Pg_lo_read,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateObjCommand(interp,
|
||||
"pg_lo_write",
|
||||
Pg_lo_write,
|
||||
NULL, NULL);
|
||||
#else
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_read",
|
||||
Pg_lo_read,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_write",
|
||||
Pg_lo_write,
|
||||
NULL, NULL);
|
||||
#endif
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_lseek",
|
||||
Pg_lo_lseek,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_creat",
|
||||
Pg_lo_creat,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_tell",
|
||||
Pg_lo_tell,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_unlink",
|
||||
Pg_lo_unlink,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_import",
|
||||
Pg_lo_import,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_lo_export",
|
||||
Pg_lo_export,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_listen",
|
||||
Pg_listen,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CreateCommand(interp,
|
||||
"pg_on_connection_loss",
|
||||
Pg_on_connection_loss,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_PkgProvide(interp, "Pgtcl", "1.4");
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
Pgtcl_SafeInit(Tcl_Interp *interp)
|
||||
{
|
||||
return Pgtcl_Init(interp);
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,143 +0,0 @@
|
||||
/*-------------------------------------------------------------------------
|
||||
*
|
||||
* pgtclCmds.h
|
||||
* declarations for the C functions which implement pg_* tcl commands
|
||||
*
|
||||
* Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
|
||||
* Portions Copyright (c) 1994, Regents of the University of California
|
||||
*
|
||||
* $PostgreSQL: pgsql/src/interfaces/libpgtcl/pgtclCmds.h,v 1.32 2003/11/29 22:41:25 pgsql Exp $
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef PGTCLCMDS_H
|
||||
#define PGTCLCMDS_H
|
||||
|
||||
#include <tcl.h>
|
||||
|
||||
#include "libpq-fe.h"
|
||||
|
||||
/* Hack to deal with Tcl 8.4 const-ification without losing compatibility */
|
||||
#ifndef CONST84
|
||||
#define CONST84
|
||||
#endif
|
||||
|
||||
#define RES_HARD_MAX 128
|
||||
#define RES_START 16
|
||||
|
||||
/*
|
||||
* From Tcl version 8.0 on we can make large object access binary.
|
||||
*/
|
||||
#ifdef TCL_MAJOR_VERSION
|
||||
#if (TCL_MAJOR_VERSION >= 8)
|
||||
#define PGTCL_USE_TCLOBJ
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Each Pg_ConnectionId has a list of Pg_TclNotifies structs, one for each
|
||||
* Tcl interpreter that has executed any pg_listens on the connection.
|
||||
* We need this arrangement to be able to clean up if an interpreter is
|
||||
* deleted while the connection remains open. A free side benefit is that
|
||||
* multiple interpreters can be registered to listen for the same notify
|
||||
* name. (All their callbacks will be called, but in an unspecified order.)
|
||||
*
|
||||
* We use the same approach for pg_on_connection_loss callbacks, but they
|
||||
* are not kept in a hashtable since there's no name associated.
|
||||
*/
|
||||
|
||||
typedef struct Pg_TclNotifies_s
|
||||
{
|
||||
struct Pg_TclNotifies_s *next; /* list link */
|
||||
Tcl_Interp *interp; /* This Tcl interpreter */
|
||||
|
||||
/*
|
||||
* NB: if interp == NULL, the interpreter is gone but we haven't yet
|
||||
* got round to deleting the Pg_TclNotifies structure.
|
||||
*/
|
||||
Tcl_HashTable notify_hash; /* Active pg_listen requests */
|
||||
|
||||
char *conn_loss_cmd; /* pg_on_connection_loss cmd, or NULL */
|
||||
} Pg_TclNotifies;
|
||||
|
||||
typedef struct Pg_ConnectionId_s
|
||||
{
|
||||
char id[32];
|
||||
PGconn *conn;
|
||||
int res_max; /* Max number of results allocated */
|
||||
int res_hardmax; /* Absolute max to allow */
|
||||
int res_count; /* Current count of active results */
|
||||
int res_last; /* Optimize where to start looking */
|
||||
int res_copy; /* Query result with active copy */
|
||||
int res_copyStatus; /* Copying status */
|
||||
PGresult **results; /* The results */
|
||||
|
||||
Pg_TclNotifies *notify_list; /* head of list of notify info */
|
||||
int notifier_running; /* notify event source is live */
|
||||
#if TCL_MAJOR_VERSION >= 8
|
||||
Tcl_Channel notifier_channel; /* Tcl_Channel on which notifier
|
||||
* is listening */
|
||||
#else
|
||||
int notifier_socket; /* PQsocket on which notifier is listening */
|
||||
#endif
|
||||
} Pg_ConnectionId;
|
||||
|
||||
/* Values of res_copyStatus */
|
||||
#define RES_COPY_NONE 0
|
||||
#define RES_COPY_INPROGRESS 1
|
||||
#define RES_COPY_FIN 2
|
||||
|
||||
|
||||
/* **************************/
|
||||
/* registered Tcl functions */
|
||||
/* **************************/
|
||||
extern int Pg_conndefaults(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_connect(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_disconnect(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_exec(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_execute(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_select(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_result(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_open(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_close(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
|
||||
#ifdef PGTCL_USE_TCLOBJ
|
||||
extern int Pg_lo_read(ClientData cData, Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *CONST objv[]);
|
||||
extern int Pg_lo_write(ClientData cData, Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *CONST objv[]);
|
||||
|
||||
#else
|
||||
extern int Pg_lo_read(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_write(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
#endif
|
||||
extern int Pg_lo_lseek(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_creat(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_tell(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_unlink(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_import(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_lo_export(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_listen(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
extern int Pg_on_connection_loss(ClientData cData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
|
||||
#endif /* PGTCLCMDS_H */
|
||||
@ -1,862 +0,0 @@
|
||||
/*-------------------------------------------------------------------------
|
||||
*
|
||||
* pgtclId.c
|
||||
*
|
||||
* Contains Tcl "channel" interface routines, plus useful routines
|
||||
* to convert between strings and pointers. These are needed because
|
||||
* everything in Tcl is a string, but in C, pointers to data structures
|
||||
* are needed.
|
||||
*
|
||||
* ASSUMPTION: sizeof(long) >= sizeof(void*)
|
||||
*
|
||||
* Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
|
||||
* Portions Copyright (c) 1994, Regents of the University of California
|
||||
*
|
||||
* IDENTIFICATION
|
||||
* $PostgreSQL: pgsql/src/interfaces/libpgtcl/pgtclId.c,v 1.45 2004/01/07 18:56:29 neilc Exp $
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
#include "postgres_fe.h"
|
||||
|
||||
#include <errno.h>
|
||||
|
||||
#include "pgtclCmds.h"
|
||||
#include "pgtclId.h"
|
||||
|
||||
|
||||
static int
|
||||
PgEndCopy(Pg_ConnectionId * connid, int *errorCodePtr)
|
||||
{
|
||||
connid->res_copyStatus = RES_COPY_NONE;
|
||||
if (PQendcopy(connid->conn))
|
||||
{
|
||||
PQclear(connid->results[connid->res_copy]);
|
||||
connid->results[connid->res_copy] =
|
||||
PQmakeEmptyPGresult(connid->conn, PGRES_BAD_RESPONSE);
|
||||
connid->res_copy = -1;
|
||||
*errorCodePtr = EIO;
|
||||
return -1;
|
||||
}
|
||||
else
|
||||
{
|
||||
PQclear(connid->results[connid->res_copy]);
|
||||
connid->results[connid->res_copy] =
|
||||
PQmakeEmptyPGresult(connid->conn, PGRES_COMMAND_OK);
|
||||
connid->res_copy = -1;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Called when reading data (via gets) for a copy <rel> to stdout.
|
||||
*/
|
||||
int
|
||||
PgInputProc(DRIVER_INPUT_PROTO)
|
||||
{
|
||||
Pg_ConnectionId *connid;
|
||||
PGconn *conn;
|
||||
int avail;
|
||||
|
||||
connid = (Pg_ConnectionId *) cData;
|
||||
conn = connid->conn;
|
||||
|
||||
if (connid->res_copy < 0 ||
|
||||
PQresultStatus(connid->results[connid->res_copy]) != PGRES_COPY_OUT)
|
||||
{
|
||||
*errorCodePtr = EBUSY;
|
||||
return -1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Read any newly arrived data into libpq's buffer, thereby clearing
|
||||
* the socket's read-ready condition.
|
||||
*/
|
||||
if (!PQconsumeInput(conn))
|
||||
{
|
||||
*errorCodePtr = EIO;
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Move data from libpq's buffer to Tcl's. */
|
||||
|
||||
avail = PQgetlineAsync(conn, buf, bufSize);
|
||||
|
||||
if (avail < 0)
|
||||
{
|
||||
/* Endmarker detected, change state and return 0 */
|
||||
return PgEndCopy(connid, errorCodePtr);
|
||||
}
|
||||
|
||||
return avail;
|
||||
}
|
||||
|
||||
/*
|
||||
* Called when writing data (via puts) for a copy <rel> from stdin
|
||||
*/
|
||||
int
|
||||
PgOutputProc(DRIVER_OUTPUT_PROTO)
|
||||
{
|
||||
Pg_ConnectionId *connid;
|
||||
PGconn *conn;
|
||||
|
||||
connid = (Pg_ConnectionId *) cData;
|
||||
conn = connid->conn;
|
||||
|
||||
if (connid->res_copy < 0 ||
|
||||
PQresultStatus(connid->results[connid->res_copy]) != PGRES_COPY_IN)
|
||||
{
|
||||
*errorCodePtr = EBUSY;
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (PQputnbytes(conn, buf, bufSize))
|
||||
{
|
||||
*errorCodePtr = EIO;
|
||||
return -1;
|
||||
}
|
||||
|
||||
/*
|
||||
* This assumes Tcl script will write the terminator line in a single
|
||||
* operation; maybe not such a good assumption?
|
||||
*/
|
||||
if (bufSize >= 3 && strncmp(&buf[bufSize - 3], "\\.\n", 3) == 0)
|
||||
{
|
||||
if (PgEndCopy(connid, errorCodePtr) == -1)
|
||||
return -1;
|
||||
}
|
||||
return bufSize;
|
||||
}
|
||||
|
||||
#if HAVE_TCL_GETFILEPROC
|
||||
|
||||
Tcl_File
|
||||
PgGetFileProc(ClientData cData, int direction)
|
||||
{
|
||||
return NULL;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The WatchProc and GetHandleProc are no-ops but must be present.
|
||||
*/
|
||||
static void
|
||||
PgWatchProc(ClientData instanceData, int mask)
|
||||
{
|
||||
}
|
||||
|
||||
static int
|
||||
PgGetHandleProc(ClientData instanceData, int direction,
|
||||
ClientData *handlePtr)
|
||||
{
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_ChannelType Pg_ConnType = {
|
||||
"pgsql", /* channel type */
|
||||
NULL, /* blockmodeproc */
|
||||
PgDelConnectionId, /* closeproc */
|
||||
PgInputProc, /* inputproc */
|
||||
PgOutputProc, /* outputproc */
|
||||
NULL, /* SeekProc, Not used */
|
||||
NULL, /* SetOptionProc, Not used */
|
||||
NULL, /* GetOptionProc, Not used */
|
||||
PgWatchProc, /* WatchProc, must be defined */
|
||||
PgGetHandleProc, /* GetHandleProc, must be defined */
|
||||
NULL /* Close2Proc, Not used */
|
||||
};
|
||||
|
||||
/*
|
||||
* Create and register a new channel for the connection
|
||||
*/
|
||||
void
|
||||
PgSetConnectionId(Tcl_Interp *interp, PGconn *conn)
|
||||
{
|
||||
Tcl_Channel conn_chan;
|
||||
Pg_ConnectionId *connid;
|
||||
int i;
|
||||
|
||||
connid = (Pg_ConnectionId *) ckalloc(sizeof(Pg_ConnectionId));
|
||||
connid->conn = conn;
|
||||
connid->res_count = 0;
|
||||
connid->res_last = -1;
|
||||
connid->res_max = RES_START;
|
||||
connid->res_hardmax = RES_HARD_MAX;
|
||||
connid->res_copy = -1;
|
||||
connid->res_copyStatus = RES_COPY_NONE;
|
||||
connid->results = (PGresult **) ckalloc(sizeof(PGresult *) * RES_START);
|
||||
for (i = 0; i < RES_START; i++)
|
||||
connid->results[i] = NULL;
|
||||
connid->notify_list = NULL;
|
||||
connid->notifier_running = 0;
|
||||
|
||||
sprintf(connid->id, "pgsql%d", PQsocket(conn));
|
||||
|
||||
#if TCL_MAJOR_VERSION >= 8
|
||||
connid->notifier_channel = Tcl_MakeTcpClientChannel((ClientData) PQsocket(conn));
|
||||
Tcl_RegisterChannel(NULL, connid->notifier_channel);
|
||||
#else
|
||||
connid->notifier_socket = -1;
|
||||
#endif
|
||||
|
||||
#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 5
|
||||
/* Original signature (only seen in Tcl 7.5) */
|
||||
conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, NULL, NULL, (ClientData) connid);
|
||||
#else
|
||||
/* Tcl 7.6 and later use this */
|
||||
conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, (ClientData) connid,
|
||||
TCL_READABLE | TCL_WRITABLE);
|
||||
#endif
|
||||
|
||||
Tcl_SetChannelOption(interp, conn_chan, "-buffering", "line");
|
||||
Tcl_SetResult(interp, connid->id, TCL_VOLATILE);
|
||||
Tcl_RegisterChannel(interp, conn_chan);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Get back the connection from the Id
|
||||
*/
|
||||
PGconn *
|
||||
PgGetConnectionId(Tcl_Interp *interp, CONST84 char *id,
|
||||
Pg_ConnectionId ** connid_p)
|
||||
{
|
||||
Tcl_Channel conn_chan;
|
||||
Pg_ConnectionId *connid;
|
||||
|
||||
conn_chan = Tcl_GetChannel(interp, id, 0);
|
||||
if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
|
||||
{
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_AppendResult(interp, id, " is not a valid postgresql connection", 0);
|
||||
if (connid_p)
|
||||
*connid_p = NULL;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
|
||||
if (connid_p)
|
||||
*connid_p = connid;
|
||||
return connid->conn;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Remove a connection Id from the hash table and
|
||||
* close all portals the user forgot.
|
||||
*/
|
||||
int
|
||||
PgDelConnectionId(DRIVER_DEL_PROTO)
|
||||
{
|
||||
Tcl_HashEntry *entry;
|
||||
Tcl_HashSearch hsearch;
|
||||
Pg_ConnectionId *connid;
|
||||
Pg_TclNotifies *notifies;
|
||||
int i;
|
||||
|
||||
connid = (Pg_ConnectionId *) cData;
|
||||
|
||||
for (i = 0; i < connid->res_max; i++)
|
||||
{
|
||||
if (connid->results[i])
|
||||
PQclear(connid->results[i]);
|
||||
}
|
||||
ckfree((void *) connid->results);
|
||||
|
||||
/* Release associated notify info */
|
||||
while ((notifies = connid->notify_list) != NULL)
|
||||
{
|
||||
connid->notify_list = notifies->next;
|
||||
for (entry = Tcl_FirstHashEntry(¬ifies->notify_hash, &hsearch);
|
||||
entry != NULL;
|
||||
entry = Tcl_NextHashEntry(&hsearch))
|
||||
ckfree((char *) Tcl_GetHashValue(entry));
|
||||
Tcl_DeleteHashTable(¬ifies->notify_hash);
|
||||
if (notifies->conn_loss_cmd)
|
||||
ckfree((void *) notifies->conn_loss_cmd);
|
||||
if (notifies->interp)
|
||||
Tcl_DontCallWhenDeleted(notifies->interp, PgNotifyInterpDelete,
|
||||
(ClientData) notifies);
|
||||
ckfree((void *) notifies);
|
||||
}
|
||||
|
||||
/*
|
||||
* Turn off the Tcl event source for this connection, and delete any
|
||||
* pending notify and connection-loss events.
|
||||
*/
|
||||
PgStopNotifyEventSource(connid, true);
|
||||
|
||||
/* Close the libpq connection too */
|
||||
PQfinish(connid->conn);
|
||||
connid->conn = NULL;
|
||||
|
||||
/*
|
||||
* Kill the notifier channel, too. We must not do this until after
|
||||
* we've closed the libpq connection, because Tcl will try to close
|
||||
* the socket itself!
|
||||
*
|
||||
* XXX Unfortunately, while this works fine if we are closing due to
|
||||
* explicit pg_disconnect, all Tcl versions through 8.4.1 dump core if
|
||||
* we try to do it during interpreter shutdown. Not clear why. For
|
||||
* now, we kill the channel during pg_disconnect, but during interp
|
||||
* shutdown we just accept leakage of the (fairly small) amount of
|
||||
* memory taken for the channel state representation. (Note we are not
|
||||
* leaking a socket, since libpq closed that already.) We tell the
|
||||
* difference between pg_disconnect and interpreter shutdown by
|
||||
* testing for interp != NULL, which is an undocumented but apparently
|
||||
* safe way to tell.
|
||||
*/
|
||||
#if TCL_MAJOR_VERSION >= 8
|
||||
if (connid->notifier_channel != NULL && interp != NULL)
|
||||
Tcl_UnregisterChannel(NULL, connid->notifier_channel);
|
||||
#endif
|
||||
|
||||
/*
|
||||
* We must use Tcl_EventuallyFree because we don't want the connid
|
||||
* struct to vanish instantly if Pg_Notify_EventProc is active for it.
|
||||
* (Otherwise, closing the connection from inside a pg_listen callback
|
||||
* could lead to coredump.) Pg_Notify_EventProc can detect that the
|
||||
* connection has been deleted from under it by checking connid->conn.
|
||||
*/
|
||||
Tcl_EventuallyFree((ClientData) connid, TCL_DYNAMIC);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Find a slot for a new result id. If the table is full, expand it by
|
||||
* a factor of 2. However, do not expand past the hard max, as the client
|
||||
* is probably just not clearing result handles like they should.
|
||||
*/
|
||||
int
|
||||
PgSetResultId(Tcl_Interp *interp, CONST84 char *connid_c, PGresult *res)
|
||||
{
|
||||
Tcl_Channel conn_chan;
|
||||
Pg_ConnectionId *connid;
|
||||
int resid,
|
||||
i;
|
||||
char buf[32];
|
||||
|
||||
|
||||
conn_chan = Tcl_GetChannel(interp, connid_c, 0);
|
||||
if (conn_chan == NULL)
|
||||
return TCL_ERROR;
|
||||
connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
|
||||
|
||||
/* search, starting at slot after the last one used */
|
||||
resid = connid->res_last;
|
||||
for (;;)
|
||||
{
|
||||
/* advance, with wraparound */
|
||||
if (++resid >= connid->res_max)
|
||||
resid = 0;
|
||||
/* this slot empty? */
|
||||
if (!connid->results[resid])
|
||||
{
|
||||
connid->res_last = resid;
|
||||
break; /* success exit */
|
||||
}
|
||||
/* checked all slots? */
|
||||
if (resid == connid->res_last)
|
||||
break; /* failure exit */
|
||||
}
|
||||
|
||||
if (connid->results[resid])
|
||||
{
|
||||
/* no free slot found, so try to enlarge array */
|
||||
if (connid->res_max >= connid->res_hardmax)
|
||||
{
|
||||
Tcl_SetResult(interp, "hard limit on result handles reached",
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
connid->res_last = resid = connid->res_max;
|
||||
connid->res_max *= 2;
|
||||
if (connid->res_max > connid->res_hardmax)
|
||||
connid->res_max = connid->res_hardmax;
|
||||
connid->results = (PGresult **) ckrealloc((void *) connid->results,
|
||||
sizeof(PGresult *) * connid->res_max);
|
||||
for (i = connid->res_last; i < connid->res_max; i++)
|
||||
connid->results[i] = NULL;
|
||||
}
|
||||
|
||||
connid->results[resid] = res;
|
||||
sprintf(buf, "%s.%d", connid_c, resid);
|
||||
Tcl_SetResult(interp, buf, TCL_VOLATILE);
|
||||
return resid;
|
||||
}
|
||||
|
||||
static int
|
||||
getresid(Tcl_Interp *interp, CONST84 char *id, Pg_ConnectionId ** connid_p)
|
||||
{
|
||||
Tcl_Channel conn_chan;
|
||||
char *mark;
|
||||
int resid;
|
||||
Pg_ConnectionId *connid;
|
||||
|
||||
if (!(mark = strchr(id, '.')))
|
||||
return -1;
|
||||
*mark = '\0';
|
||||
conn_chan = Tcl_GetChannel(interp, id, 0);
|
||||
*mark = '.';
|
||||
if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
|
||||
{
|
||||
Tcl_SetResult(interp, "Invalid connection handle", TCL_STATIC);
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (Tcl_GetInt(interp, mark + 1, &resid) == TCL_ERROR)
|
||||
{
|
||||
Tcl_SetResult(interp, "Poorly formated result handle", TCL_STATIC);
|
||||
return -1;
|
||||
}
|
||||
|
||||
connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
|
||||
|
||||
if (resid < 0 || resid >= connid->res_max || connid->results[resid] == NULL)
|
||||
{
|
||||
Tcl_SetResult(interp, "Invalid result handle", TCL_STATIC);
|
||||
return -1;
|
||||
}
|
||||
|
||||
*connid_p = connid;
|
||||
|
||||
return resid;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Get back the result pointer from the Id
|
||||
*/
|
||||
PGresult *
|
||||
PgGetResultId(Tcl_Interp *interp, CONST84 char *id)
|
||||
{
|
||||
Pg_ConnectionId *connid;
|
||||
int resid;
|
||||
|
||||
if (!id)
|
||||
return NULL;
|
||||
resid = getresid(interp, id, &connid);
|
||||
if (resid == -1)
|
||||
return NULL;
|
||||
return connid->results[resid];
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Remove a result Id from the hash tables
|
||||
*/
|
||||
void
|
||||
PgDelResultId(Tcl_Interp *interp, CONST84 char *id)
|
||||
{
|
||||
Pg_ConnectionId *connid;
|
||||
int resid;
|
||||
|
||||
resid = getresid(interp, id, &connid);
|
||||
if (resid == -1)
|
||||
return;
|
||||
connid->results[resid] = 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Get the connection Id from the result Id
|
||||
*/
|
||||
int
|
||||
PgGetConnByResultId(Tcl_Interp *interp, CONST84 char *resid_c)
|
||||
{
|
||||
char *mark;
|
||||
Tcl_Channel conn_chan;
|
||||
|
||||
if (!(mark = strchr(resid_c, '.')))
|
||||
goto error_out;
|
||||
*mark = '\0';
|
||||
conn_chan = Tcl_GetChannel(interp, resid_c, 0);
|
||||
*mark = '.';
|
||||
if (conn_chan && Tcl_GetChannelType(conn_chan) == &Pg_ConnType)
|
||||
{
|
||||
Tcl_SetResult(interp, (char *) Tcl_GetChannelName(conn_chan),
|
||||
TCL_VOLATILE);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
error_out:
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_AppendResult(interp, resid_c, " is not a valid connection\n", 0);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------
|
||||
Notify event source
|
||||
|
||||
These functions allow asynchronous notify messages arriving from
|
||||
the SQL server to be dispatched as Tcl events. See the Tcl
|
||||
Notifier(3) man page for more info.
|
||||
|
||||
The main trick in this code is that we have to cope with status changes
|
||||
between the queueing and the execution of a Tcl event. For example,
|
||||
if the user changes or cancels the pg_listen callback command, we should
|
||||
use the new setting; we do that by not resolving the notify relation
|
||||
name until the last possible moment.
|
||||
We also have to handle closure of the channel or deletion of the interpreter
|
||||
to be used for the callback (note that with multiple interpreters,
|
||||
the channel can outlive the interpreter it was created by!)
|
||||
Upon closure of the channel, we immediately delete the file event handler
|
||||
for it, which has the effect of disabling any file-ready events that might
|
||||
be hanging about in the Tcl event queue. But for interpreter deletion,
|
||||
we just set any matching interp pointers in the Pg_TclNotifies list to NULL.
|
||||
The list item stays around until the connection is deleted. (This avoids
|
||||
trouble with walking through a list whose members may get deleted under us.)
|
||||
|
||||
Another headache is that Ousterhout keeps changing the Tcl I/O interfaces.
|
||||
libpgtcl currently claims to work with Tcl 7.5, 7.6, and 8.0, and each of
|
||||
'em is different. Worse, the Tcl_File type went away in 8.0, which means
|
||||
there is no longer any platform-independent way of waiting for file ready.
|
||||
So we now have to use a Unix-specific interface. Grumble.
|
||||
|
||||
In the current design, Pg_Notify_FileHandler is a file handler that
|
||||
we establish by calling Tcl_CreateFileHandler(). It gets invoked from
|
||||
the Tcl event loop whenever the underlying PGconn's socket is read-ready.
|
||||
We suck up any available data (to clear the OS-level read-ready condition)
|
||||
and then transfer any available PGnotify events into the Tcl event queue.
|
||||
Eventually these events will be dispatched to Pg_Notify_EventProc. When
|
||||
we do an ordinary PQexec, we must also transfer PGnotify events into Tcl's
|
||||
event queue, since libpq might have read them when we weren't looking.
|
||||
------------------------------------------*/
|
||||
|
||||
typedef struct
|
||||
{
|
||||
Tcl_Event header; /* Standard Tcl event info */
|
||||
PGnotify *notify; /* Notify event from libpq, or NULL */
|
||||
/* We use a NULL notify pointer to denote a connection-loss event */
|
||||
Pg_ConnectionId *connid; /* Connection for server */
|
||||
} NotifyEvent;
|
||||
|
||||
/* Dispatch a NotifyEvent that has reached the front of the event queue */
|
||||
|
||||
static int
|
||||
Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
|
||||
{
|
||||
NotifyEvent *event = (NotifyEvent *) evPtr;
|
||||
Pg_TclNotifies *notifies;
|
||||
char *callback;
|
||||
char *svcallback;
|
||||
|
||||
/* We classify SQL notifies as Tcl file events. */
|
||||
if (!(flags & TCL_FILE_EVENTS))
|
||||
return 0;
|
||||
|
||||
/* If connection's been closed, just forget the whole thing. */
|
||||
if (event->connid == NULL)
|
||||
{
|
||||
if (event->notify)
|
||||
PQfreemem(event->notify);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Preserve/Release to ensure the connection struct doesn't disappear
|
||||
* underneath us.
|
||||
*/
|
||||
Tcl_Preserve((ClientData) event->connid);
|
||||
|
||||
/*
|
||||
* Loop for each interpreter that has ever registered on the
|
||||
* connection. Each one can get a callback.
|
||||
*/
|
||||
|
||||
for (notifies = event->connid->notify_list;
|
||||
notifies != NULL;
|
||||
notifies = notifies->next)
|
||||
{
|
||||
Tcl_Interp *interp = notifies->interp;
|
||||
|
||||
if (interp == NULL)
|
||||
continue; /* ignore deleted interpreter */
|
||||
|
||||
/*
|
||||
* Find the callback to be executed for this interpreter, if any.
|
||||
*/
|
||||
if (event->notify)
|
||||
{
|
||||
/* Ordinary NOTIFY event */
|
||||
Tcl_HashEntry *entry;
|
||||
|
||||
entry = Tcl_FindHashEntry(¬ifies->notify_hash,
|
||||
event->notify->relname);
|
||||
if (entry == NULL)
|
||||
continue; /* no pg_listen in this interpreter */
|
||||
callback = (char *) Tcl_GetHashValue(entry);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Connection-loss event */
|
||||
callback = notifies->conn_loss_cmd;
|
||||
}
|
||||
|
||||
if (callback == NULL)
|
||||
continue; /* nothing to do for this interpreter */
|
||||
|
||||
/*
|
||||
* We have to copy the callback string in case the user executes a
|
||||
* new pg_listen or pg_on_connection_loss during the callback.
|
||||
*/
|
||||
svcallback = (char *) ckalloc((unsigned) (strlen(callback) + 1));
|
||||
strcpy(svcallback, callback);
|
||||
|
||||
/*
|
||||
* Execute the callback.
|
||||
*/
|
||||
Tcl_Preserve((ClientData) interp);
|
||||
if (Tcl_GlobalEval(interp, svcallback) != TCL_OK)
|
||||
{
|
||||
if (event->notify)
|
||||
Tcl_AddErrorInfo(interp, "\n (\"pg_listen\" script)");
|
||||
else
|
||||
Tcl_AddErrorInfo(interp, "\n (\"pg_on_connection_loss\" script)");
|
||||
Tcl_BackgroundError(interp);
|
||||
}
|
||||
Tcl_Release((ClientData) interp);
|
||||
ckfree(svcallback);
|
||||
|
||||
/*
|
||||
* Check for the possibility that the callback closed the
|
||||
* connection.
|
||||
*/
|
||||
if (event->connid->conn == NULL)
|
||||
break;
|
||||
}
|
||||
|
||||
Tcl_Release((ClientData) event->connid);
|
||||
|
||||
if (event->notify)
|
||||
PQfreemem(event->notify);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Transfer any notify events available from libpq into the Tcl event queue.
|
||||
* Note that this must be called after each PQexec (to capture notifies
|
||||
* that arrive during command execution) as well as in Pg_Notify_FileHandler
|
||||
* (to capture notifies that arrive when we're idle).
|
||||
*/
|
||||
|
||||
void
|
||||
PgNotifyTransferEvents(Pg_ConnectionId * connid)
|
||||
{
|
||||
PGnotify *notify;
|
||||
|
||||
while ((notify = PQnotifies(connid->conn)) != NULL)
|
||||
{
|
||||
NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
|
||||
|
||||
event->header.proc = Pg_Notify_EventProc;
|
||||
event->notify = notify;
|
||||
event->connid = connid;
|
||||
Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
|
||||
}
|
||||
|
||||
/*
|
||||
* This is also a good place to check for unexpected closure of the
|
||||
* connection (ie, backend crash), in which case we must shut down the
|
||||
* notify event source to keep Tcl from trying to select() on the now-
|
||||
* closed socket descriptor. But don't kill on-connection-loss
|
||||
* events; in fact, register one.
|
||||
*/
|
||||
if (PQsocket(connid->conn) < 0)
|
||||
PgConnLossTransferEvents(connid);
|
||||
}
|
||||
|
||||
/*
|
||||
* Handle a connection-loss event
|
||||
*/
|
||||
void
|
||||
PgConnLossTransferEvents(Pg_ConnectionId * connid)
|
||||
{
|
||||
if (connid->notifier_running)
|
||||
{
|
||||
/* Put the on-connection-loss event in the Tcl queue */
|
||||
NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
|
||||
|
||||
event->header.proc = Pg_Notify_EventProc;
|
||||
event->notify = NULL;
|
||||
event->connid = connid;
|
||||
Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
|
||||
}
|
||||
|
||||
/*
|
||||
* Shut down the notify event source to keep Tcl from trying to
|
||||
* select() on the now-closed socket descriptor. And zap any
|
||||
* unprocessed notify events ... but not, of course, the
|
||||
* connection-loss event.
|
||||
*/
|
||||
PgStopNotifyEventSource(connid, false);
|
||||
}
|
||||
|
||||
/*
|
||||
* Cleanup code for coping when an interpreter or a channel is deleted.
|
||||
*
|
||||
* PgNotifyInterpDelete is registered as an interpreter deletion callback
|
||||
* for each extant Pg_TclNotifies structure.
|
||||
* NotifyEventDeleteProc is used by PgStopNotifyEventSource to cancel
|
||||
* pending Tcl NotifyEvents that reference a dying connection.
|
||||
*/
|
||||
|
||||
void
|
||||
PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp)
|
||||
{
|
||||
/* Mark the interpreter dead, but don't do anything else yet */
|
||||
Pg_TclNotifies *notifies = (Pg_TclNotifies *) clientData;
|
||||
|
||||
notifies->interp = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Comparison routines for detecting events to be removed by Tcl_DeleteEvents.
|
||||
* NB: In (at least) Tcl versions 7.6 through 8.0.3, there is a serious
|
||||
* bug in Tcl_DeleteEvents: if there are multiple events on the queue and
|
||||
* you tell it to delete the last one, the event list pointers get corrupted,
|
||||
* with the result that events queued immediately thereafter get lost.
|
||||
* Therefore we daren't tell Tcl_DeleteEvents to actually delete anything!
|
||||
* We simply use it as a way of scanning the event queue. Events matching
|
||||
* the about-to-be-deleted connid are marked dead by setting their connid
|
||||
* fields to NULL. Then Pg_Notify_EventProc will do nothing when those
|
||||
* events are executed.
|
||||
*/
|
||||
static int
|
||||
NotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
|
||||
{
|
||||
Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
|
||||
|
||||
if (evPtr->proc == Pg_Notify_EventProc)
|
||||
{
|
||||
NotifyEvent *event = (NotifyEvent *) evPtr;
|
||||
|
||||
if (event->connid == connid && event->notify != NULL)
|
||||
event->connid = NULL;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* This version deletes on-connection-loss events too */
|
||||
static int
|
||||
AllNotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
|
||||
{
|
||||
Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
|
||||
|
||||
if (evPtr->proc == Pg_Notify_EventProc)
|
||||
{
|
||||
NotifyEvent *event = (NotifyEvent *) evPtr;
|
||||
|
||||
if (event->connid == connid)
|
||||
event->connid = NULL;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* File handler callback: called when Tcl has detected read-ready on socket.
|
||||
* The clientData is a pointer to the associated connection.
|
||||
* We can ignore the condition mask since we only ever ask about read-ready.
|
||||
*/
|
||||
|
||||
static void
|
||||
Pg_Notify_FileHandler(ClientData clientData, int mask)
|
||||
{
|
||||
Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
|
||||
|
||||
/*
|
||||
* Consume any data available from the SQL server (this just buffers
|
||||
* it internally to libpq; but it will clear the read-ready
|
||||
* condition).
|
||||
*/
|
||||
if (PQconsumeInput(connid->conn))
|
||||
{
|
||||
/* Transfer notify events from libpq to Tcl event queue. */
|
||||
PgNotifyTransferEvents(connid);
|
||||
}
|
||||
else
|
||||
{
|
||||
/*
|
||||
* If there is no input but we have read-ready, assume this means
|
||||
* we lost the connection.
|
||||
*/
|
||||
PgConnLossTransferEvents(connid);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Start and stop the notify event source for a connection.
|
||||
*
|
||||
* We do not bother to run the notifier unless at least one pg_listen
|
||||
* or pg_on_connection_loss has been executed on the connection. Currently,
|
||||
* once started the notifier is run until the connection is closed.
|
||||
*
|
||||
* FIXME: if PQreset is executed on the underlying PGconn, the active
|
||||
* socket number could change. How and when should we test for this
|
||||
* and update the Tcl file handler linkage? (For that matter, we'd
|
||||
* also have to reissue LISTEN commands for active LISTENs, since the
|
||||
* new backend won't know about 'em. I'm leaving this problem for
|
||||
* another day.)
|
||||
*/
|
||||
|
||||
void
|
||||
PgStartNotifyEventSource(Pg_ConnectionId * connid)
|
||||
{
|
||||
/* Start the notify event source if it isn't already running */
|
||||
if (!connid->notifier_running)
|
||||
{
|
||||
int pqsock = PQsocket(connid->conn);
|
||||
|
||||
if (pqsock >= 0)
|
||||
{
|
||||
#if TCL_MAJOR_VERSION >= 8
|
||||
Tcl_CreateChannelHandler(connid->notifier_channel,
|
||||
TCL_READABLE,
|
||||
Pg_Notify_FileHandler,
|
||||
(ClientData) connid);
|
||||
#else
|
||||
/* In Tcl 7.5 and 7.6, we need to gin up a Tcl_File. */
|
||||
Tcl_File tclfile = Tcl_GetFile((ClientData) pqsock, TCL_UNIX_FD);
|
||||
|
||||
Tcl_CreateFileHandler(tclfile, TCL_READABLE,
|
||||
Pg_Notify_FileHandler, (ClientData) connid);
|
||||
connid->notifier_socket = pqsock;
|
||||
#endif
|
||||
connid->notifier_running = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
PgStopNotifyEventSource(Pg_ConnectionId * connid, bool allevents)
|
||||
{
|
||||
/* Remove the event source */
|
||||
if (connid->notifier_running)
|
||||
{
|
||||
#if TCL_MAJOR_VERSION >= 8
|
||||
Tcl_DeleteChannelHandler(connid->notifier_channel,
|
||||
Pg_Notify_FileHandler,
|
||||
(ClientData) connid);
|
||||
#else
|
||||
/* In Tcl 7.5 and 7.6, we need to gin up a Tcl_File. */
|
||||
Tcl_File tclfile = Tcl_GetFile((ClientData) connid->notifier_socket,
|
||||
TCL_UNIX_FD);
|
||||
|
||||
Tcl_DeleteFileHandler(tclfile);
|
||||
#endif
|
||||
connid->notifier_running = 0;
|
||||
}
|
||||
|
||||
/* Kill queued Tcl events that reference this channel */
|
||||
if (allevents)
|
||||
Tcl_DeleteEvents(AllNotifyEventDeleteProc, (ClientData) connid);
|
||||
else
|
||||
Tcl_DeleteEvents(NotifyEventDeleteProc, (ClientData) connid);
|
||||
}
|
||||
@ -1,64 +0,0 @@
|
||||
/*-------------------------------------------------------------------------
|
||||
*
|
||||
* pgtclId.h
|
||||
*
|
||||
* Contains Tcl "channel" interface routines, plus useful routines
|
||||
* to convert between strings and pointers. These are needed because
|
||||
* everything in Tcl is a string, but in C, pointers to data structures
|
||||
* are needed.
|
||||
*
|
||||
* Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
|
||||
* Portions Copyright (c) 1994, Regents of the University of California
|
||||
*
|
||||
* $PostgreSQL: pgsql/src/interfaces/libpgtcl/pgtclId.h,v 1.25 2003/11/29 22:41:25 pgsql Exp $
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
extern void PgSetConnectionId(Tcl_Interp *interp, PGconn *conn);
|
||||
|
||||
#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 5
|
||||
/* Only Tcl 7.5 had drivers with this signature */
|
||||
#define DRIVER_DEL_PROTO ClientData cData, Tcl_Interp *interp, \
|
||||
Tcl_File inFile, Tcl_File outFile
|
||||
#define DRIVER_OUTPUT_PROTO ClientData cData, Tcl_File outFile, char *buf, \
|
||||
int bufSize, int *errorCodePtr
|
||||
#define DRIVER_INPUT_PROTO ClientData cData, Tcl_File inFile, char *buf, \
|
||||
int bufSize, int *errorCodePtr
|
||||
#else
|
||||
/* Tcl 7.6 and beyond use this signature */
|
||||
#define DRIVER_OUTPUT_PROTO ClientData cData, CONST84 char *buf, int bufSize, \
|
||||
int *errorCodePtr
|
||||
#define DRIVER_INPUT_PROTO ClientData cData, char *buf, int bufSize, \
|
||||
int *errorCodePtr
|
||||
#define DRIVER_DEL_PROTO ClientData cData, Tcl_Interp *interp
|
||||
#endif
|
||||
|
||||
extern PGconn *PgGetConnectionId(Tcl_Interp *interp, CONST84 char *id,
|
||||
Pg_ConnectionId **);
|
||||
extern int PgDelConnectionId(DRIVER_DEL_PROTO);
|
||||
extern int PgOutputProc(DRIVER_OUTPUT_PROTO);
|
||||
extern int PgInputProc(DRIVER_INPUT_PROTO);
|
||||
extern int PgSetResultId(Tcl_Interp *interp, CONST84 char *connid,
|
||||
PGresult *res);
|
||||
extern PGresult *PgGetResultId(Tcl_Interp *interp, CONST84 char *id);
|
||||
extern void PgDelResultId(Tcl_Interp *interp, CONST84 char *id);
|
||||
extern int PgGetConnByResultId(Tcl_Interp *interp, CONST84 char *resid);
|
||||
extern void PgStartNotifyEventSource(Pg_ConnectionId * connid);
|
||||
extern void PgStopNotifyEventSource(Pg_ConnectionId * connid, bool allevents);
|
||||
extern void PgNotifyTransferEvents(Pg_ConnectionId * connid);
|
||||
extern void PgConnLossTransferEvents(Pg_ConnectionId * connid);
|
||||
extern void PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp);
|
||||
|
||||
/* GetFileProc is needed in Tcl 7.6 *only* ... it went away again in 8.0 */
|
||||
#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 6
|
||||
#define HAVE_TCL_GETFILEPROC 1
|
||||
#else
|
||||
#define HAVE_TCL_GETFILEPROC 0
|
||||
#endif
|
||||
|
||||
#if HAVE_TCL_GETFILEPROC
|
||||
extern Tcl_File PgGetFileProc(ClientData cData, int direction);
|
||||
#endif
|
||||
|
||||
extern Tcl_ChannelType Pg_ConnType;
|
||||
@ -1,201 +0,0 @@
|
||||
# Microsoft Developer Studio Generated NMAKE File, Based on libpgtcl_REL7_1_STABLE.dsp
|
||||
!IF "$(CFG)" == ""
|
||||
CFG=libpgtcl - Win32 Release
|
||||
!MESSAGE No configuration specified. Defaulting to libpgtcl - Win32 Release.
|
||||
!ENDIF
|
||||
|
||||
!IF "$(CFG)" != "libpgtcl - Win32 Release" && "$(CFG)" != "libpgtcl - Win32 Debug"
|
||||
!MESSAGE Invalid configuration "$(CFG)" specified.
|
||||
!MESSAGE You can specify a configuration when running NMAKE
|
||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
||||
!MESSAGE
|
||||
!MESSAGE NMAKE /f "libpgtcl.mak" CFG="libpgtcl - Win32 Debug"
|
||||
!MESSAGE
|
||||
!MESSAGE Possible choices for configuration are:
|
||||
!MESSAGE
|
||||
!MESSAGE "libpgtcl - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
|
||||
!MESSAGE "libpgtcl - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
|
||||
!MESSAGE
|
||||
!ERROR An invalid configuration is specified.
|
||||
!ENDIF
|
||||
|
||||
!IF "$(OS)" == "Windows_NT"
|
||||
NULL=
|
||||
!ELSE
|
||||
NULL=nul
|
||||
!ENDIF
|
||||
|
||||
CPP=cl.exe
|
||||
MTL=midl.exe
|
||||
RSC=rc.exe
|
||||
|
||||
TCLBASE=\usr\local\tcltk833
|
||||
PGINCLUDE=/I ..\..\include /I ..\libpq /I $(TCLBASE)\include
|
||||
|
||||
!IF "$(CFG)" == "libpgtcl - Win32 Release"
|
||||
|
||||
OUTDIR=.\Release
|
||||
INTDIR=.\Release
|
||||
# Begin Custom Macros
|
||||
OutDir=.\Release
|
||||
# End Custom Macros
|
||||
|
||||
ALL : "$(OUTDIR)\libpgtcl.dll" "$(OUTDIR)\libpgtcl.bsc"
|
||||
|
||||
|
||||
CLEAN :
|
||||
-@erase "$(INTDIR)\pgtcl.obj"
|
||||
-@erase "$(INTDIR)\pgtcl.sbr"
|
||||
-@erase "$(INTDIR)\pgtclCmds.obj"
|
||||
-@erase "$(INTDIR)\pgtclCmds.sbr"
|
||||
-@erase "$(INTDIR)\pgtclId.obj"
|
||||
-@erase "$(INTDIR)\pgtclId.sbr"
|
||||
-@erase "$(INTDIR)\vc60.idb"
|
||||
-@erase "$(OUTDIR)\libpgtcl.dll"
|
||||
-@erase "$(OUTDIR)\libpgtcl.exp"
|
||||
-@erase "$(OUTDIR)\libpgtcl.lib"
|
||||
-@erase "$(OUTDIR)\libpgtcl.bsc"
|
||||
|
||||
"$(OUTDIR)" :
|
||||
if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
|
||||
|
||||
CPP_PROJ=/nologo /MT /W3 /GX /O2 $(PGINCLUDE) /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR"$(INTDIR)\\" /Fp"$(INTDIR)\libpgtcl.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /c
|
||||
MTL_PROJ=/nologo /D "NDEBUG" /mktyplib203 /win32
|
||||
BSC32=bscmake.exe
|
||||
BSC32_FLAGS=/nologo /o"$(OUTDIR)\libpgtcl.bsc"
|
||||
BSC32_SBRS= \
|
||||
"$(INTDIR)\pgtcl.sbr" \
|
||||
"$(INTDIR)\pgtclCmds.sbr" \
|
||||
"$(INTDIR)\pgtclId.sbr"
|
||||
|
||||
"$(OUTDIR)\libpgtcl.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
|
||||
$(BSC32) @<<
|
||||
$(BSC32_FLAGS) $(BSC32_SBRS)
|
||||
<<
|
||||
|
||||
LINK32=link.exe
|
||||
LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib tcl83.lib libpq.lib /nologo /dll /incremental:no /pdb:"$(OUTDIR)\libpgtcl.pdb" /machine:I386 /def:".\libpgtcl.def" /out:"$(OUTDIR)\libpgtcl.dll" /implib:"$(OUTDIR)\libpgtcl.lib" /libpath:"$(TCLBASE)\lib" /libpath:"..\libpq\Release"
|
||||
DEF_FILE= \
|
||||
".\libpgtcl.def"
|
||||
LINK32_OBJS= \
|
||||
"$(INTDIR)\pgtcl.obj" \
|
||||
"$(INTDIR)\pgtclCmds.obj" \
|
||||
"$(INTDIR)\pgtclId.obj"
|
||||
|
||||
"$(OUTDIR)\libpgtcl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
|
||||
$(LINK32) @<<
|
||||
$(LINK32_FLAGS) $(LINK32_OBJS)
|
||||
<<
|
||||
|
||||
!ELSEIF "$(CFG)" == "libpgtcl - Win32 Debug"
|
||||
|
||||
OUTDIR=.\Debug
|
||||
INTDIR=.\Debug
|
||||
# Begin Custom Macros
|
||||
OutDir=.\Debug
|
||||
# End Custom Macros
|
||||
|
||||
ALL : "$(OUTDIR)\libpgtcl.dll" "$(OUTDIR)\libpgtcl.bsc"
|
||||
|
||||
|
||||
CLEAN :
|
||||
-@erase "$(INTDIR)\pgtcl.obj"
|
||||
-@erase "$(INTDIR)\pgtcl.sbr"
|
||||
-@erase "$(INTDIR)\pgtclCmds.obj"
|
||||
-@erase "$(INTDIR)\pgtclCmds.sbr"
|
||||
-@erase "$(INTDIR)\pgtclId.obj"
|
||||
-@erase "$(INTDIR)\pgtclId.sbr"
|
||||
-@erase "$(INTDIR)\vc60.idb"
|
||||
-@erase "$(INTDIR)\vc60.pdb"
|
||||
-@erase "$(OUTDIR)\libpgtcl.dll"
|
||||
-@erase "$(OUTDIR)\libpgtcl.exp"
|
||||
-@erase "$(OUTDIR)\libpgtcl.ilk"
|
||||
-@erase "$(OUTDIR)\libpgtcl.lib"
|
||||
-@erase "$(OUTDIR)\libpgtcl.pdb"
|
||||
-@erase "$(OUTDIR)\libpgtcl.bsc"
|
||||
|
||||
"$(OUTDIR)" :
|
||||
if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
|
||||
|
||||
CPP_PROJ=/nologo /MTd /W3 /Gm /GX /ZI /Od $(PGINCLUDE) /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR"$(INTDIR)\\" /Fp"$(INTDIR)\libpgtcl.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /GZ /c
|
||||
MTL_PROJ=/nologo /D "_DEBUG" /mktyplib203 /win32
|
||||
BSC32=bscmake.exe
|
||||
BSC32_FLAGS=/nologo /o"$(OUTDIR)\libpgtcl.bsc"
|
||||
BSC32_SBRS= \
|
||||
"$(INTDIR)\pgtcl.sbr" \
|
||||
"$(INTDIR)\pgtclCmds.sbr" \
|
||||
"$(INTDIR)\pgtclId.sbr"
|
||||
|
||||
"$(OUTDIR)\libpgtcl.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
|
||||
$(BSC32) @<<
|
||||
$(BSC32_FLAGS) $(BSC32_SBRS)
|
||||
<<
|
||||
|
||||
LINK32=link.exe
|
||||
LINK32_FLAGS=tcl83.lib libpq.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /incremental:yes /pdb:"$(OUTDIR)\libpgtcl.pdb" /debug /machine:I386 /def:".\libpgtcl.def" /out:"$(OUTDIR)\libpgtcl.dll" /implib:"$(OUTDIR)\libpgtcl.lib" /pdbtype:sept /libpath:"$(TCLBASE)\lib" /libpath:"..\libpq\Debug"
|
||||
DEF_FILE= \
|
||||
".\libpgtcl.def"
|
||||
LINK32_OBJS= \
|
||||
"$(INTDIR)\pgtcl.obj" \
|
||||
"$(INTDIR)\pgtclCmds.obj" \
|
||||
"$(INTDIR)\pgtclId.obj"
|
||||
|
||||
"$(OUTDIR)\libpgtcl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
|
||||
$(LINK32) @<<
|
||||
$(LINK32_FLAGS) $(LINK32_OBJS)
|
||||
<<
|
||||
|
||||
!ENDIF
|
||||
|
||||
.c{$(INTDIR)}.obj::
|
||||
$(CPP) @<<
|
||||
$(CPP_PROJ) $<
|
||||
<<
|
||||
|
||||
.cpp{$(INTDIR)}.obj::
|
||||
$(CPP) @<<
|
||||
$(CPP_PROJ) $<
|
||||
<<
|
||||
|
||||
.cxx{$(INTDIR)}.obj::
|
||||
$(CPP) @<<
|
||||
$(CPP_PROJ) $<
|
||||
<<
|
||||
|
||||
.c{$(INTDIR)}.sbr::
|
||||
$(CPP) @<<
|
||||
$(CPP_PROJ) $<
|
||||
<<
|
||||
|
||||
.cpp{$(INTDIR)}.sbr::
|
||||
$(CPP) @<<
|
||||
$(CPP_PROJ) $<
|
||||
<<
|
||||
|
||||
.cxx{$(INTDIR)}.sbr::
|
||||
$(CPP) @<<
|
||||
$(CPP_PROJ) $<
|
||||
<<
|
||||
|
||||
!IF "$(CFG)" == "libpgtcl - Win32 Release" || "$(CFG)" == "libpgtcl - Win32 Debug"
|
||||
SOURCE=pgtcl.c
|
||||
|
||||
"$(INTDIR)\pgtcl.obj" "$(INTDIR)\pgtcl.sbr" : $(SOURCE) "$(INTDIR)"
|
||||
$(CPP) $(CPP_PROJ) $(SOURCE)
|
||||
|
||||
|
||||
SOURCE=pgtclCmds.c
|
||||
|
||||
"$(INTDIR)\pgtclCmds.obj" "$(INTDIR)\pgtclCmds.sbr" : $(SOURCE) "$(INTDIR)"
|
||||
$(CPP) $(CPP_PROJ) $(SOURCE)
|
||||
|
||||
|
||||
SOURCE=pgtclId.c
|
||||
|
||||
"$(INTDIR)\pgtclId.obj" "$(INTDIR)\pgtclId.sbr" : $(SOURCE) "$(INTDIR)"
|
||||
$(CPP) $(CPP_PROJ) $(SOURCE)
|
||||
|
||||
|
||||
|
||||
!ENDIF
|
||||
|
||||
Loading…
Reference in New Issue
Block a user