[elpa] externals/pq 46e38888e3 01/63: Initial commit.

[ELPA Syncer]

branch: externals/pq
commit 46e38888e39cce747b56b6af6c61c33580e34799
Author: Andreas Seltenreich <andreas+git@ansel.ydns.eu>
Commit: Andreas Seltenreich <andreas+git@ansel.ydns.eu>

    Initial commit.
---
 #test.el#  |  14 ++
 Makefile   |   8 ++
 README.org |   9 ++
 pg_type.h  |  61 ++++++++
 pq.c       | 469 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test.el    |  13 ++
 6 files changed, 574 insertions(+)

diff --git a/#test.el# b/#test.el#
new file mode 100644
index 0000000000..b689ddf3a8
--- /dev/null
+++ b/#test.el#
@@ -0,0 +1,14 @@
+(load-library "~/src/emacs-module-postgres/pq.so")
+(setq con (pq:connectdb "port=5433 dbname=smith"))
+(setq result (pq:exec con "select version()"))
+(pq:ntuples result)
+(pq:nfields result)
+(pq:getvalue result 0 0)
+(setq result (pq:exec con "select version(),now()"))
+(pq:getvalue result 0 1)
+(pq:getvalue (pq:execParams con "select 'Hello, ' || $1::text" 
(user-login-name)) 0 0)
+(pq:escapeLiteral con "moo'oo")
+(pq:exec con (concat "set application_name to " (pq:escapeLiteral con 
(emacs-version))))
+(setq con nil)
+(pq:escapeLiteral con "moo'oo")
+(garbage-collect)
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000000..1b412527b0
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,8 @@
+
+CFLAGS = -I$(HOME)/ext/emacs/src/  -I /usr/include/postgresql/
+LDFLAGS =  -lpq
+pq.so : pq.c
+       gcc -g -O3 -shared $(CFLAGS) -Wall -Werror $(LDFLAGS)  $< -o $@
+
+clean:
+       rm -f pq.so
diff --git a/README.org b/README.org
new file mode 100644
index 0000000000..44405e7721
--- /dev/null
+++ b/README.org
@@ -0,0 +1,9 @@
+A quick and dirty Emacs module for accessing postgres via libpq.
+
+Work-in-progress.  It doesn't expose many libpq features yet, but
+what's there should be crash-safe no matter what you do in the lisp
+world.  If you make it crash, please report.
+
+See [[./test.el]] for implemented functions.
+
+
diff --git a/pg_type.h b/pg_type.h
new file mode 100644
index 0000000000..79daedaf17
--- /dev/null
+++ b/pg_type.h
@@ -0,0 +1,61 @@
+/*-------------------------------------------------------------------------
+ *
+ * pg_type.h
+ *       Hard-wired knowledge about some standard type OIDs.
+ *
+ * XXX keep this in sync with src/include/catalog/pg_type.h
+ *
+ * Portions Copyright (c) 1996-2016, PostgreSQL Global Development Group
+ * Portions Copyright (c) 1994, Regents of the University of California
+ *
+ * src/interfaces/ecpg/ecpglib/pg_type.h
+ *
+ *-------------------------------------------------------------------------
+ */
+#ifndef PG_TYPE_H
+#define PG_TYPE_H
+
+#define BOOLOID                        16
+#define BYTEAOID               17
+#define CHAROID                        18
+#define NAMEOID                        19
+#define INT8OID                        20
+#define INT2OID                        21
+#define INT2VECTOROID  22
+#define INT4OID                        23
+#define REGPROCOID             24
+#define TEXTOID                        25
+#define OIDOID                 26
+#define TIDOID         27
+#define XIDOID 28
+#define CIDOID 29
+#define OIDVECTOROID   30
+#define POINTOID               600
+#define LSEGOID                        601
+#define PATHOID                        602
+#define BOXOID                 603
+#define POLYGONOID             604
+#define LINEOID                        628
+#define FLOAT4OID 700
+#define FLOAT8OID 701
+#define ABSTIMEOID             702
+#define RELTIMEOID             703
+#define TINTERVALOID   704
+#define UNKNOWNOID             705
+#define CIRCLEOID              718
+#define CASHOID 790
+#define INETOID 869
+#define CIDROID 650
+#define BPCHAROID              1042
+#define VARCHAROID             1043
+#define DATEOID                        1082
+#define TIMEOID                        1083
+#define TIMESTAMPOID   1114
+#define TIMESTAMPTZOID 1184
+#define INTERVALOID            1186
+#define TIMETZOID              1266
+#define ZPBITOID        1560
+#define VARBITOID        1562
+#define NUMERICOID             1700
+
+#endif   /* PG_TYPE_H */
diff --git a/pq.c b/pq.c
new file mode 100644
index 0000000000..0418bb3944
--- /dev/null
+++ b/pq.c
@@ -0,0 +1,469 @@
+#include <emacs-module.h>
+#include <libpq-fe.h>
+#include "pg_type.h"
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#define MAX_PARAMS 12
+
+void *plugin_is_GPL_compatible;
+
+static struct emacs_runtime *ert;
+static emacs_env *env;
+
+static emacs_value Qnil;
+static emacs_value Qt;
+static emacs_value Qpq_error;
+
+/* We pass different kinds of libpq pointers to lisp.  We wrap them up
+   with type information so we don't crash if the user mixes them up. */
+struct pq_pointer {
+  enum pq_pointer_type {
+    type_conn,
+    type_res
+  } type;
+  union {
+    PGconn *conn;
+    PGresult *res;
+  } p;
+};
+
+void pq_finalize_pointer(void *user_ptr)
+{
+  struct pq_pointer *ptr = user_ptr;
+
+  /* Do libpq cleanup */
+  switch (ptr->type) {
+  case type_conn: {
+    PQfinish(ptr->p.conn);
+    fprintf(stderr, "PQfinish(%p)\n", ptr->p.conn);
+    break;
+  }
+  case type_res:
+    fprintf(stderr, "PQclear(%p)\n", ptr->p.res);
+    PQclear(ptr->p.res);
+    break;
+  }
+
+  /* Free our wrapper */
+  free(user_ptr);
+}
+
+/* Raise error unless a PGresult is ok. */
+bool result_ok(emacs_env *env, PGresult *res)
+{
+  int status = PQresultStatus(res);
+  switch (status) {
+  case PGRES_TUPLES_OK:
+  case PGRES_SINGLE_TUPLE:
+  case PGRES_COMMAND_OK:
+    return true;
+
+  case PGRES_FATAL_ERROR:
+  default:
+    {
+      char *errmsg = PQresultErrorMessage(res);
+/*       char *errmsg = PQresStatus(status); */
+      emacs_value errstring = env->make_string(env, errmsg, strlen(errmsg));
+
+      PQclear(res);
+      env->non_local_exit_signal(env, Qpq_error, errstring);
+    }
+    return false;
+  }
+}
+
+static char *my_string_to_c(emacs_env *env, emacs_value string)
+{
+  ptrdiff_t size;
+  env->copy_string_contents(env, string, 0, &size);
+  char *buf = malloc(size);
+  env->copy_string_contents(env, string, buf, &size);
+  return buf;
+}
+
+static emacs_value
+Fpq_connectdb (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  char *conninfo = my_string_to_c(env, args[0]);
+  PGconn *conn = PQconnectdb(conninfo);
+
+  char *errmsg = PQerrorMessage(conn);
+  if (strlen(errmsg)) {
+    emacs_value errstring = env->make_string(env, errmsg, strlen(errmsg));
+
+    env->non_local_exit_signal(env, Qpq_error, errstring);
+    free(conninfo);
+    PQfinish(conn);
+    return Qnil;
+  }
+  fprintf(stderr, "PQconnectdb(%s) -> %p\n", conninfo, conn);
+  free(conninfo);
+
+  struct pq_pointer *p = malloc(sizeof(struct pq_pointer));
+  p->type = type_conn;
+  p->p.conn = conn;
+  return env->make_user_ptr(env, pq_finalize_pointer, p);
+}
+
+static emacs_value
+Fpq_exec (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  assert(type_conn == arg0->type);
+
+  char *command = my_string_to_c(env, args[1]);
+  PGresult *res = PQexec(arg0->p.conn, command);
+  free(command);
+
+  if (!result_ok(env, res))
+    return Qnil;
+
+  struct pq_pointer *p = malloc(sizeof(struct pq_pointer));
+  p->type = type_res;
+  p->p.res = res;
+  return env->make_user_ptr(env, pq_finalize_pointer, p);
+}
+
+static emacs_value
+Fpq_execParams (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  assert(type_conn == arg0->type);
+
+  int nParams = nargs - 2;
+  const char *paramValues[nParams];
+
+  for (int i=0; i<nParams; i++)
+    paramValues[i] = my_string_to_c(env, args[2+i]);
+
+  char *command = my_string_to_c(env, args[1]);
+  PGresult *res = PQexecParams(arg0->p.conn, command, nParams,
+                              NULL, paramValues, NULL, NULL, 0);
+
+  for (int i=0; i<nParams; i++)
+    free((void *)paramValues[i]);
+
+  free(command);
+
+  if (!result_ok(env, res))
+    return Qnil;
+
+  struct pq_pointer *p = malloc(sizeof(struct pq_pointer));
+  p->type = type_res;
+  p->p.res = res;
+  return env->make_user_ptr(env, pq_finalize_pointer, p);
+}
+
+static emacs_value
+Fpq_prepare (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  assert(type_conn == arg0->type);
+
+  char *name = my_string_to_c(env, args[1]);
+  char *command = my_string_to_c(env, args[2]);
+
+  PGresult *res = PQprepare(arg0->p.conn, name, command, 0, 0);
+
+  free(name);
+  free(command);
+
+  if (!result_ok(env, res))
+    return Qnil;
+
+  return args[1];
+}
+
+static emacs_value
+Fpq_execPrepared (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  assert(type_conn == arg0->type);
+
+  char *name = my_string_to_c(env, args[1]);
+
+  int nParams = nargs - 2;
+  const char *paramValues[nParams];
+  for (int i=0; i<nParams; i++)
+    paramValues[i] = my_string_to_c(env, args[2+i]);
+
+  PGresult *res = PQexecParams(arg0->p.conn, name, nParams,
+                              NULL, paramValues, NULL, NULL, 0);
+
+  for (int i=0; i<nParams; i++)
+    free((void *)paramValues[i]);
+
+  if (!result_ok(env, res))
+    return Qnil;
+
+  struct pq_pointer *p = malloc(sizeof(struct pq_pointer));
+  p->type = type_res;
+  p->p.res = res;
+  return env->make_user_ptr(env, pq_finalize_pointer, p);
+}
+
+static emacs_value
+Fpq_ntuples (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  assert(type_res == arg0->type);
+  return env->make_integer(env, PQntuples(arg0->p.res));
+}
+
+static emacs_value
+Fpq_nfields (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  assert(type_res == arg0->type);
+  return env->make_integer(env, PQnfields(arg0->p.res));
+}
+
+static emacs_value
+Fpq_fname (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  int column = env->extract_integer(env, args[1]);
+  assert(type_res == arg0->type);
+  char *name = PQfname(arg0->p.res, column);
+  return env->make_string(env, name, strlen(name));
+}
+
+static emacs_value
+pq_getvalue_internal(emacs_env *env, PGresult *res, int row, int column)
+{
+  char *result = PQgetvalue(res, row, column);
+
+  switch(PQftype(res, column)) {
+  case INT2OID:
+  case INT4OID:
+      return env->make_integer(env, atol(result));
+  case FLOAT4OID:
+  case FLOAT8OID:
+  case NUMERICOID:
+    return env->make_float(env, atof(result));
+  default:
+    return env->make_string(env, result, strlen(result));
+  }
+}
+
+static emacs_value
+Fpq_getvalue(emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  int row = env->extract_integer(env, args[1]);
+  int column = env->extract_integer(env, args[2]);
+  assert(type_res == arg0->type);
+  if (PQgetisnull(arg0->p.res, row, column))
+    return Qnil;
+  return pq_getvalue_internal(env, arg0->p.res, row, column);
+}
+
+/* static emacs_value */
+/* Fpq_getrow(emacs_env *env, int nargs, emacs_value args[], void *data) */
+/* { */
+/*   struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]); */
+/*   int row = env->extract_integer(env, args[1]); */
+/*   assert(type_res == arg0->type); */
+/*   int nfields = PQnfields(arg0->p.res); */
+/*   emacs_value *values = malloc(nfields*sizeof(emacs_value)); */
+
+/*   for (int i = 0; i < nfields; i++) { */
+/*     values[i] = pq_getvalue_internal(env, arg0->p.res, row, i); */
+/*   } */
+
+/*   emacs_value Qvector = env->intern (env, "vector"); */
+/*   return env->funcall (env, Qvector, nfields, values); */
+/* } */
+
+static emacs_value
+Fpq_escape (emacs_env *env, int nargs, emacs_value args[], void *data)
+{
+  if (!env->is_not_nil(env, args[0]))
+    return Qnil;
+  struct pq_pointer *arg0 = env->get_user_ptr(env, args[0]);
+  assert(type_conn == arg0->type);
+
+  char *value = my_string_to_c(env, args[1]);
+  char *(*escaper)(PGconn *, const char *, size_t) = data;
+  char *quoted = escaper(arg0->p.conn, value, strlen(value));
+  emacs_value result = env->make_string(env, quoted, strlen(quoted));
+  PQfreemem(quoted);
+  return result;
+}
+
+/* Bind NAME to FUN.  */
+static void
+bind_function (const char *name, emacs_value Sfun)
+{
+  /* Set the function cell of the symbol named NAME to SFUN using
+     the 'fset' function.  */
+
+  /* Convert the strings to symbols by interning them */
+  emacs_value Qfset = env->intern (env, "fset");
+  emacs_value Qsym = env->intern (env, name);
+
+  /* Prepare the arguments array */
+  emacs_value args[] = { Qsym, Sfun };
+
+  /* Make the call (2 == nb of arguments) */
+  env->funcall (env, Qfset, 2, args);
+}
+
+/* Provide FEATURE to Emacs.  */
+static void
+provide (const char *feature)
+{
+  /* call 'provide' with FEATURE converted to a symbol */
+
+  emacs_value Qfeat = env->intern (env, feature);
+  emacs_value Qprovide = env->intern (env, "provide");
+  emacs_value args[] = { Qfeat };
+
+  env->funcall (env, Qprovide, 1, args);
+}
+
+int
+emacs_module_init (struct emacs_runtime *init_ert)
+{
+  ert = init_ert;
+  env = ert->get_environment(ert);
+
+  emacs_value fun1 = env->make_function (env,
+              1,            /* min. number of arguments */
+              1,            /* max. number of arguments */
+              Fpq_connectdb,  /* actual function pointer */
+              "Connect to PostgreSQL database described by CONNSTR.",        
/* docstring */
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:connectdb", fun1);
+
+  emacs_value fun2 = env->make_function (env,
+              2,            /* min. number of arguments */
+              2,            /* max. number of arguments */
+              Fpq_exec,  /* actual function pointer */
+              "Execute STATEMENT using CONNECTION.",        /* docstring */
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:exec", fun2);
+
+  emacs_value fun3 = env->make_function (env,
+              1,            /* min. number of arguments */
+              1,            /* max. number of arguments */
+              Fpq_ntuples,  /* actual function pointer */
+              "Return number of rows in result.",        /* docstring */
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:ntuples", fun3);
+
+  emacs_value fun4 = env->make_function (env,
+              1,            /* min. number of arguments */
+              1,            /* max. number of arguments */
+              Fpq_nfields,  /* actual function pointer */
+              "Return number of fields in rows of result.",        /* 
docstring */
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:nfields", fun4);
+
+  emacs_value fun5 = env->make_function (env,
+              2,            /* min. number of arguments */
+              2,            /* max. number of arguments */
+              Fpq_fname,  /* actual function pointer */
+              "Return name in RESULT of column NUMBER.",        /* docstring */
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:fname", fun5);
+
+  emacs_value fun6 = env->make_function (env,
+              3,            /* min. number of arguments */
+              3,            /* max. number of arguments */
+              Fpq_getvalue,  /* actual function pointer */
+              "Return value for RESULT at ROW and COLUMN",        /* docstring 
*/
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:getvalue", fun6);
+
+  emacs_value fun7 = env->make_function (env,
+              2,            /* min. number of arguments */
+              2+MAX_PARAMS,  /* max. number of arguments */
+              Fpq_execParams,  /* actual function pointer */
+              "Return value for RESULT at ROW and COLUMN",        /* docstring 
*/
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:execParams", fun7);
+
+  emacs_value fun8 = env->make_function (env,
+              3,            /* min. number of arguments */
+              3,  /* max. number of arguments */
+              Fpq_prepare,  /* actual function pointer */
+              "Prepare statement NAME with STATEMENT ",        /* docstring */
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:prepare", fun8);
+
+  emacs_value fun9 = env->make_function (env,
+              2,            /* min. number of arguments */
+              2+MAX_PARAMS,  /* max. number of arguments */
+              Fpq_execPrepared,  /* actual function pointer */
+              "Execute prepared statement NAME with ARGS...",        /* 
docstring */
+              NULL          /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:execPrepared", fun9);
+
+    emacs_value fun10 = env->make_function (env,
+              2,            /* min. number of arguments */
+              2+MAX_PARAMS,  /* max. number of arguments */
+              Fpq_escape,  /* actual function pointer */
+              "Perform literal value quoting on STRING for CONN.",        /* 
docstring */
+              PQescapeLiteral /* user pointer of your choice (data param in 
Fmymod_test) */
+  );
+  bind_function("pq:escapeLiteral", fun10);
+
+  emacs_value fun11 = env->make_function (env,
+              2,            /* min. number of arguments */
+              2+MAX_PARAMS,  /* max. number of arguments */
+              Fpq_escape,  /* actual function pointer */
+              "Perform identifier quoting on STRING for CONN.",        /* 
docstring */
+              PQescapeIdentifier  /* user pointer of your choice (data param 
in Fmymod_test) */
+  );
+  bind_function("pq:escapeIdentifier", fun11);
+
+/*   emacs_value fun12 = env->make_function (env, */
+/*               2,            /\* min. number of arguments *\/ */
+/*               2,  /\* max. number of arguments *\/ */
+/*               Fpq_getrow,  /\* actual function pointer *\/ */
+/*               "Fetch ROW from RESULT as a vector.",        /\* docstring 
*\/ */
+/*               PQescapeIdentifier  /\* user pointer of your choice (data 
param in Fmymod_test) *\/ */
+/*   ); */
+/*   bind_function("pq:getrow", fun12); */
+
+  Qnil = env->intern (env, "nil");
+  Qt = env->intern (env, "t");
+  Qpq_error = env->intern (env, "pq:error");
+
+  provide("pq");
+
+  /* loaded successfully */
+  return 0;
+}
diff --git a/test.el b/test.el
new file mode 100644
index 0000000000..4f3c08387b
--- /dev/null
+++ b/test.el
@@ -0,0 +1,13 @@
+(load-library "~/src/emacs-module-postgres/pq.so")
+(setq con (pq:connectdb "port=5433 dbname=smith"))
+(setq result (pq:exec con "select version()"))
+(pq:ntuples result)
+(pq:nfields result)
+(pq:getvalue result 0 0)
+(setq result (pq:exec con "select version(),now()"))
+(pq:getvalue result 0 1)
+(pq:getvalue (pq:execParams con "select 'Hello, ' || $1::text" 
(user-login-name)) 0 0)
+(pq:escapeLiteral con "moo'oo")
+(pq:exec con (concat "set application_name to " (pq:escapeLiteral con 
(emacs-version))))
+(setq con nil)
+(garbage-collect)