Initial revision
[chise/xemacs-chise.git.1] / src / postgresql.c
index 00ca1ae..724b043 100644 (file)
@@ -57,6 +57,9 @@ TODO (in rough order of priority):
   PQgetlineAsync (copy in/out Asynch.)
   PQputnbytes (copy in/out Asynch.)
   PQendcopy (copy in/out)
+  PQsetenvStart (Asynch. Queries)
+  PQsetenvPoll (Asynch. Queries)
+  PQsetenvHandle (Asynch. Queries)
 
   Unsupported functions:
   PQsetdbLogin -- This function is deprecated, has a subset of the
@@ -99,12 +102,18 @@ TODO (in rough order of priority):
 #include "lisp.h"
 #include "sysdep.h"
 #include "buffer.h"
+
+#include <libpq-fe.h>
+/* Undefine the following when asynchronous setenvs are fixed in libpq. */
+/* #define LIBPQ_7_0_IS_FIXED */
 #include "postgresql.h"
 
 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */
+#define I_HATE_CONST CONST
 #define PG_OS_CODING FORMAT_FILENAME
 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to)
 #else
+#define I_HATE_CONST const
 #ifdef MULE
 #define PG_OS_CODING Fget_coding_system(Vpg_coding_system)
 #else
@@ -387,11 +396,114 @@ DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
                               Lisp_PGresult);
 #endif
 
+/****/
+#ifdef HAVE_POSTGRESQLV7
+/* PGsetenvHandle is an opaque object and we need to be able to store them in
+   Lisp code so we can make asynchronous environmental calls.
+
+   Asynchronous setenv calls were introduced in libpq-7.0.
+*/
+#ifdef LIBPQ_7_0_IS_FIXED
+
+Lisp_Object Qpgsetenvp;
+
+static Lisp_Object
+make_pgsetenv (Lisp_PGsetenvHandle *pgsetenv)
+{
+  Lisp_Object lisp_pgsetenv;
+  XSETPGSETENV (lisp_pgsetenv, pgsetenv);
+  return lisp_pgsetenv;
+}
+
+static Lisp_Object
+#ifdef RUNNING_XEMACS_21_1
+mark_pgsetenv (Lisp_Object obj, void (*markobj) (Lisp_Object))
+#else
+mark_pgsetenv (Lisp_Object obj)
+#endif
+{
+  return Qnil;
+}
+
+static void
+print_pgsetenv (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  char *fmt = "#<PGsetenvHandle %s>";
+  char buf[1024];
+  PGsetenvHandle *h;
+
+  h = (XPGSETENV (obj))->pgsetenv;
+
+  sprintf (buf, fmt, h ? "live" : "DEAD");
+
+  /* There are no accessor functions to retrieve any fields, so we must */
+  /* treat this as being completely opaque. */
+  if (print_readably)
+    error ("printing unreadable object %s", buf);
+  else
+    write_c_string (buf, printcharfun);
+}
+
+static Lisp_PGsetenvHandle *
+allocate_pgresult (void)
+{
+#ifdef RUNNING_XEMACS_21_1
+  Lisp_PGsetenvHandle *pgsetenv =
+    alloc_lcrecord_type (Lisp_PGsetenvHandle, lrecord_pgsetenv);
+#else
+  Lisp_PGsetenvHandle *pgsetenv =
+    alloc_lcrecord_type (Lisp_PGsetenvHandle, &lrecord_pgsetenv);
+#endif
+  pgsetenv->pgsetenv = (PGsetenvState *)NULL;
+  return pgsetenv;
+}
+
+static void
+finalize_pgsetenv (void *header, int for_disksave)
+{
+  Lisp_PGsetenvHandle *pgsetenv = (Lisp_PGsetenvHandle *)header;
+
+  if (for_disksave)
+    signal_simple_error ("Can't dump an emacs containing PGsetenvHandle objects",
+                         make_pgsetenv (pgsetenv));
+
+  /* #### PGsetenvHandle's are allocated with malloc(), however in
+     libpq-7.0 the treatment of them is little short of disastrous.
+     We don't dare attempt to free it, because there are many code
+     paths which lead to the handle being freed internally.  The
+     connection routines leak setenv handles and so will we until
+     libpq gets cleaned up.
+     Actually, in 7.0b1 asynchronous setenv cannot work outside libpq, so
+     these functions are disabled in this API.
+  */
+  if (pgsetenv->pgsetenv)
+    {
+      free (pgsetenv->pgsetenv);
+      pgsetenv->pgsetenv = (PGsetenvHandle *)NULL;
+    }
+}
+
+#ifdef RUNNING_XEMACS_21_1
+DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
+                              mark_pgresult, print_pgresult, finalize_pgresult,
+                              NULL, NULL,
+                              Lisp_PGresult);
+#else
+DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
+                              mark_pgresult, print_pgresult, finalize_pgresult,
+                              NULL, NULL,
+                              0,
+                              Lisp_PGresult);
+#endif /* RUNNING_XEMACS_21_1 */
+
+#endif /* LIBPQ_7_0_IS_FIXED */
+#endif /* HAVE_POSTGRESQLV7 */
+
 /***********************/
 
 /* notices */
 static void
