From: Chris Hanson Date: Fri, 6 Jun 2003 19:14:19 +0000 (+0000) Subject: First draft of PostgreSQL support. X-Git-Tag: 20090517-FFI~1897 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=16a3246a1f6e25c905ef89dd9c3c427db24339f2;p=mit-scheme.git First draft of PostgreSQL support. --- diff --git a/v7/src/microcode/acconfig.h b/v7/src/microcode/acconfig.h index 4129acbb9..9ae28ba68 100644 --- a/v7/src/microcode/acconfig.h +++ b/v7/src/microcode/acconfig.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: acconfig.h,v 11.7 2003/05/17 02:21:04 cph Exp $ +$Id: acconfig.h,v 11.8 2003/06/06 19:14:16 cph Exp $ Copyright 2002,2001,2003 Massachusetts Institute of Technology @@ -105,6 +105,9 @@ USA. /* Define if termcap library is present. */ #undef HAVE_LIBTERMCAP +/* Define if PostgreSQL library is present. */ +#undef HAVE_LIBPQ + @BOTTOM@ #ifndef __unix__ diff --git a/v7/src/microcode/configure.in b/v7/src/microcode/configure.in index b6bb3aaee..52ac923e6 100644 --- a/v7/src/microcode/configure.in +++ b/v7/src/microcode/configure.in @@ -19,7 +19,7 @@ dnl along with MIT/GNU Scheme; if not, write to the Free Software dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA dnl 02111-1307, USA. -AC_REVISION([$Id: configure.in,v 11.23 2003/05/17 20:55:37 cph Exp $]) +AC_REVISION([$Id: configure.in,v 11.24 2003/06/06 19:14:19 cph Exp $]) AC_INIT(boot.c) AC_CONFIG_HEADER(config.h) @@ -35,7 +35,9 @@ AC_ARG_WITH(openssl, AC_ARG_WITH(mhash, [ --with-mhash Use the mhash library if available [yes]]) AC_ARG_WITH(mcrypt, -[ --with-mcrypt Use the mcrypt library available [yes]]) +[ --with-mcrypt Use the mcrypt library if available [yes]]) +AC_ARG_WITH(libpq, +[ --with-libpq Use the PostgreSQL libpq library if available [yes]]) dnl Substitution variables to be filled in below. AS_FLAGS= @@ -106,6 +108,9 @@ AC_CHECK_LIB(curses, tparm, AC_CHECK_LIB(termcap, tparam, [scheme_cv_lib_termcap=yes], [scheme_cv_lib_termcap=no]) +AC_CHECK_LIB(pq, PQconnectdb, + [scheme_cv_lib_pq=yes], + [scheme_cv_lib_pq=no]) dnl Checks for header files. AC_HEADER_DIRENT @@ -118,6 +123,7 @@ AC_CHECK_HEADERS(sys/ptyio.h sys/socket.h sys/time.h sys/un.h sys/vfs.h) AC_CHECK_HEADERS(stdbool.h termio.h termios.h unistd.h utime.h) AC_CHECK_HEADERS(openssl/blowfish.h openssl/md5.h blowfish.h md5.h) AC_CHECK_HEADERS(mhash.h mcrypt.h gdbm.h curses.h term.h dlfcn.h sys/mman.h) +AC_CHECK_HEADERS(postgresql/libpq-fe.h) dnl Checks for typedefs AC_TYPE_MODE_T @@ -418,6 +424,7 @@ dnl Handle options to enable/disable use of some libraries. test "${with_openssl:-yes}" = "no" && scheme_cv_lib_crypto="no" test "${with_mhash:-yes}" = "no" && scheme_cv_lib_mhash="no" test "${with_mcrypt:-yes}" = "no" && scheme_cv_lib_mcrypt="no" +test "${with_libpq:-yes}" = "no" && scheme_cv_lib_pq="no" dnl Next, we decide which libraries to use. We mostly want support dnl for Blowfish and MD5, each of which can come from multiple libraries. @@ -558,6 +565,15 @@ else fi fi +dnl PostgreSQL support. +if test "${scheme_cv_lib_pq}" = "yes"; then + AC_DEFINE(HAVE_LIBPQ) + if test "${ac_cv_header_postgresql_libpq_fe_h}" = "yes"; then + QUASI_STATIC_LIBS="${QUASI_STATIC_LIBS} -lpq" + OPTIONAL_BASES="${OPTIONAL_BASES} prpgsql" + fi +fi + dnl Decide whether we're using static or dynamic libraries. if test "${enable_static_libs:-no}" = "no"; then LIBS="${LIBS}${QUASI_STATIC_LIBS}" diff --git a/v7/src/microcode/prpgsql.c b/v7/src/microcode/prpgsql.c new file mode 100644 index 000000000..415ab22db --- /dev/null +++ b/v7/src/microcode/prpgsql.c @@ -0,0 +1,182 @@ +/* -*-C-*- + +$Id: prpgsql.c,v 1.1 2003/06/06 19:14:02 cph Exp $ + +Copyright 2003 Massachusetts Institute of Technology + +This file is part of MIT/GNU Scheme. + +MIT/GNU Scheme is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or (at +your option) any later version. + +MIT/GNU Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT/GNU Scheme; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. + +*/ + +/* Interface to PostgreSQL libpq library */ + +#include "scheme.h" +#include "prims.h" +#include "usrdef.h" +#include "os.h" + +#include + +#define ARG_CONN(n) ((PGconn *) (arg_ulong_integer (n))) +#define ARG_RESULT(n) ((PGresult *) (arg_ulong_integer (n))) +#define ARG_EXEC_STATUS(n) ((ExecStatusType) (arg_ulong_integer (n))) + +#define ANY_TO_UINT(x) (ulong_to_integer ((unsigned long) (x))) +#define ANY_TO_UNSPECIFIC(x) ((x), UNSPECIFIC) + +#define ONE_ARG(get_arg, fn, cvt) \ +{ \ + PRIMITIVE_HEADER (1); \ + PRIMITIVE_RETURN (cvt (fn (get_arg (1)))); \ +} + +#define STRING_TO_UINT(fn) ONE_ARG (STRING_ARG, fn, ANY_TO_UINT) + +#define CONN_TO_UINT(fn) ONE_ARG (ARG_CONN, fn, ANY_TO_UINT) +#define CONN_TO_INT(fn) ONE_ARG (ARG_CONN, fn, long_to_integer) +#define CONN_TO_UNSPECIFIC(fn) ONE_ARG (ARG_CONN, fn, ANY_TO_UNSPECIFIC) +#define CONN_TO_STRING(fn) ONE_ARG (ARG_CONN, fn, char_pointer_to_string) + +#define RESULT_TO_UINT(fn) ONE_ARG (ARG_RESULT, fn, ANY_TO_UINT) +#define RESULT_TO_INT(fn) ONE_ARG (ARG_RESULT, fn, long_to_integer) +#define RESULT_TO_UNSPECIFIC(fn) ONE_ARG (ARG_RESULT, fn, ANY_TO_UNSPECIFIC) +#define RESULT_TO_STRING(fn) ONE_ARG (ARG_RESULT, fn, char_pointer_to_string) + +DEFINE_PRIMITIVE ("PQ-CONNECT-DB", Prim_pq_connect_db, 1, 1, 0) + STRING_TO_UINT (PQconnectdb) + +DEFINE_PRIMITIVE ("PQ-CONNECT-START", Prim_pq_connect_start, 1, 1, 0) + STRING_TO_UINT (PQconnectStart) + +DEFINE_PRIMITIVE ("PQ-CONNECT-POLL", Prim_pq_connect_poll, 1, 1, 0) + CONN_TO_UINT (PQconnectPoll) + +DEFINE_PRIMITIVE ("PQ-STATUS", Prim_pq_status, 1, 1, 0) + CONN_TO_UINT (PQstatus) + +DEFINE_PRIMITIVE ("PQ-FINISH", Prim_pq_finish, 1, 1, 0) + CONN_TO_UNSPECIFIC (PQfinish) + +DEFINE_PRIMITIVE ("PQ-RESET", Prim_pq_reset, 1, 1, 0) + CONN_TO_UNSPECIFIC (PQreset) + +DEFINE_PRIMITIVE ("PQ-RESET-START", Prim_pq_reset_start, 1, 1, 0) + CONN_TO_INT (PQresetStart) + +DEFINE_PRIMITIVE ("PQ-RESET-POLL", Prim_pq_reset_poll, 1, 1, 0) + CONN_TO_UINT (PQresetPoll) + +DEFINE_PRIMITIVE ("PQ-DB", Prim_pq_db, 1, 1, 0) + CONN_TO_STRING (PQdb) + +DEFINE_PRIMITIVE ("PQ-USER", Prim_pq_user, 1, 1, 0) + CONN_TO_STRING (PQuser) + +DEFINE_PRIMITIVE ("PQ-PASS", Prim_pq_pass, 1, 1, 0) + CONN_TO_STRING (PQpass) + +DEFINE_PRIMITIVE ("PQ-HOST", Prim_pq_host, 1, 1, 0) + CONN_TO_STRING (PQhost) + +DEFINE_PRIMITIVE ("PQ-PORT", Prim_pq_port, 1, 1, 0) + CONN_TO_STRING (PQport) + +DEFINE_PRIMITIVE ("PQ-TTY", Prim_pq_tty, 1, 1, 0) + CONN_TO_STRING (PQtty) + +DEFINE_PRIMITIVE ("PQ-OPTIONS", Prim_pq_options, 1, 1, 0) + CONN_TO_STRING (PQoptions) + +DEFINE_PRIMITIVE ("PQ-ERROR-MESSAGE", Prim_pq_error_message, 1, 1, 0) + CONN_TO_STRING (PQerrorMessage) + +DEFINE_PRIMITIVE ("PQ-EXEC", Prim_pq_exec, 2, 2, 0) +{ + PRIMITIVE_HEADER (2); + PRIMITIVE_RETURN (ANY_TO_UINT (PQexec ((ARG_CONN (1)), (STRING_ARG (2))))); +} + +DEFINE_PRIMITIVE ("PQ-MAKE-EMPTY-PG-RESULT", Prim_pq_make_empty_pg_result, + 2, 2, 0) +{ + PRIMITIVE_HEADER (2); + PRIMITIVE_RETURN + (ANY_TO_UINT (PQmakeEmptyPGresult ((ARG_CONN (1)), + (ARG_EXEC_STATUS (1))))); +} + +DEFINE_PRIMITIVE ("PQ-RESULT-STATUS", Prim_pq_result_status, 1, 1, 0) + RESULT_TO_UINT (PQresultStatus) + +DEFINE_PRIMITIVE ("PQ-RES-STATUS", Prim_pq_res_status, 1, 1, 0) + ONE_ARG (ARG_EXEC_STATUS, PQresStatus, ANY_TO_UINT) + +DEFINE_PRIMITIVE ("PQ-RESULT-ERROR-MESSAGE", Prim_pq_result_error_message, + 1, 1, 0) + RESULT_TO_STRING (PQresultErrorMessage) + +DEFINE_PRIMITIVE ("PQ-CLEAR", Prim_pq_clear, 1, 1, 0) + RESULT_TO_UNSPECIFIC (PQclear) + +DEFINE_PRIMITIVE ("PQ-ESCAPE-STRING", Prim_pq_escape_string, 2, 2, 0) +{ + PRIMITIVE_HEADER (2); + CHECK_ARG (1, STRING_P); + PRIMITIVE_RETURN + (ulong_to_integer (PQescapeString ((STRING_ARG (2)), + (STRING_LOC ((ARG_REF (1)), 0)), + (STRING_LENGTH (ARG_REF (1)))))); +} + +DEFINE_PRIMITIVE ("PQ-N-TUPLES", Prim_pq_n_tuples, 1, 1, 0) + RESULT_TO_INT (PQntuples) + +DEFINE_PRIMITIVE ("PQ-N-FIELDS", Prim_pq_n_fields, 1, 1, 0) + RESULT_TO_INT (PQnfields) + +DEFINE_PRIMITIVE ("PQ-FIELD-NAME", Prim_pq_fname, 2, 2, 0) +{ + PRIMITIVE_HEADER (2); + PRIMITIVE_RETURN + (char_pointer_to_string (PQfname ((ARG_RESULT (1)), + (arg_integer (2))))); +} + +DEFINE_PRIMITIVE ("PQ-GET-VALUE", Prim_pq_get_value, 3, 3, 0) +{ + PRIMITIVE_HEADER (3); + PRIMITIVE_RETURN + (char_pointer_to_string (PQgetvalue ((ARG_RESULT (1)), + (arg_integer (2)), + (arg_integer (3))))); +} + +DEFINE_PRIMITIVE ("PQ-GET-IS-NULL?", Prim_pq_get_is_null, 3, 3, 0) +{ + PRIMITIVE_HEADER (3); + PRIMITIVE_RETURN + (BOOLEAN_TO_OBJECT (PQgetisnull ((ARG_RESULT (1)), + (arg_integer (2)), + (arg_integer (3))))); +} + +DEFINE_PRIMITIVE ("PQ-CMD-STATUS", Prim_pq_cmd_status, 1, 1, 0) + RESULT_TO_STRING (PQcmdStatus) + +DEFINE_PRIMITIVE ("PQ-CMD-TUPLES", Prim_pq_cmd_tuples, 1, 1, 0) + RESULT_TO_STRING (PQcmdTuples)