diff modules/postgresql/postgresql.c @ 5125:b5df3737028a ben-lisp-object

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents d1247f3cc363 4aebb0131297
children a9c41067dd88
line wrap: on
line diff
--- a/modules/postgresql/postgresql.c	Wed Jan 20 07:05:57 2010 -0600
+++ b/modules/postgresql/postgresql.c	Wed Feb 24 01:58:04 2010 -0600
@@ -99,7 +99,6 @@
 /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */
 
 #include "lisp.h"
-#include "sysdep.h"
 
 #include "buffer.h"
 #include "postgresql.h"
@@ -107,6 +106,8 @@
 #ifdef HAVE_SHLIB
 # include "emodules.h"
 #endif
+#include "sysdep.h"
+#include "sysfile.h"
 
 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */
 #define PG_OS_CODING FORMAT_FILENAME
@@ -120,15 +121,36 @@
 Lisp_Object Vpg_coding_system;
 #endif
 
-#define CHECK_LIVE_CONNECTION(P) do {					\
-	if (!P || (PQstatus (P) != CONNECTION_OK)) {			\
-		char *e = "bad value";					\
-		if (P) e = PQerrorMessage (P);				\
-	 signal_ferror (Qprocess_error, "dead connection [%s]", e);	\
-	} } while (0)
-#define PUKE_IF_NULL(p) do {						 \
-	if (!p) signal_error (Qinvalid_argument, "bad value", Qunbound); \
-	} while (0)
+#define CHECK_LIVE_CONNECTION(P)					\
+do									\
+{									\
+  if (!P || (PQstatus (P) != CONNECTION_OK))				\
+    {									\
+      Lisp_Object err;							\
+									\
+      if (P)								\
+	err = build_extstring (PQerrorMessage (P), PG_OS_CODING);	\
+      else								\
+	err = build_msg_string ("Bad value");				\
+      signal_error (Qprocess_error, "Dead connection", err);		\
+    }									\
+}									\
+while (0)
+
+#define PUKE_IF_NULL(p)							\
+do									\
+{									\
+  if (!p) signal_error (Qinvalid_argument, "Bad value", Qunbound);	\
+}									\
+while (0)
+
+#define SIGNAL_ERROR(p, reason)						\
+do									\
+{									\
+  signal_error (Qprocess_error, reason,					\
+		build_extstring (PQerrorMessage (p), PG_OS_CODING));	\
+}									\
+while (0)  
 
 static Lisp_Object VXPGHOST;
 static Lisp_Object VXPGUSER;
@@ -205,7 +227,7 @@
   char buf[256];
   PGconn *P;
   ConnStatusType cst;
-  char *host="", *db="", *user="", *port="";
+  const char *host="", *db="", *user="", *port="";
 
   P = (XPGCONN (obj))->pgconn;
 
@@ -233,7 +255,7 @@
   if (print_readably)
     printing_unreadable_object ("%s", buf);
   else
-    write_c_string (printcharfun, buf);
+    write_cistring (printcharfun, buf);
 }
 
 static Lisp_PGconn *
@@ -252,6 +274,8 @@
   return pgconn;
 }
 
+#ifdef RUNNING_XEMACS_21_4
+
 static void
 finalize_pgconn (void *header, int for_disksave)
 {
@@ -268,6 +292,22 @@
     }
 }
 
+#else /* not RUNNING_XEMACS_21_4 */
+
+static void
+finalize_pgconn (void *header)
+{
+  Lisp_PGconn *pgconn = (Lisp_PGconn *)header;
+
+  if (pgconn->pgconn)
+    {
+      PQfinish (pgconn->pgconn);
+      pgconn->pgconn = (PGconn *)NULL;
+    }
+}
+
+#endif /* (not) RUNNING_XEMACS_21_4 */
+
 #ifdef RUNNING_XEMACS_21_1
 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
 			       mark_pgconn, print_pgconn, finalize_pgconn,
@@ -349,7 +389,7 @@
 		   PQcmdStatus (res));
 	  break;
 	default:
-notuples:
+	notuples:
 	  /* No counts to print */
 	  sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */
 		   PQresStatus (PQresultStatus (res)),
@@ -363,7 +403,7 @@
   if (print_readably)
     printing_unreadable_object ("%s", buf);
   else