-xemacs_notice_processor (void *arg, const char *msg)
+xemacs_notice_processor (void *arg, I_HATE_CONST char *msg)
 {
   warn_when_safe (Qpostgresql, Qnotice, "%s", msg);
 }
@@ -535,15 +647,15 @@ Poll an asynchronous connection for completion
        (conn))
 {
   PGconn *P;
-  PostgresPollingStatusType polling_status;
+  PostgresPollingStatusType PS;
 
   CHECK_PGCONN (conn);
 
   P = (XPGCONN (conn))->pgconn;
   CHECK_LIVE_CONNECTION (P);
 
-  polling_status = PQconnectPoll (P);
-  switch (polling_status)
+  PS = PQconnectPoll (P);
+  switch (PS)
     {
     case PGRES_POLLING_FAILED:
       /* Something Bad has happened */
@@ -561,7 +673,7 @@ Poll an asynchronous connection for completion
       return Qpgres_polling_active;
     default:
       /* they've added a new field we don't know about */
-      error ("Help!  Unknown status code %08x from backend!", polling_status);
+      error ("Help!  Unknown status code %08x from backend!", PS);
     }
 }
 
@@ -720,20 +832,20 @@ Reset connection to the backend asynchronously.
 }
 
 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
-Poll an asynchronous reset for completion.
+Poll an asynchronous reset for completion
 */
        (conn))
 {
   PGconn *P;
-  PostgresPollingStatusType polling_status;
+  PostgresPollingStatusType PS;
 
   CHECK_PGCONN (conn);
 
   P = (XPGCONN (conn))->pgconn;
   CHECK_LIVE_CONNECTION (P);
 
-  polling_status = PQresetPoll (P);
-  switch (polling_status)
+  PS = PQresetPoll (P);
+  switch (PS)
     {
     case PGRES_POLLING_FAILED:
       /* Something Bad has happened */
@@ -751,7 +863,7 @@ Poll an asynchronous reset for completion.
       return Qpgres_polling_active;
     default:
       /* they've added a new field we don't know about */
-      error ("Help!  Unknown status code %08x from backend!", polling_status);
+      error ("Help!  Unknown status code %08x from backend!", PS);
     }
 }
 #endif
@@ -841,12 +953,12 @@ pq::backend-pid   Process ID of backend process
     return build_ext_string (PQoptions(P), PG_OS_CODING);
   else if (EQ (field, Qpqstatus))
     {
-      ConnStatusType cst;
+      ExecStatusType est;
       /* PQstatus Returns the status of the connection. The status can be
         CONNECTION_OK or CONNECTION_BAD.
         ConnStatusType PQstatus(PGconn *conn)
       */
-      switch ((cst = PQstatus (P)))
+      switch ((est = PQstatus (P)))
        {
        case CONNECTION_OK: return Qpg_connection_ok;
        case CONNECTION_BAD: return Qpg_connection_bad;
@@ -859,7 +971,7 @@ pq::backend-pid   Process ID of backend process
 #endif /* HAVE_POSTGRESQLV7 */
        default:
          /* they've added a new field we don't know about */
-         error ("Help!  Unknown connection status code %08x from backend!", cst);
+         error ("Help!  Unknown exec status code %08x from backend!", est);
        }
     }
   else if (EQ (field, Qpqerrormessage))
@@ -1252,7 +1364,7 @@ Returns the command status string from the SQL command that generated the result
 }
 
 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
-Returns the number of rows affected by the SQL command.
+Returns the number of rows affected by the SQL command
 */
        (result))
 {
@@ -1304,7 +1416,7 @@ Needs to be called only on a connected database connection.
 }
 
 DEFUN ("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
-Return the blocking status of the database connection.
+Return the blocking status of the database connection
 */
        (conn))
 {
@@ -1318,7 +1430,7 @@ Return the blocking status of the database connection.
 }
 
 DEFUN ("pq-flush", Fpq_flush, 1, 1, 0, /*
-Force the write buffer to be written (or at least try).
+Force the write buffer to be written (or at least try)
 */
        (conn))
 {
@@ -1538,7 +1650,7 @@ The returned string is *not* null-terminated.
   if (ret == -1) return Qt; /* done! */
   else if (!ret) return Qnil; /* no data yet */
   else return Fcons (make_int (ret),
-                    make_ext_string ((Extbyte *) buffer, ret, PG_OS_CODING));
+                    make_ext_string (buffer, ret, PG_OS_CODING));
 }
 
 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
