mirror of https://github.com/postgres/postgres
PostgreSQL Daemon
22 years ago
parent
d1b3915ce1
commit
41fa9e9bae
@ -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 |
||||
} |
||||
|
||||
@ -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