Skip to content
Browse files

adapted to the new extension building process

git-svn-id: svn+ssh://svn.kahua.org/var/local/repos/kahua/Gauche-dbd-pg/trunk@828 4e392e78-dc3f-dc11-8fd5-00188bfc9ac4
  • Loading branch information...
1 parent 3ea7c1b commit d2156adddee4e1439a9f445c9b66bd27fa267a66 @shirok shirok committed Jul 19, 2005
Showing with 816 additions and 0 deletions.
  1. +30 −0 COPYING
  2. +43 −0 DIST
  3. +79 −0 Makefile.in
  4. +25 −0 README
  5. +62 −0 configure.in
  6. +137 −0 dbd/pg.scm
  7. +201 −0 gauche_dbd_pg.c
  8. +70 −0 gauche_dbd_pg.h
  9. +67 −0 gauche_dbd_pglib.stub
  10. +102 −0 test.scm
View
30 COPYING
@@ -0,0 +1,30 @@
+
+ Copyright (c) 2003 Scheme Arts, L.L.C., All rights reserved.
+ Copyright (c) 2003 Time Intermedia Corporation, All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. Neither the name of the authors nor the names of its contributors
+ may be used to endorse or promote products derived from this
+ software without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+ TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
View
43 DIST
@@ -0,0 +1,43 @@
+#!/bin/sh
+#
+# A helper script for developers.
+# ./DIST gen : runs autoconf to generate 'configure' script.
+# ./DIST tgz : creates a tarball.
+# Assumes gnu tar.
+
+MODULE=Gauche-dbd-pg
+
+while [ $# -gt 0 ]; do
+ case $1 in
+ gen) gen=yes; shift ;;
+ tgz) tgz=yes; shift ;;
+ *) echo "DIST gen|tgz"; exit 0;;
+ esac
+done
+
+if [ "$gen" = "yes" ]; then
+ autoconf
+fi
+
+if [ "$tgz" = "yes" ]; then
+ if [ -f Makefile ]; then make maintainer-clean; fi
+ ./DIST gen
+ ./configure
+ make distclean
+
+ if [ ! -f VERSION ]; then echo "No VERSION; something wrong?"; exit 1; fi
+ VERSION=`cat VERSION`
+
+ rm -f DIST_EXCLUDE_X
+ echo DIST > DIST_EXCLUDE_X
+ echo DIST_EXCLUDE_X >> DIST_EXCLUDE_X
+ if [ -f DIST_EXCLUDE ]; then cat DIST_EXCLUDE >> DIST_EXCLUDE_X; fi
+ find . -name CVS -print -prune >> DIST_EXCLUDE_X
+
+ rm -rf ../$MODULE-$VERSION
+
+ mkdir ../$MODULE-$VERSION
+ tar cvfX - DIST_EXCLUDE_X . | (cd ../$MODULE-$VERSION; tar xf -)
+ (cd ..; tar cvf - $MODULE-$VERSION | gzip -9 > $MODULE-$VERSION.tgz)
+ (cd ..; rm -rf $MODULE-$VERSION)
+fi
View
79 Makefile.in
@@ -0,0 +1,79 @@
+#
+# $Id: Makefile.in,v 1.1 2005/07/19 00:45:42 shiro Exp $
+#
+
+# General info
+SHELL = @SHELL@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+VPATH = $(srcdir)
+
+# These may be overridden by make invocators
+DESTDIR =
+GOSH = @GOSH@
+GAUCHE_CONFIG = @GAUCHE_CONFIG@
+GAUCHE_PACKAGE = @GAUCHE_PACKAGE@
+INSTALL = @GAUCHE_INSTALL@
+
+# Other parameters
+SOEXT = @SOEXT@
+OBJEXT = @OBJEXT@
+EXEEXT = @EXEEXT@
+
+# Module-specific stuff
+PACKAGE = Gauche-dbd-pg
+
+ARCHFILES = gauche_dbd_pg.$(SOEXT)
+SCMFILES = dbd/pg.scm
+HEADERS =
+
+TARGET = $(ARCHFILES)
+GENERATED =
+CONFIG_GENERATED = Makefile config.cache config.log config.status \
+ configure.lineno autom4te*.cache $(PACKAGE).gpd
+
+HEADER_INSTALL_DIR = $(DESTDIR)`$(GAUCHE_CONFIG) --siteincdir`
+SCM_INSTALL_DIR = $(DESTDIR)`$(GAUCHE_CONFIG) --sitelibdir`
+ARCH_INSTALL_DIR = $(DESTDIR)`$(GAUCHE_CONFIG) --sitearchdir`
+
+PG_CFLAGS = @PG_CFLAGS@
+PG_LDFLAGS = @PG_LDFLAGS@
+
+gauche_dbd_pg_SRCS = gauche_dbd_pg.c gauche_dbd_pglib.stub
+
+all : $(TARGET)
+
+gauche_dbd_pg.$(SOEXT): $(gauche_dbd_pg_SRCS)
+ $(GAUCHE_PACKAGE) compile \
+ --cflags="$(PG_CFLAGS)" \
+ --ldflags="$(PG_LDFLAGS)" \
+ --verbose gauche_dbd_pg $(gauche_dbd_pg_SRCS)
+
+check : all
+ @rm -f test.log
+ $(GOSH) -I. test.scm > test.log
+
+install : all
+ $(INSTALL) -m 444 -T $(HEADER_INSTALL_DIR) $(HEADERS)
+ $(INSTALL) -m 444 -T $(SCM_INSTALL_DIR) $(SCMFILES)
+ $(INSTALL) -m 555 -T $(ARCH_INSTALL_DIR) $(ARCHFILES)
+ $(INSTALL) -m 444 -T $(SCM_INSTALL_DIR)/.packages $(PACKAGE).gpd
+
+uninstall :
+ $(INSTALL) -U $(HEADER_INSTALL_DIR) $(HEADERS)
+ $(INSTALL) -U $(SCM_INSTALL_DIR) $(SCMFILES)
+ $(INSTALL) -U $(ARCH_INSTALL_DIR) $(ARCHFILES)
+ $(INSTALL) -U $(SCM_INSTALL_DIR)/.packages $(PACKAGE).gpd
+
+clean :
+ $(GAUCHE_PACKAGE) compile --clean gauche_dbd_pg $(gauche_dbd_pg_SRCS)
+ rm -rf core $(TARGET) $(GENERATED) *~ test.log so_locations
+
+distclean : clean
+ rm -rf $(CONFIG_GENERATED)
+
+maintainer-clean : clean
+ rm -rf $(CONFIG_GENERATED) configure VERSION
+
View
25 README
@@ -0,0 +1,25 @@
+* Requirements
+
+** pg_config
+
+./configure requires 'pg_config'.
+please set path to 'pg_config', like that:
+
+ export PATH=/usr/local/pgsql/bin:$PATH
+
+** your default database
+
+make test requires PostgreSQL's default database.
+
+if it's not exist, you may make it like that:
+
+ % sudo -u postgres createuser <your-login-name>
+ % sudo -u postgres createdb <your-login-name>
+
+* Build and Install
+
+ % ./configure
+ % make
+ % make check
+ % sudo make install
+
View
62 configure.in
@@ -0,0 +1,62 @@
+dnl
+dnl Configuring Gauche-dbd-pg
+dnl process this file with autoconf to generate 'configure'.
+dnl $Id: configure.in,v 1.1 2005/07/19 00:45:42 shiro Exp $
+dnl
+
+AC_PREREQ(2.54)
+AC_INIT(Gauche-dbd-pg, 0.2_pre1, shiro@acm.org)
+dnl If you want to use the system name (OS, architecture, etc) in the
+dnl configure, uncomment the following line. In such a case, you need
+dnl to copy config.guess and config.sub from automake distribution.
+dnl AC_CANONICAL_SYSTEM
+
+dnl Set up gauche related commands. The commands are set by scanning
+dnl PATH. You can override them by "GOSH=/my/gosh ./configure" etc.
+AC_PATH_PROG([GOSH], gosh)
+AC_PATH_PROG([GAUCHE_CONFIG], gauche-config)
+AC_PATH_PROG([GAUCHE_PACKAGE], gauche-package)
+AC_PATH_PROG([GAUCHE_INSTALL], gauche-install)
+AC_PATH_PROG([GAUCHE_CESCONV], gauche-cesconv)
+
+dnl Usually these parameters are set by AC_PROG_CC, but we'd rather use
+dnl the same one as Gauche has been compiled with.
+SOEXT=`$GAUCHE_CONFIG --so-suffix`
+OBJEXT=`$GAUCHE_CONFIG --object-suffix`
+EXEEXT=`$GAUCHE_CONFIG --executable-suffix`
+AC_SUBST(SOEXT)
+AC_SUBST(OBJEXT)
+AC_SUBST(EXEEXT)
+
+dnl Check for headers.
+dnl Add your macro calls to check required headers, if you have any.
+
+dnl Check for other programs.
+dnl Add your macro calls to check existence of programs, if you have any.
+
+dnl Check for libraries
+dnl Add your macro calls to check required libraries, if you have any.
+AC_PATH_PROGS(PG_CONFIG, pg_config)
+AC_MSG_CHECKING(checking postgresql client library)
+if test X${PG_CONFIG} = X; then
+ AC_MSG_RESULT(not available)
+else
+ AC_DEFINE(HAVE_PG, 1)
+ PG_CFLAGS=-I`${PG_CONFIG} --includedir`
+ PG_LDFLAGS="-L`${PG_CONFIG} --libdir` -lpq"
+ AC_SUBST(PG_CFLAGS)
+ AC_SUBST(PG_LDFLAGS)
+ AC_MSG_RESULT(ok)
+fi
+
+dnl Creating gpd (gauche package description) file
+GAUCHE_PACKAGE_CONFIGURE_ARGS="`echo ""$ac_configure_args"" | sed 's/[\\""\`\$]/\\\&/g'`"
+AC_MSG_NOTICE([creating ${PACKAGE_NAME}.gpd])
+$GAUCHE_PACKAGE make-gpd "$PACKAGE_NAME" \
+ -version "$PACKAGE_VERSION" \
+ -configure "./configure $GAUCHE_PACKAGE_CONFIGURE_ARGS"
+
+dnl Output
+echo $PACKAGE_VERSION > VERSION
+AC_OUTPUT(Makefile)
+
View
137 dbd/pg.scm
@@ -0,0 +1,137 @@
+;;; dbd.pg - PostgreSQL driver
+;;;
+;;; Copyright (c) 2003-2005 Scheme Arts, L.L.C., All rights reserved.
+;;; Copyright (c) 2003-2005 Time Intermedia Corporation, All rights reserved.
+;;; See COPYING for terms and conditions of using this software
+;;;
+;;; $Id: pg.scm,v 1.1 2005/07/19 00:45:43 shiro Exp $
+
+(define-module dbd.pg
+ (use gauche.collection)
+ (use dbi)
+ (export <pg-driver>
+ <pg-connection>
+ <pg-query>
+ <pg-result-set>
+ <pq-handle> ; pq.so
+ <pq-res> ; pq.so
+ pq-connectdb ; pq.so
+ pq-exec ; pq.so
+ pq-result-status ; pq.so
+ pq-result-error-message ; pq.so
+ pq-ntuples ; pq.so
+ pq-nfields ; pq.so
+ pq-get-value ; pq.so
+ pq-finish ; pq.so
+ dbi-make-connection
+ dbi-make-query
+ dbi-execute-query
+ call-with-iterator
+ dbi-get-value
+ dbi-close))
+(select-module dbd.pg)
+
+;; Loads extension
+(dynamic-load "gauche_dbd_pg")
+
+(define-class <pg-driver> (<dbi-driver>) ())
+
+(define-class <pg-connection> (<dbi-connection>)
+ ((%connection :init-keyword :connection :init-value #f)))
+
+(define-class <pg-query> (<dbi-query>)
+ ((%connection :init-keyword :connection)
+ (%query-string :init-keyword :query-string)))
+
+(define-class <pg-result-set> (<dbi-result-set> <collection>)
+ ((%result-set :init-keyword :result-set)
+ (%status :init-keyword :status)
+ (%error :init-keyword :error)
+;; (%row-id :init-keyword :row-id)
+ (%num-rows :init-keyword :num-rows)
+ (num-cols :getter dbi-column-count :init-keyword :num-cols)))
+
+(define-method dbi-make-connection ((d <pg-driver>) (user <string>)
+ (password <string>) (option <string>))
+ (let ((conn
+ (make <pg-connection> :driver-name d :open #t
+ :connection (pq-connectdb
+ (string-append
+ (if (> (string-length user) 0) "user=" "")
+ user
+ (if (> (string-length password) 0) " password=" "")
+ password " " option)
+ (make <pq-handle>)))))
+ (let ((status (pq-status (slot-ref conn '%connection))))
+ (if (eq? status CONNECTION_BAD)
+ (raise (make <dbi-exception>
+ :error-code status
+ :message "Connect Error: Bad Connection"))
+ conn))))
+
+(define-method dbi-make-query ((c <pg-connection>))
+ (if (not (slot-ref c 'open))
+ (raise
+ (make <dbi-exception> :error-code -1
+ :message "connection has already closed.")))
+ (make <pg-query> :open #t
+ :connection (slot-ref c '%connection)))
+
+(define-method dbi-execute-query ((q <pg-query>) (query-string <string>))
+ (if (not (slot-ref q 'open))
+ (raise
+ (make <dbi-exception> :error-code -2
+ :message "query has already closed.")))
+ (let ((result (pq-exec query-string (slot-ref q '%connection) (make <pq-res>))))
+ (let ((status (pq-result-status result))
+ (error (pq-result-error-message result)))
+ (case status
+ ((PG_NONFATAL_ERROR)
+ (raise
+ (make <dbi-exception> :error-code status :error-message error)))
+ ((PG_FATAL_ERROR)
+ (raise
+ (make <dbi-exception> :error-code status :error-message error))))
+ (make <pg-result-set> :open #t :result-set result
+ :status status
+ :error error
+ :num-rows (pq-ntuples result)
+ :num-cols (pq-nfields result)))))
+
+(define-method call-with-iterator ((r <pg-result-set>) proc . option)
+ (if (not (slot-ref r 'open))
+ (raise (make <dbi-exception> :error-code -4 :message "<pg-result> already closed.")))
+ (let ((row-id -1))
+ (define (end?) (>= (+ row-id 1) (slot-ref r '%num-rows)))
+ (define (next)
+ (inc! row-id)
+ (let ((proc
+ (lambda (n)
+ (let ((value (pq-get-value row-id n (slot-ref r '%result-set)))) value)))) proc))
+ (proc end? next)))
+
+(define-method dbi-get-value ((proc <procedure>) (n <integer>)) (proc n))
+
+(define-method dbi-close ((result-set <pg-result-set>))
+ (if (not (slot-ref result-set 'open))
+ (raise
+ (make <dbi-exception> :error-code -5 :message "already closed.")))
+ (slot-set! result-set 'open #f))
+
+(define-method dbi-close ((query <pg-query>))
+ (if (not (slot-ref query 'open))
+ (raise
+ (make <dbi-exception :error-code -6 :message "already closed.")))
+ (slot-set! query 'open #f))
+
+(define-method dbi-close ((connection <pg-connection>))
+ (if (not (slot-ref connection 'open))
+ (raise
+ (make <dbi-exception> :error-code -7 :message "already closed.")))
+ (slot-set! connection 'open #f)
+ (pq-finish (slot-ref connection '%connection)))
+
+;; Epilogue
+(provide "dbd/pg")
+
+
View
201 gauche_dbd_pg.c
@@ -0,0 +1,201 @@
+/*
+ * gauche_dbd_pg.c
+ *
+ * Copyright (c) 2003-2005 Scheme Arts, L.L.C., All rights reserved.
+ * Copyright (c) 2003-2005 Time Intermedia Corporation, All rights reserved.
+ * See COPYING for terms and conditions of using this software
+ *
+ * $Id: gauche_dbd_pg.c,v 1.1 2005/07/19 00:45:42 shiro Exp $
+ */
+
+#include "gauche_dbd_pg.h"
+
+/*
+ * static function prototypes
+ */
+
+static ScmObj pq_allocate(ScmClass *klass, ScmObj initargs);
+static ScmObj pq_res_allocate(ScmClass *klass, ScmObj initargs);
+
+/*
+ * class definitions
+ */
+
+SCM_DEFINE_BUILTIN_CLASS(Scm_PqClass,
+ NULL, NULL, NULL,
+ pq_allocate,
+ NULL);
+
+SCM_DEFINE_BUILTIN_CLASS(Scm_PqResClass,
+ NULL, NULL, NULL,
+ pq_res_allocate,
+ NULL);
+
+/*
+ * allocators
+ */
+static ScmObj pq_allocate(ScmClass *klass, ScmObj initargs) {
+ ScmPq *h = SCM_NEW(ScmPq);
+ SCM_SET_CLASS(h, SCM_CLASS_PQ);
+ memset(&h->handle, 0, sizeof(h->handle));
+ return SCM_OBJ(h);
+}
+
+static ScmObj pq_res_allocate(ScmClass *klass, ScmObj initargs) {
+ ScmPqRes *r = SCM_NEW(ScmPqRes);
+ SCM_SET_CLASS(r, SCM_CLASS_PQ_RES);
+ memset(&r->res, 0, sizeof(r->res));
+ return SCM_OBJ(r);
+}
+
+/*
+ * cprocs
+ */
+
+ScmObj Scm_PqConnectdb(ScmString *conninfo,
+ ScmObj connection)
+{
+ ScmPq *c;
+
+ if (SCM_PQ_P(connection)) {
+ c = SCM_PQ(connection);
+ c->handle = PQconnectdb(Scm_GetString(conninfo));
+ if (c->handle == NULL) return SCM_FALSE;
+ } else return SCM_FALSE;
+
+ return connection;
+}
+
+ScmObj Scm_PqStatus(ScmObj connection)
+{
+ ScmPq *c;
+ int status;
+ ScmObj result = SCM_FALSE;
+ if (SCM_PQ_P(connection)) {
+ c = SCM_PQ(connection);
+ status = PQstatus(c->handle);
+ result = SCM_MAKE_INT((int)status);
+ } else return SCM_FALSE;
+
+ return result;
+}
+
+ScmObj Scm_PqExec(ScmString *query,
+ ScmObj connection,
+ ScmObj result)
+{
+ ScmPq *c;
+ ScmPqRes *r;
+
+ if (SCM_PQ_P(connection) && SCM_PQ_RES_P(result)) {
+ c = SCM_PQ(connection);
+ r = SCM_PQ_RES(result);
+ r->res = PQexec(c->handle, Scm_GetString(query));
+ } else return SCM_FALSE;
+
+ return result;
+}
+
+ScmObj Scm_PqResultStatus(ScmObj result) {
+ ExecStatusType pq_status;
+ ScmObj status = SCM_FALSE;
+ ScmPqRes *r;
+
+ if (SCM_PQ_RES_P(result)) {
+ r = SCM_PQ_RES(result);
+ pq_status = PQresultStatus(r->res);
+ status = SCM_MAKE_INT((int)pq_status);
+ } else return SCM_FALSE;
+
+ return status;
+}
+
+ScmObj Scm_PqResultErrorMessage(ScmObj result) {
+ char *pq_error_message;
+ ScmObj error_message = SCM_FALSE;
+ ScmPqRes *r;
+
+ if (SCM_PQ_RES_P(result)) {
+ r = SCM_PQ_RES(result);
+ pq_error_message = PQresultErrorMessage(r->res);
+ error_message = SCM_MAKE_STR_COPYING(pq_error_message);
+ } else return SCM_FALSE;
+
+ return error_message;
+}
+
+ScmObj Scm_PqNtuples(ScmObj result) {
+ ScmObj row_count = SCM_FALSE;
+ ScmPqRes *r;
+ int num_rows;
+
+ if (SCM_PQ_RES_P(result)) {
+ r = SCM_PQ_RES(result);
+ num_rows = PQntuples(r->res);
+ row_count = SCM_MAKE_INT(num_rows);
+ } else return SCM_FALSE;
+
+ return row_count;
+}
+
+ScmObj Scm_PqNfields(ScmObj result) {
+ ScmObj column_count = SCM_FALSE;
+ ScmPqRes *r;
+ int num_cols;
+
+ if (SCM_PQ_RES_P(result)) {
+ r = SCM_PQ_RES(result);
+ num_cols = PQnfields(r->res);
+ column_count = SCM_MAKE_INT(num_cols);
+ } else return SCM_FALSE;
+
+ return column_count;
+}
+
+ScmObj Scm_PqGetValue(int row_id, int col_id, ScmObj result) {
+ ScmObj value = SCM_FALSE;
+ ScmPqRes *r;
+ char *str_value;
+
+ if (SCM_PQ_RES_P(result)) {
+ r = SCM_PQ_RES(result);
+ str_value = PQgetvalue(r->res, row_id, col_id);
+ value = SCM_MAKE_STR_COPYING(str_value);
+ } else return SCM_FALSE;
+
+ return value;
+}
+
+ScmObj Scm_PqFinish(ScmObj connection) {
+ ScmPq *c;
+
+ if (SCM_PQ_P(connection)) {
+ c = SCM_PQ(connection);
+ PQfinish(c->handle);
+ } else return SCM_FALSE;
+
+ return connection;
+}
+
+/*
+ * Module initialization function.
+ */
+extern void Scm_Init_gauche_dbd_pglib(ScmModule*);
+
+ScmObj Scm_Init_gauche_dbd_pg(void)
+{
+ ScmModule *mod;
+
+ /* Register this DSO to Gauche */
+ SCM_INIT_EXTENSION(gauche_dbd_pg);
+
+ /* Create the module if it doesn't exist yet. */
+ mod = SCM_MODULE(SCM_FIND_MODULE("dbd.pg", TRUE));
+
+ /* Register classes */
+ Scm_InitStaticClass(&Scm_PqClass, "<pq-handle>", mod, NULL, 0);
+ Scm_InitStaticClass(&Scm_PqResClass, "<pq-res>", mod, NULL, 0);
+
+ /* Register stub-generated procedures */
+ Scm_Init_gauche_dbd_pglib(mod);
+}
View
70 gauche_dbd_pg.h
@@ -0,0 +1,70 @@
+/*
+ * gauche_dbd_pg.h
+ *
+ * Copyright (c) 2003-2005 Scheme Arts, L.L.C., All rights reserved.
+ * Copyright (c) 2003-2005 Time Intermedia Corporation, All rights reserved.
+ * See COPYING for terms and conditions of using this software
+ *
+ * $Id: gauche_dbd_pg.h,v 1.1 2005/07/19 00:45:42 shiro Exp $
+ */
+
+/* Prologue */
+#ifndef GAUCHE_DBD_PG_H
+#define GAUCHE_DBD_PG_H
+
+#include <stdio.h>
+#include <libpq-fe.h>
+#include <gauche.h>
+#include <gauche/extend.h>
+
+SCM_DECL_BEGIN
+
+SCM_CLASS_DECL(Scm_PqClass);
+SCM_CLASS_DECL(Scm_PqResClass);
+
+#define SCM_CLASS_PQ (&Scm_PqClass)
+#define SCM_CLASS_PQ_RES (&Scm_PqResClass)
+
+typedef struct ScmPqRec {
+ SCM_HEADER;
+ PGconn *handle;
+} ScmPq;
+
+typedef struct ScmPqResRec {
+ SCM_HEADER;
+ PGresult *res;
+} ScmPqRes;
+
+#define SCM_PQ(obj) ((ScmPq *)(obj))
+#define SCM_PQ_RES(obj) ((ScmPqRes *)(obj))
+
+#define SCM_PQ_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_PQ))
+#define SCM_PQ_RES_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_PQ_RES))
+
+extern void Scm_Init_pqlib(ScmModule *module);
+
+extern ScmObj Scm_PqConnectdb(ScmString *conninfo,
+ ScmObj connection);
+
+extern ScmObj Scm_PqStatus(ScmObj connection);
+
+extern ScmObj Scm_PqExec(ScmString *query,
+ ScmObj connection,
+ ScmObj result);
+
+extern ScmObj Scm_PqResultStatus(ScmObj result);
+
+extern ScmObj Scm_PqResultErrorMessage(ScmObj result);
+
+extern ScmObj Scm_PqNtuples(ScmObj result);
+
+extern ScmObj Scm_PqNfields(ScmObj result);
+
+extern ScmObj Scm_PqGetValue(int row_id, int col_id, ScmObj result);
+
+extern ScmObj Scm_PqFinish(ScmObj connection);
+
+/* Epilogue */
+SCM_DECL_END
+
+#endif /* GAUCHE_DBD_PG_H */
View
67 gauche_dbd_pglib.stub
@@ -0,0 +1,67 @@
+;;-*-Scheme-*-
+;; pqlib.stub - pq driver stub
+;;
+;; Copyright (c) 2003-2005 Scheme Arts, L.L.C., All rights reserved.
+;; Copyright (c) 2003-2005 Time Intermedia Corporation, All rights reserved.
+;; See COPYING for terms and conditions of using this software
+;;
+;; $Id: gauche_dbd_pglib.stub,v 1.1 2005/07/19 00:45:42 shiro Exp $
+
+"
+#include \"gauche_dbd_pg.h\"
+"
+
+(define-cproc pq-connectdb
+ (conninfo::<string> &optional connection)
+ "SCM_RETURN(Scm_PqConnectdb(conninfo, connection));")
+
+(define-cproc pq-exec
+ (query::<string> &optional connection result)
+ "SCM_RETURN(Scm_PqExec(query, connection, result));")
+
+;; ConnStatusType from libpq-fe.h
+(define-enum CONNECTION_OK)
+(define-enum CONNECTION_BAD)
+(define-enum CONNECTION_STARTED)
+(define-enum CONNECTION_MADE)
+(define-enum CONNECTION_AWAITING_RESPONSE)
+(define-enum CONNECTION_AUTH_OK)
+(define-enum CONNECTION_SETENV)
+(define-enum CONNECTION_SSL_STARTUP)
+(define-enum CONNECTION_NEEDED)
+
+;; ExecStatusType from libpq-fe.h
+(define-enum PGRES_EMPTY_QUERY)
+(define-enum PGRES_COMMAND_OK)
+(define-enum PGRES_TUPLES_OK)
+(define-enum PGRES_COPY_OUT)
+(define-enum PGRES_COPY_IN)
+(define-enum PGRES_BAD_RESPONSE)
+(define-enum PGRES_NONFATAL_ERROR)
+(define-enum PGRES_FATAL_ERROR)
+
+(define-cproc pq-status
+ (&optional connection)
+ "SCM_RETURN(Scm_PqStatus(connection));")
+
+(define-cproc pq-result-status
+ (&optional result)
+ "SCM_RETURN(Scm_PqResultStatus(result));")
+
+(define-cproc pq-result-error-message
+ (&optional result)
+ "SCM_RETURN(Scm_PqResultErrorMessage(result));")
+
+(define-cproc pq-ntuples
+ (&optional result)
+ "SCM_RETURN(Scm_PqNtuples(result));")
+
+(define-cproc pq-nfields
+ (&optional result)
+ "SCM_RETURN(Scm_PqNfields(result));")
+
+(define-cproc pq-get-value (row_id::<int> col_id::<int> &optional result)
+ "SCM_RETURN(Scm_PqGetValue(row_id, col_id, result));")
+
+(define-cproc pq-finish(&optional connection)
+ "SCM_RETURN(Scm_PqFinish(connection));")
View
102 test.scm
@@ -0,0 +1,102 @@
+;;;
+;;; Test dbd.pg
+;;;
+
+(use gauche.test)
+(use gauche.collection)
+(use srfi-1)
+(use srfi-13)
+
+(test-start "dbd.pg")
+(use dbi)
+(use dbd.pg)
+(test-module 'dbd.pg)
+
+;; dbi-make-driver のテスト:
+;; "pg" ドライバーをロードして
+;; クラス <pg-driver> のインスタンスだったら合格
+(define pg-driver (dbi-make-driver "pg"))
+(test* "dbi-make-driver pg"
+ #t
+ (is-a? pg-driver <pg-driver>))
+
+;; dbi-make-connection のテスト:
+;; <pg-driver>型のインスタンスを引数にしたとき
+;; dbi-make-connection の戻り値が
+;; <pg-connection>型のインスタンスだったら合格
+;; 注: (sys-getenv "USER")で取得した現在のユーザーがパスワードなしで
+;; PostgreSQLのデフォルトデータベースに接続できる必要がある。
+(define current-user (sys-getenv "USER"))
+(define pg-connection
+ (dbi-make-connection pg-driver current-user "" ""))
+(test* "dbi-make-connection <pg-driver>"
+ #t
+ (is-a? pg-connection <pg-connection>))
+
+;; dbi-make-query のテスト:
+;; <pg-connection>型のインスタンスを引数にしたとき
+;; dbi-make-queryの戻り値が
+;; <pg-query>型のインスタンスだったら合格
+(define pg-query (dbi-make-query pg-connection))
+(test* "dbi-make-query <pg-connection>"
+ #t
+ (is-a? pg-query <pg-query>))
+
+;;;; testテーブルをdropしておく
+(with-error-handler
+ (lambda (e) #t)
+ (lambda () (dbi-execute-query pg-query "drop table test")))
+;;;; testテーブルを作成しておく
+(dbi-execute-query pg-query "create table test (id integer, name varchar)")
+;;;; testテーブルにデータをinsertしておく
+(dbi-execute-query pg-query
+ "insert into test (id, name) values (10, 'yasuyuki')")
+(dbi-execute-query pg-query
+ "insert into test (id, name) values (20, 'nyama')")
+
+;; dbi-execute-query のテスト:
+;; <pg-query>型のインスタンスを引数にしたとき
+;; dbi-execute-query の戻り値が
+;; <pg-result-set>型のインスタンスだったら合格
+(define pg-result-set (dbi-execute-query pg-query "select * from test"))
+(test* "dbi-execute-query <pg-query>"
+ #t
+ (is-a? pg-result-set <pg-result-set>))
+
+;; dbi-get-valueのテスト:
+;; map の中で pg-get-value を使って <pg-result-set> からすべての行を取得し、
+;; あらかじめ insertされた (("10" "yasuyuki") ("20" "nyama")) に等しければ合格
+(test* "dbi-get-value with map"
+ '(("10" "yasuyuki") ("20" "nyama"))
+ (map (lambda (row)
+ (list (dbi-get-value row 0) (dbi-get-value row 1)))
+ pg-result-set))
+
+;; dbi-close <dbi-result-set> のテスト:
+;; <pg-result-set>型のインスタンスをcloseして再度アクセスし、
+;; <dbi-exception>が発生したら合格
+(dbi-close pg-result-set)
+(test* "dbi-close <pg-result-set>" *test-error*
+ (dbi-close pg-result-set))
+
+;; dbi-close <dbi-query> のテスト:
+;; <pg-query>型のインスタンスをcloseして再度アクセスし、
+;; <dbi-exception>が発生したら合格
+(dbi-close pg-query)
+(test* "dbi-close <pg-query>" *test-error*
+ (dbi-close pg-query))
+
+;; dbi-close <dbi-connection> のテスト:
+;; <pg-connection>型のインスタンスをcloseして再度アクセスし、
+;; <dbi-exception>が発生したら合格
+(dbi-close pg-connection)
+(test* "dbi-close <pg-connection>" *test-error*
+ (dbi-close pg-connection))
+
+;; epilogue
+(test-end)
+
+
+
+
+

0 comments on commit d2156ad

Please sign in to comment.
Something went wrong with that request. Please try again.