@@ -1575,12 +1687,114 @@ End a copying operation.
   return PQendcopy (P) ? Qt : Qnil;
 }
 
+/* The setenv suite of functions. The author of the libpq manual doesn't
+   know a whole lot about them, and neither do I.
+*/
+#if !defined (HAVE_POSTGRESQLV7) || defined (LIBPQ_7_0_IS_FIXED)
+DEFUN ("pq-setenv", Fpq_setenv, 1, 1, 0, /*
+Set environmental parameters on the backend synchronously.
+Returns t if the operation was successful, nil otherwise.
+*/
+       (conn))
+{
+  PGconn *P;
+
+  CHECK_PGCONN (conn);
+  P = (XPGCONN (conn))->pgconn;
+  CHECK_LIVE_CONNECTION (P);
+
+  return PQsetenv (P) ? Qt : Qnil;
+}
+#endif
+
+#ifdef LIBPQ_7_0_IS_FIXED
+
+DEFUN ("pq-setenv-start", Fpq_setenv_start, 1, 1, 0, /*
+Set environmental parameters on the backend asynchronously.
+A PGsetenvHandle is returned on success, nil otherwise.
+*/
+       (conn))
+{
+  PGconn *P;
+  PGsetenvHandle *handle;
+  Lisp_setenvHandle *lseh;
+
+  CHECK_PGCONN (conn);
+  P = (XPGCONN (conn))->pgconn;
+  CHECK_LIVE_CONNECTION (P);
+
+  handle = PQsetenvStart (P);
+  if (!handle) error ("out of memory?");
+
+  lseh = allocate_pgsetenv ();
+  lseh->setenv = handle;
+
+  return make_pgsetenv (lseh);
+}
+
+DEFUN ("pq-setenv-poll", Fpq_setenv_poll, 1, 1, 0, /*
+Poll an asynchronous setenv operation for completion.
+*/
+       (conn))
+{
+  PGconn *P;
+  PostgresPollingStatusType pst;
+
+  CHECK_PGCONN (conn);
+  P = (XPGCONN (conn))->pgconn;
+  CHECK_LIVE_CONNECTION (P);
+
+  pst = PQsetenvPoll (P);
+  switch (pst)
+    {
+    case PGRES_POLLING_FAILED:
+      /* Something Bad has happened */
+      {
+       char *e = PQerrorMessage (P);
+       error ("libpq: %s", e);
+      }
+    case PGRES_POLLING_OK:
+      return Qpgres_polling_ok;
+    case PGRES_POLLING_READING:
+      return Qpgres_polling_reading;
+    case PGRES_POLLING_WRITING:
+      return Qpgres_polling_writing;
+    case PGRES_POLLING_ACTIVE:
+      return Qpgres_polling_active;
+    default:
+      /* they've added a new field we don't know about */
+      error ("Help!  Unknown status code %08x from backend!", PS);
+    }
+}
+
+DEFUN ("pq-setenv-abort", Fpq_setenv_abort, 1, 1, 0, /*
+Attempt to abort an in-progress asynchronous setenv operation.
+*/
+       (handle))
+{
+  PGsetenvHandle *h;
+
+  CHECK_PGSETENV (handle);
+  h = (XPGSETENV (handle))->pgsetenv;
+  PUKE_IF_NULL (h);
+
+  PQsetenvAbort (h);
+  /* PQsetenvAbort usually free(3)'s the handle, don't take any chances. */
+  (XSETENV (handle))->pgsetenv = (PGsetenvHandle *)NULL;
+
+  return Qt;
+}
+#endif /* LIBPQ_7_0_IS_FIXED */
+
 void
 syms_of_postgresql(void)
 {
 #ifndef RUNNING_XEMACS_21_1
   INIT_LRECORD_IMPLEMENTATION (pgconn);
   INIT_LRECORD_IMPLEMENTATION (pgresult);
+#ifdef LIBPQ_7_0_IS_FIXED
+  INIT_LRECORD_IMPLEMENTATION (pgsetenv);
+#endif
 #endif
   defsymbol (&Qpostgresql, "postgresql");
 
@@ -1693,6 +1907,16 @@ syms_of_postgresql(void)
   DEFSUBR (Fpq_get_line_async);
   DEFSUBR (Fpq_put_nbytes);
   DEFSUBR (Fpq_end_copy);
+
+  /* The value of the setenv functions is questioned in the libpq manual. */
+#if !defined (HAVE_POSTGRESQLV7) || defined (LIBPQ_7_0_IS_FIXED)
+  DEFSUBR (Fpq_setenv);
+#endif
+#ifdef LIBPQ_7_0_IS_FIXED
+  DEFSUBR (Fpq_setenv_start);
+  DEFSUBR (Fpq_setenv_poll);
+  DEFSUBR (Fpq_setenv_abort);
+#endif /* LIBPQ_7_0_IS_FIXED */
 }
 
 void