-    write_c_string (printcharfun, buf);
+    write_cistring (printcharfun, buf);
 }
 
 #undef RESULT_TUPLES_FMT
@@ -386,6 +426,8 @@
   return pgresult;
 }
 
+#ifdef RUNNING_XEMACS_21_4
+
 static void
 finalize_pgresult (void *header, int for_disksave)
 {
@@ -402,6 +444,22 @@
     }
 }
 
+#else /* not RUNNING_XEMACS_21_4 */
+
+static void
+finalize_pgresult (void *header)
+{
+  Lisp_PGresult *pgresult = (Lisp_PGresult *)header;
+
+  if (pgresult->pgresult)
+    {
+      PQclear (pgresult->pgresult);
+      pgresult->pgresult = (PGresult *)NULL;
+    }
+}
+
+#endif /* (not) RUNNING_XEMACS_21_4 */
+
 #ifdef RUNNING_XEMACS_21_1
 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
 			       mark_pgresult, print_pgresult, finalize_pgresult,
@@ -450,23 +508,25 @@
 
   pcio = PQconndefaults();
   if (!pcio) return Qnil; /* can never happen in libpq-7.0 */
-  temp = list1 (Fcons (build_ext_string (pcio[0].keyword, PG_OS_CODING),
-		       Fcons (build_ext_string (pcio[0].envvar, PG_OS_CODING),
-			      Fcons (build_ext_string (pcio[0].compiled, PG_OS_CODING),
-				     Fcons (build_ext_string (pcio[0].val, PG_OS_CODING),
-					    Fcons (build_ext_string (pcio[0].label, PG_OS_CODING),
-						   Fcons (build_ext_string (pcio[0].dispchar, PG_OS_CODING),
-							  Fcons (make_int (pcio[0].dispsize), Qnil))))))));
+  temp =
+    list1 (nconc2 (list4 (build_extstring (pcio[0].keyword, PG_OS_CODING),
+			  build_extstring (pcio[0].envvar, PG_OS_CODING),
+			  build_extstring (pcio[0].compiled, PG_OS_CODING),
+			  build_extstring (pcio[0].val, PG_OS_CODING)),
+		   list3 (build_extstring (pcio[0].label, PG_OS_CODING),
+			  build_extstring (pcio[0].dispchar, PG_OS_CODING),
+			  make_int (pcio[0].dispsize))));
 
   for (i = 1; pcio[i].keyword; i++)
     {
-      temp1 = list1 (Fcons (build_ext_string (pcio[i].keyword, PG_OS_CODING),
-			    Fcons (build_ext_string (pcio[i].envvar, PG_OS_CODING),
-				   Fcons (build_ext_string (pcio[i].compiled, PG_OS_CODING),
-					  Fcons (build_ext_string (pcio[i].val, PG_OS_CODING),
-						 Fcons (build_ext_string (pcio[i].label, PG_OS_CODING),
-							Fcons (build_ext_string (pcio[i].dispchar, PG_OS_CODING),
-							       Fcons (make_int (pcio[i].dispsize), Qnil))))))));
+      temp1 =
+	list1 (nconc2 (list4 (build_extstring (pcio[i].keyword, PG_OS_CODING),
+			      build_extstring (pcio[i].envvar, PG_OS_CODING),
+			      build_extstring (pcio[i].compiled, PG_OS_CODING),
+			      build_extstring (pcio[i].val, PG_OS_CODING)),
+		       list3 (build_extstring (pcio[i].label, PG_OS_CODING),
+			      build_extstring (pcio[i].dispchar, PG_OS_CODING),
+			      make_int (pcio[i].dispsize))));
       {
 	Lisp_Object args[2];
 	args[0] = temp;
@@ -483,44 +543,57 @@
 PGconn *PQconnectdb(const char *conninfo)
 */
 
+#ifdef HAVE_POSTGRESQLV7
+#define USED_IF_V7(x) x
+#else
+#define USED_IF_V7(x) UNUSED (x)
+#endif
+
+static Lisp_Object
+postgresql_connect (Lisp_Object conninfo, int USED_IF_V7 (async))
+{
+  PGconn *P;
+  Lisp_PGconn *lisp_pgconn;
+
+  CHECK_STRING (conninfo);
+
+  P = (
+#ifdef HAVE_POSTGRESQLV7
+       async ? PQconnectStart : 
+#endif
+       PQconnectdb)
+    (LISP_STRING_TO_EXTERNAL (conninfo, PG_OS_CODING));
+  if (P && (PQstatus (P) == CONNECTION_OK))
+    {
+      (void) PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
+      lisp_pgconn = allocate_pgconn ();
+      lisp_pgconn->pgconn = P;
+      return make_pgconn (lisp_pgconn);
+    }
+  else
+    {
+      /* Connection failed.  Destroy the connection and signal an error. */
+
+      Lisp_Object errmsg;
+      if (P)
+	{
+	  errmsg = build_extstring (PQerrorMessage (P), PG_OS_CODING);
+	  PQfinish (P);
+	}
+      else
+	errmsg = build_msg_string ("Out of Memory?");
+      signal_error (Qprocess_error, "Connecting to PostGreSQL backend",
+		    errmsg);
+    }
+}
+
 /* ###autoload */
 DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /*
 Make a new connection to a PostgreSQL backend.
 */
 	(conninfo))
 {
-  PGconn *P;
-  Lisp_PGconn *lisp_pgconn;
-  char *error_message = "Out of Memory?";
-  char *c_conninfo;
-
-  CHECK_STRING (conninfo);
-
-  TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
-		     C_STRING_ALLOCA, c_conninfo, Qnative);
-  P = PQconnectdb (c_conninfo);
-  if (P && (PQstatus (P) == CONNECTION_OK))
-    {
-      (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
-      lisp_pgconn = allocate_pgconn();
-      lisp_pgconn->pgconn = P;
-      return make_pgconn (lisp_pgconn);
-    }
-  else
-    {
-      /* Connection failed.  Destroy the connection and signal an error. */
-      char buf[BLCKSZ];
-      strcpy (buf, error_message);
-      if (P)
-	{
-	  /* storage for the error message gets erased when call PQfinish */
-	  /* so we must temporarily stash it somewhere */
-	  strncpy (buf, PQerrorMessage (P), sizeof (buf));
-	  buf[sizeof (buf) - 1] = '\0';
-	  PQfinish (P);
-	}
-      signal_ferror (Qprocess_error, "libpq: %s", buf);
-    }
+  return postgresql_connect (conninfo, 0);
 }
 
 /* PQconnectStart Makes a new asynchronous connection to a backend.
@@ -534,37 +607,7 @@
 */
 	(conninfo))
 {
-  PGconn *P;
-  Lisp_PGconn *lisp_pgconn;
-  char *error_message = "Out of Memory?";
-  char *c_conninfo;
-
-  CHECK_STRING (conninfo);
-  TO_EXTERNAL_FORMAT (LISP_STRING, conninfo,
-		      C_STRING_ALLOCA, c_conninfo, Qnative);
-  P = PQconnectStart (c_conninfo);
-
-  if (P && (PQstatus (P) != CONNECTION_BAD))
-    {
-      (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
-      lisp_pgconn = allocate_pgconn();
-      lisp_pgconn->pgconn = P;
-
-      return make_pgconn (lisp_pgconn);
-    }
-  else
-    {
-      /* capture the error message before destroying the object */
-      char buf[BLCKSZ];
-      strcpy (buf, error_message);
-      if (P)
-	{
-	  strncpy (buf, PQerrorMessage (P), sizeof (buf));
-	  buf[sizeof (buf) - 1] = '\0';
-	  PQfinish (P);
-	}
-      signal_ferror (Qprocess_error, "libpq: %s", buf);
-    }
+  return postgresql_connect (conninfo, 1);
 }
 
 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
@@ -585,10 +628,7 @@
     {
     case PGRES_POLLING_FAILED:
       /* Something Bad has happened */
-      {
-	char *e = PQerrorMessage (P);
-	signal_ferror (Qprocess_error, "libpq: %s", e);
-      }
+      SIGNAL_ERROR (P, "Polling asynchronous connection");
     case PGRES_POLLING_OK:
       return Qpgres_polling_ok;
     case PGRES_POLLING_READING:
@@ -751,10 +791,7 @@
   CHECK_LIVE_CONNECTION (P);
 
   if (PQresetStart (P)) return Qt;
-  {
-    char *e = PQerrorMessage (P);
-    signal_ferror (Qprocess_error, "libpq: %s", e);
-  }
+  SIGNAL_ERROR (P, "Resetting connection");
 }
 
 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
@@ -774,11 +811,7 @@
   switch (polling_status)
     {
     case PGRES_POLLING_FAILED:
-      /* Something Bad has happened */
-      {
-	char *e = PQerrorMessage (P);
-	signal_ferror (Qprocess_error, "libpq: %s", e);
-      }
+      SIGNAL_ERROR (P, "Polling asynchronous reset");
     case PGRES_POLLING_OK:
       return Qpgres_polling_ok;
     case PGRES_POLLING_READING:
@@ -840,22 +873,22 @@
     /* PQdb Returns the database name of the connection.
        char *PQdb(PGconn *conn)
      */
-    return build_ext_string (PQdb(P), PG_OS_CODING);
+    return build_extstring (PQdb(P), PG_OS_CODING);
   else if (EQ (field, Qpquser))
     /* PQuser Returns the user name of the connection.
        char *PQuser(PGconn *conn)
      */
-    return build_ext_string (PQuser(P), PG_OS_CODING);
+    return build_extstring (PQuser(P), PG_OS_CODING);
   else if (EQ (field, Qpqpass))
     /* PQpass Returns the password of the connection.
        char *PQpass(PGconn *conn)
      */
-    return build_ext_string (PQpass(P), PG_OS_CODING);
+    return build_extstring (PQpass(P), PG_OS_CODING);
   else if (EQ (field, Qpqhost))
     /* PQhost Returns the server host name of the connection.
        char *PQhost(PGconn *conn)
      */
-    return build_ext_string (PQhost(P), PG_OS_CODING);
+    return build_extstring (PQhost(P), PG_OS_CODING);
   else if (EQ (field, Qpqport))
     {
       char *p;
@@ -871,12 +904,12 @@
     /* PQtty Returns the debug tty of the connection.
        char *PQtty(PGconn *conn)
      */
-    return build_ext_string (PQtty(P), PG_OS_CODING);
+    return build_extstring (PQtty(P), PG_OS_CODING);
   else if (EQ (field, Qpqoptions))
   /* PQoptions Returns the backend options used in the connection.
      char *PQoptions(PGconn *conn)
    */
-    return build_ext_string (PQoptions(P), PG_OS_CODING);
+    return build_extstring (PQoptions(P), PG_OS_CODING);
   else if (EQ (field, Qpqstatus))
     {
       ConnStatusType cst;
@@ -905,7 +938,7 @@
        by an operation on the connection.
        char *PQerrorMessage(PGconn* conn);
      */
-    return build_ext_string (PQerrorMessage(P), PG_OS_CODING);
+    return build_extstring (PQerrorMessage(P), PG_OS_CODING);
   else if (EQ (field, Qpqbackendpid))
     /* PQbackendPID Returns the process ID of the backend server handling
        this connection.
@@ -938,7 +971,8 @@
 
   R = PQexec (P, c_query);
   {
-    char *tag, buf[BLCKSZ];
+    const Ascbyte *tag;
+    char buf[BLCKSZ];
 
     if (!R) out_of_memory ("query: out of memory", Qunbound);
     else
@@ -989,7 +1023,7 @@
 		      C_STRING_ALLOCA, c_query, Qnative);
 
   if (PQsendQuery (P, c_query)) return Qt;
-  else signal_ferror (Qprocess_error, "async query: %s", PQerrorMessage (P));
+  else SIGNAL_ERROR (P, "Sending asynchronous query");
 }
 
 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /*
@@ -1011,7 +1045,8 @@
   if (!R) return Qnil; /* not an error, there's no more data to get */
 
   {
-    char *tag, buf[BLCKSZ];
+    const Ascbyte *tag;
+    char buf[BLCKSZ];
 
     switch (PQresultStatus (R))
       {
@@ -1063,7 +1098,9 @@
   case PGRES_FATAL_ERROR: return Qpgres_fatal_error;
   default:
     /* they've added a new field we don't know about */
-    signal_ferror (Qprocess_error, "Help!  Unknown exec status code %08x from backend!", est);
+    signal_ferror (Qprocess_error,
+		   "Help!  Unknown exec status code %08x from backend!",
+		   est);
   }
 }
 
@@ -1078,7 +1115,7 @@
   R = (XPGRESULT (result))->pgresult;
   PUKE_IF_NULL (R);
 
-  return build_ext_string (PQresStatus (PQresultStatus (R)), PG_OS_CODING);
+  return build_extstring (PQresStatus (PQresultStatus (R)), PG_OS_CODING);
 }
 
 /* Sundry PGresult accessor functions */
@@ -1093,7 +1130,7 @@
   R = (XPGRESULT (result))->pgresult;
   PUKE_IF_NULL (R);
 
-  return build_ext_string (PQresultErrorMessage (R), PG_OS_CODING);
+  return build_extstring (PQresultErrorMessage (R), PG_OS_CODING);
 }
 
 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
@@ -1151,7 +1188,7 @@
   R = (XPGRESULT (result))->pgresult;
   PUKE_IF_NULL (R);
 
-  return build_ext_string (PQfname (R, XINT (field_index)), PG_OS_CODING);
+  return build_extstring (PQfname (R, XINT (field_index)), PG_OS_CODING);
 }
 
 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
@@ -1236,7 +1273,7 @@
   R = (XPGRESULT (result))->pgresult;
   PUKE_IF_NULL (R);
 
-  return build_ext_string (PQgetvalue (R, XINT (tup_num), XINT (field_num)),
+  return build_extstring (PQgetvalue (R, XINT (tup_num), XINT (field_num)),
 			   PG_OS_CODING);
 }
 
@@ -1286,7 +1323,7 @@
   R = (XPGRESULT (result))->pgresult;
   PUKE_IF_NULL (R);
 
-  return build_ext_string (PQcmdStatus (R), PG_OS_CODING);
+  return build_extstring (PQcmdStatus (R), PG_OS_CODING);
 }
 
 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
@@ -1300,7 +1337,7 @@
   R = (XPGRESULT (result))->pgresult;
   PUKE_IF_NULL (R);
 
-  return build_ext_string (PQcmdTuples (R), PG_OS_CODING);
+  return build_extstring (PQcmdTuples (R), PG_OS_CODING);
 }
 
 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
@@ -1394,7 +1431,7 @@
   {
     Lisp_Object temp;
 
-    temp = list2 (build_ext_string (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid));
+    temp = list2 (build_extstring (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid));
     free ((void *)PGN);
     return temp;
   }
@@ -1424,9 +1461,7 @@
   P = (XPGCONN (conn))->pgconn;
   CHECK_LIVE_CONNECTION (P);
 
-  TO_EXTERNAL_FORMAT (LISP_STRING, filename,
-		      C_STRING_ALLOCA, c_filename,
-		      Qfile_name);
+  LISP_PATHNAME_CONVERT_OUT (filename, c_filename);
 
   return make_int ((int)lo_import (P, c_filename));
 }
@@ -1445,8 +1480,7 @@
   P = (XPGCONN (conn))->pgconn;
   CHECK_LIVE_CONNECTION (P);
 
-  TO_EXTERNAL_FORMAT (LISP_STRING, filename,
-		      C_STRING_ALLOCA, c_filename, Qfile_name);
+  LISP_PATHNAME_CONVERT_OUT (filename, c_filename);
 
   return make_int ((int)lo_export (P, XINT (oid), c_filename));
 }
@@ -1508,7 +1542,7 @@
 
   ret = PQgetline (P, buffer, sizeof (buffer));
 
-  return Fcons (make_int (ret), build_ext_string (buffer, PG_OS_CODING));
+  return Fcons (make_int (ret), build_extstring (buffer, PG_OS_CODING));
 }
 
 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /*
@@ -1577,7 +1611,7 @@
   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_extstring ((Extbyte *) buffer, ret, PG_OS_CODING));
 }
 
 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
@@ -1847,7 +1881,7 @@
 
 #define FROB(envvar, var)			\
   if ((p = egetenv (envvar)))			\
-    var = build_intstring (p);	\
+    var = build_istring (p);	\
   else						\
     var = Qnil