update.
[chise/xemacs-chise.git.1] / src / postgresql.c
1 /*
2   postgresql.c -- Emacs Lisp binding to libpq.so
3   Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
4   Licensed to the Free Software Foundation.
5
6   Author:  SL Baur <steve@xemacs.org>
7   Maintainer:  SL Baur <steve@xemacs.org>
8
9 Please send patches to this file to me first before submitting them to
10 xemacs-patches.
11
12
13 KNOWN PROBLEMS (Last update 15-March-2000)
14 +  None.
15
16 Implementation notes:
17 0. Supported PostgreSQL versions
18    This code was developed against libpq-6.5.3 and libpq-7.0-beta1.  Earlier
19    versions may work.  V7 support is more complete than V6.5 support.
20 1. Mule
21    Non-ASCII databases have been tested on both 6.5 and 7.0.
22 2. Asynchronous Operation
23    Starting with libpq-7.0, an asynchronous interface is offered.  This
24    binding supports the asynchronous calls to a limited extent.  Since the
25    XEmacs 21.2 core does not support a sensible interface to add managed but
26    unreadable (by XEmacs) file descriptors to the main select code, polling
27    is required to drive the asynchronous calls.  XtAppAddInput would work
28    fine, but we want to be able to use the database when running strictly in
29    tty mode.
30 3. Completeness
31    Various calls have been deliberately not exported to Lisp.  The
32    unexported calls are either left-over backwards compatibility code that
33    aren't needed, calls that cannot be implemented sensibly, or calls that
34    cannot be implemented safely.  A list of all global functions in libpq
35    but not exported to Lisp is below.
36 4. Policy
37    This interface tries very hard to not set any policy towards how database
38    code in Emacs Lisp will be written.
39 5. Documentation
40    For full lisp programming documentation, see the XEmacs Lisp Reference
41    Manual.  For PostgreSQL documentation, see the PostgreSQL distribution.
42
43 TODO (in rough order of priority):
44 1. Asynchronous notifies need to be implemented to the extent they can be.
45 2. The large object interface needs work with Emacs buffers in addition
46    to files.  Need two functions buffer->large_object, and large_object->
47    buffer.
48 */
49
50 /*
51   Unimplemented functions: [TODO]
52   PQsetNoticeProcessor
53
54   Implemented, but undocumented functions: [TODO]
55   PQgetline (copy in/out)
56   PQputline (copy in/out)
57   PQgetlineAsync (copy in/out Asynch.)
58   PQputnbytes (copy in/out Asynch.)
59   PQendcopy (copy in/out)
60
61   Unsupported functions:
62   PQsetdbLogin -- This function is deprecated, has a subset of the
63    functionality of PQconnectdb, and is better done in Lisp.
64   PQsetdb -- Same as for PQsetdbLogin
65   PQsocket -- Abstraction error, file descriptors should not be leaked
66    into Lisp code
67   PQprint -- print to a file descriptor, deprecated, better done in Lisp
68   PQdisplayTuples -- deprecated
69   PQprintTuples -- really, really deprecated
70   PQmblen -- Returns the length in bytes of multibyte character encoded
71    string.
72   PQtrace -- controls debug print tracing to a tty.
73   PQuntrace -- Ditto.  I don't see any way to do this sensibly.
74   PQoidStatus -- deprecated and nearly identical to PQoidValue
75   PQfn -- "Fast path" interface
76   lo_open (large object) [*]
77   lo_close (large object) [*]
78   lo_read (large object) [*]
79   lo_write (large object) [*]
80   lo_lseek (large object) [*]
81   lo_creat (large object) [*]
82   lo_tell (large object) [*]
83   lo_unlink (large object) [*]
84 */
85
86 #include <config.h>
87
88 /* This must be portable with XEmacs 21.1 so long as it is the official
89    released version of XEmacs and provides the basis of InfoDock.  The
90    interface to lcrecord handling has changed with 21.2, so unfortunately
91    we will need a few snippets of backwards compatibility code.
92 */
93 #if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION < 2)
94 #define RUNNING_XEMACS_21_1 1
95 #endif
96
97 /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */
98
99 #include "lisp.h"
100 #include "sysdep.h"
101 #include "buffer.h"
102 #include "postgresql.h"
103
104 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */
105 #define PG_OS_CODING FORMAT_FILENAME
106 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to)
107 #else
108 #ifdef MULE
109 #define PG_OS_CODING Fget_coding_system(Vpg_coding_system)
110 #else
111 #define PG_OS_CODING Qnative
112 #endif
113 Lisp_Object Vpg_coding_system;
114 #endif
115
116 #define CHECK_LIVE_CONNECTION(P) { \
117         if (!P || (PQstatus (P) != CONNECTION_OK)) { \
118                 char *e = "bad value"; \
119                 if (P) e = PQerrorMessage (P); \
120                 error ("dead connection [%s]", e); \
121         } }
122 #define PUKE_IF_NULL(p) { \
123         if (!p) error ("bad value"); \
124         }
125
126 static Lisp_Object VXPGHOST;
127 static Lisp_Object VXPGUSER;
128 static Lisp_Object VXPGOPTIONS;
129 static Lisp_Object VXPGPORT;
130 static Lisp_Object VXPGTTY; /* This needs to be blanked! */
131 static Lisp_Object VXPGDATABASE;
132 static Lisp_Object VXPGREALM;
133 #ifdef MULE
134 static Lisp_Object VXPGCLIENTENCODING;
135 #endif /* MULE */
136
137 /* Other variables:
138    PGAUTHTYPE -- not used after PostgreSQL 6.5
139    PGGEQO
140    PGCOSTINDEX
141    PGCOSTHEAP
142    PGTZ
143    PGDATESTYLE
144 */
145 #ifndef HAVE_POSTGRESQLV7
146 static Lisp_Object VXPGAUTHTYPE;
147 #endif
148 static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE;
149
150 static Lisp_Object Qpostgresql;
151 static Lisp_Object Qpg_connection_ok, Qpg_connection_bad;
152 static Lisp_Object Qpg_connection_started, Qpg_connection_made;
153 static Lisp_Object Qpg_connection_awaiting_response, Qpg_connection_auth_ok;
154 static Lisp_Object Qpg_connection_setenv;
155
156 static Lisp_Object Qpqdb, Qpquser, Qpqpass, Qpqhost, Qpqport, Qpqtty;
157 static Lisp_Object Qpqoptions, Qpqstatus, Qpqerrormessage, Qpqbackendpid;
158
159 static Lisp_Object Qpgres_empty_query, Qpgres_command_ok, Qpgres_tuples_ok;
160 static Lisp_Object Qpgres_copy_out, Qpgres_copy_in, Qpgres_bad_response;
161 static Lisp_Object Qpgres_nonfatal_error, Qpgres_fatal_error;
162
163 static Lisp_Object Qpgres_polling_failed, Qpgres_polling_reading;
164 static Lisp_Object Qpgres_polling_writing, Qpgres_polling_ok;
165 static Lisp_Object Qpgres_polling_active;
166 /****/
167
168 /* PGconn is an opaque object and we need to be able to store them in
169    Lisp code because libpq supports multiple connections.
170 */
171 Lisp_Object Qpgconnp;
172
173 static Lisp_Object
174 make_pgconn (Lisp_PGconn *pgconn)
175 {
176   Lisp_Object lisp_pgconn;
177   XSETPGCONN (lisp_pgconn, pgconn);
178   return lisp_pgconn;
179 }
180
181 static Lisp_Object
182 #ifdef RUNNING_XEMACS_21_1
183 mark_pgconn (Lisp_Object obj, void (*markobj) (Lisp_Object))
184 #else
185 mark_pgconn (Lisp_Object obj)
186 #endif
187 {
188   return Qnil;
189 }
190
191 static void
192 print_pgconn (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
193 {
194   char buf[256];
195   PGconn *P;
196   ConnStatusType cst;
197   char *host="", *db="", *user="", *port="";
198
199   P = (XPGCONN (obj))->pgconn;
200
201   if (!P) /* this may happen since we allow PQfinish() to be called */
202     strcpy (buf, "#<PGconn DEAD>"); /* evil! */
203   else if ((cst = PQstatus (P)) == CONNECTION_OK)
204     {
205       if (!(host = PQhost (P)))
206         host = "";
207       port = PQport (P);
208       db = PQdb (P);
209       if (!(user = PQuser (P)))
210         user = "";
211       sprintf (buf, "#<PGconn %s:%s %s/%s>", /* evil! */
212               !strlen (host) ? "localhost" : host,
213               port,
214               user,
215               db);
216     }
217   else if (cst == CONNECTION_BAD)
218     strcpy (buf, "#<PGconn BAD>"); /* evil! */
219   else
220     strcpy (buf, "#<PGconn connecting>"); /* evil! */
221
222   if (print_readably)
223     error ("printing unreadable object %s", buf);
224   else
225     write_c_string (buf, printcharfun);
226 }
227
228 static Lisp_PGconn *
229 allocate_pgconn (void)
230 {
231 #ifdef RUNNING_XEMACS_21_1
232   Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn,
233                                              lrecord_pgconn);
234 #else
235   Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn,
236                                              &lrecord_pgconn);
237 #endif
238   pgconn->pgconn = (PGconn *)NULL;
239   return pgconn;
240 }
241
242 static void
243 finalize_pgconn (void *header, int for_disksave)
244 {
245   Lisp_PGconn *pgconn = (Lisp_PGconn *)header;
246
247   if (for_disksave)
248     signal_simple_error ("Can't dump an emacs containing PGconn objects",
249                          make_pgconn (pgconn));
250
251   if (pgconn->pgconn)
252     {
253       PQfinish (pgconn->pgconn);
254       pgconn->pgconn = (PGconn *)NULL;
255     }
256 }
257
258 #ifdef RUNNING_XEMACS_21_1
259 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
260                                mark_pgconn, print_pgconn, finalize_pgconn,
261                                NULL, NULL,
262                                Lisp_PGconn);
263 #else
264 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
265                                mark_pgconn, print_pgconn, finalize_pgconn,
266                                NULL, NULL,
267                                0,
268                                Lisp_PGconn);
269 #endif
270 /****/
271
272 /* PGresult is an opaque object and we need to be able to store them in
273    Lisp code.
274 */
275 Lisp_Object Qpgresultp;
276
277 static Lisp_Object
278 make_pgresult (Lisp_PGresult *pgresult)
279 {
280   Lisp_Object lisp_pgresult;
281   XSETPGRESULT (lisp_pgresult, pgresult);
282   return lisp_pgresult;
283 }
284
285 static Lisp_Object
286 #ifdef RUNNING_XEMACS_21_1
287 mark_pgresult (Lisp_Object obj, void (*markobj) (Lisp_Object))
288 #else
289 mark_pgresult (Lisp_Object obj)
290 #endif
291 {
292   return Qnil;
293 }
294
295 #define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>"
296 #define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>"
297 #define RESULT_DEFAULT_FMT "#<PGresult %s - %s>"
298 static void
299 print_pgresult (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
300 {
301   char buf[1024];
302   PGresult *res;
303
304   res = (XPGRESULT (obj))->pgresult;
305
306   if (res)
307     {
308       switch (PQresultStatus (res))
309         {
310         case PGRES_TUPLES_OK:
311           /* Add number of tuples of result to output */
312           sprintf (buf, RESULT_TUPLES_FMT, /* evil! */
313                    PQresStatus (PQresultStatus (res)),
314                    PQntuples (res),
315                    PQcmdStatus (res));
316           break;
317         case PGRES_COMMAND_OK:
318           /* Add number of tuples affected by output-less command */
319           if (!strlen (PQcmdTuples (res))) goto notuples;
320           sprintf (buf, RESULT_CMD_TUPLES_FMT, /* evil! */
321                    PQresStatus (PQresultStatus (res)),
322                    PQcmdTuples (res),
323                    PQcmdStatus (res));
324           break;
325         default:
326 notuples:
327           /* No counts to print */
328           sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */
329                    PQresStatus (PQresultStatus (res)),
330                    PQcmdStatus (res));
331           break;
332         }
333     }
334   else
335     strcpy (buf, "#<PGresult DEAD>"); /* evil! */
336
337   if (print_readably)
338     error ("printing unreadable object %s", buf);
339   else
340     write_c_string (buf, printcharfun);
341 }
342
343 #undef RESULT_TUPLES_FMT
344 #undef RESULT_CMD_TUPLES_FMT
345 #undef RESULT_DEFAULT_FMT
346
347 static Lisp_PGresult *
348 allocate_pgresult (void)
349 {
350 #ifdef RUNNING_XEMACS_21_1
351   Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult,
352                                                  lrecord_pgresult);
353 #else
354   Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult,
355                                                  &lrecord_pgresult);
356 #endif
357   pgresult->pgresult = (PGresult *)NULL;
358   return pgresult;
359 }
360
361 static void
362 finalize_pgresult (void *header, int for_disksave)
363 {
364   Lisp_PGresult *pgresult = (Lisp_PGresult *)header;
365
366   if (for_disksave)
367     signal_simple_error ("Can't dump an emacs containing PGresult objects",
368                          make_pgresult (pgresult));
369
370   if (pgresult->pgresult)
371     {
372       PQclear (pgresult->pgresult);
373       pgresult->pgresult = (PGresult *)NULL;
374     }
375 }
376
377 #ifdef RUNNING_XEMACS_21_1
378 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
379                                mark_pgresult, print_pgresult, finalize_pgresult,
380                                NULL, NULL,
381                                Lisp_PGresult);
382 #else
383 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
384                                mark_pgresult, print_pgresult, finalize_pgresult,
385                                NULL, NULL,
386                                0,
387                                Lisp_PGresult);
388 #endif
389
390 /***********************/
391
392 /* notices */
393 static void
394 xemacs_notice_processor (void *arg, const char *msg)
395 {
396   warn_when_safe (Qpostgresql, Qnotice, "%s", msg);
397 }
398
399 /* There are four ways (as of PostgreSQL v7) to connect to a database.
400    Two of them, PQsetdb and PQsetdbLogin, are deprecated.  Both of those
401    routines take a number of positional parameters and are better done in Lisp.
402    Note that PQconnectStart does not exist prior to v7.
403 */
404
405 DEFUN ("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /*
406 Return a connection default structure.
407 */
408        ())
409 {
410   /* This function can GC */
411   PQconninfoOption *pcio;
412   Lisp_Object temp, temp1;
413   int i;
414
415   pcio = PQconndefaults();
416   if (!pcio) return Qnil; /* can never happen in libpq-7.0 */
417   temp = list1 (Fcons (build_ext_string (pcio[0].keyword, PG_OS_CODING),
418                        Fcons (build_ext_string (pcio[0].envvar, PG_OS_CODING),
419                               Fcons (build_ext_string (pcio[0].compiled, PG_OS_CODING),
420                                      Fcons (build_ext_string (pcio[0].val, PG_OS_CODING),
421                                             Fcons (build_ext_string (pcio[0].label, PG_OS_CODING),
422                                                    Fcons (build_ext_string (pcio[0].dispchar, PG_OS_CODING),
423                                                           Fcons (make_int (pcio[0].dispsize), Qnil))))))));
424
425   for (i = 1; pcio[i].keyword; i++)
426     {
427       temp1 = list1 (Fcons (build_ext_string (pcio[i].keyword, PG_OS_CODING),
428                             Fcons (build_ext_string (pcio[i].envvar, PG_OS_CODING),
429                                    Fcons (build_ext_string (pcio[i].compiled, PG_OS_CODING),
430                                           Fcons (build_ext_string (pcio[i].val, PG_OS_CODING),
431                                                  Fcons (build_ext_string (pcio[i].label, PG_OS_CODING),
432                                                         Fcons (build_ext_string (pcio[i].dispchar, PG_OS_CODING),
433                                                                Fcons (make_int (pcio[i].dispsize), Qnil))))))));
434       {
435         Lisp_Object args[2];
436         args[0] = temp;
437         args[1] = temp1;
438         /* Fappend GCPROs its arguments */
439         temp = Fappend (2, args);
440       }
441     }
442
443   return temp;
444 }
445
446 /* PQconnectdb Makes a new connection to a backend.
447 PGconn *PQconnectdb(const char *conninfo)
448 */
449
450 DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /*
451 Make a new connection to a PostgreSQL backend.
452 */
453         (conninfo))
454 {
455   PGconn *P;
456   Lisp_PGconn *lisp_pgconn;
457   char *error_message = "Out of Memory?";
458   char *c_conninfo;
459
460   CHECK_STRING (conninfo);
461
462   TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
463                      C_STRING_ALLOCA, c_conninfo, Qnative);
464   P = PQconnectdb (c_conninfo);
465   if (P && (PQstatus (P) == CONNECTION_OK))
466     {
467       (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
468       lisp_pgconn = allocate_pgconn();
469       lisp_pgconn->pgconn = P;
470       return make_pgconn (lisp_pgconn);
471     }
472   else
473     {
474       /* Connection failed.  Destroy the connection and signal an error. */
475       char buf[BLCKSZ];
476       strcpy (buf, error_message);
477       if (P)
478         {
479           /* storage for the error message gets erased when call PQfinish */
480           /* so we must temporarily stash it somewhere */
481           strncpy (buf, PQerrorMessage (P), sizeof (buf));
482           buf[sizeof (buf) - 1] = '\0';
483           PQfinish (P);
484         }
485       error ("libpq: %s", buf);
486     }
487 }
488
489 /* PQconnectStart Makes a new asynchronous connection to a backend.
490 PGconn *PQconnectStart(const char *conninfo)
491 */
492
493 #ifdef HAVE_POSTGRESQLV7
494 DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /*
495 Make a new asynchronous connection to a PostgreSQL backend.
496 */
497         (conninfo))
498 {
499   PGconn *P;
500   Lisp_PGconn *lisp_pgconn;
501   char *error_message = "Out of Memory?";
502   char *c_conninfo;
503
504   CHECK_STRING (conninfo);
505   TO_EXTERNAL_FORMAT (LISP_STRING, conninfo,
506                       C_STRING_ALLOCA, c_conninfo, Qnative);
507   P = PQconnectStart (c_conninfo);
508
509   if (P && (PQstatus (P) != CONNECTION_BAD))
510     {
511       (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
512       lisp_pgconn = allocate_pgconn();
513       lisp_pgconn->pgconn = P;
514
515       return make_pgconn (lisp_pgconn);
516     }
517   else
518     {
519       /* capture the error message before destroying the object */
520       char buf[BLCKSZ];
521       strcpy (buf, error_message);
522       if (P)
523         {
524           strncpy (buf, PQerrorMessage (P), sizeof (buf));
525           buf[sizeof (buf) - 1] = '\0';
526           PQfinish (P);
527         }
528       error ("libpq: %s", buf);
529     }
530 }
531
532 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
533 Poll an asynchronous connection for completion
534 */
535         (conn))
536 {
537   PGconn *P;
538   PostgresPollingStatusType polling_status;
539
540   CHECK_PGCONN (conn);
541
542   P = (XPGCONN (conn))->pgconn;
543   CHECK_LIVE_CONNECTION (P);
544
545   polling_status = PQconnectPoll (P);
546   switch (polling_status)
547     {
548     case PGRES_POLLING_FAILED:
549       /* Something Bad has happened */
550       {
551         char *e = PQerrorMessage (P);
552         error ("libpq: %s", e);
553       }
554     case PGRES_POLLING_OK:
555       return Qpgres_polling_ok;
556     case PGRES_POLLING_READING:
557       return Qpgres_polling_reading;
558     case PGRES_POLLING_WRITING:
559       return Qpgres_polling_writing;
560     case PGRES_POLLING_ACTIVE:
561       return Qpgres_polling_active;
562     default:
563       /* they've added a new field we don't know about */
564       error ("Help!  Unknown status code %08x from backend!", polling_status);
565     }
566 }
567
568 #ifdef MULE
569 DEFUN ("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /*
570 Return client coding system.
571 */
572        (conn))
573 {
574   PGconn *P;
575
576   CHECK_PGCONN (conn);
577   P = (XPGCONN (conn))->pgconn;
578   CHECK_LIVE_CONNECTION (P);
579
580   return make_int (PQclientEncoding (P));
581 }
582
583 DEFUN ("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /*
584 Set client coding system.
585 */
586        (conn, encoding))
587 {
588   PGconn *P;
589   int rc;
590   char *c_encoding;
591
592   CHECK_PGCONN (conn);
593   CHECK_STRING (encoding);
594
595   P = (XPGCONN (conn))->pgconn;
596   CHECK_LIVE_CONNECTION (P);
597
598   TO_EXTERNAL_FORMAT (LISP_STRING, encoding,
599                       C_STRING_ALLOCA, c_encoding, Qnative);
600
601   if ((rc = PQsetClientEncoding (P, c_encoding)) < 0)
602     error ("bad encoding");
603   else
604     return make_int (rc);
605 }
606
607 #endif
608 #endif /* HAVE_POSTGRESQLV7 */
609
610 /* PQfinish Close the connection to the backend. Also frees memory
611        used by the PGconn object.
612 void PQfinish(PGconn *conn)
613 */
614 DEFUN ("pq-finish", Fpq_finish, 1, 1, 0, /*
615 Close the connection to the backend.
616 */
617         (conn))
618 {
619   PGconn *P;
620
621   CHECK_PGCONN (conn);
622   P = (XPGCONN (conn))->pgconn;
623   PUKE_IF_NULL (P);
624
625   PQfinish (P);
626   /* #### PQfinish deallocates the PGconn structure, so we now have a
627      dangling pointer. */
628   /* Genocided all @'s ... */
629   (XPGCONN (conn))->pgconn = (PGconn *)NULL; /* You feel DEAD inside */
630   return Qnil;
631 }
632
633 DEFUN ("pq-clear", Fpq_clear, 1, 1, 0, /*
634 Forcibly erase a PGresult object.
635 */
636        (res))
637 {
638   PGresult *R;
639
640   CHECK_PGRESULT (res);
641   R = (XPGRESULT (res))->pgresult;
642   PUKE_IF_NULL (R);
643
644   PQclear (R);
645   /* Genocided all @'s ... */
646   (XPGRESULT (res))->pgresult = (PGresult *)NULL; /* You feel DEAD inside */
647
648   return Qnil;
649 }
650
651 DEFUN ("pq-is-busy", Fpq_is_busy, 1, 1, 0, /*
652 Return t if PQgetResult would block waiting for input.
653 */
654         (conn))
655 {
656   PGconn *P;
657
658   CHECK_PGCONN (conn);
659   P = (XPGCONN (conn))->pgconn;
660   CHECK_LIVE_CONNECTION (P);
661
662   return PQisBusy (P) ? Qt : Qnil;
663 }
664
665 DEFUN ("pq-consume-input", Fpq_consume_input, 1, 1, 0, /*
666 Consume any available input from the backend.
667 Returns nil if something bad happened.
668 */
669         (conn))
670 {
671   PGconn *P;
672
673   CHECK_PGCONN (conn);
674   P = (XPGCONN (conn))->pgconn;
675   CHECK_LIVE_CONNECTION (P);
676
677   return PQconsumeInput (P) ? Qt : Qnil;
678 }
679
680 /* PQreset Reset the communication port with the backend.
681 void PQreset(PGconn *conn)
682 */
683 DEFUN ("pq-reset", Fpq_reset, 1, 1, 0, /*
684 Reset the connection to the backend.
685 This function will close the connection to the backend and attempt to
686 reestablish a new connection to the same postmaster, using all the same
687 parameters previously used.  This may be useful for error recovery if a
688 working connection is lost.
689 */
690         (conn))
691 {
692   PGconn *P;
693
694   CHECK_PGCONN (conn);
695   P = (XPGCONN (conn))->pgconn;
696   PUKE_IF_NULL (P);/* we can resurrect a BAD connection, but not a dead one. */
697
698   PQreset (P);
699
700   return Qnil;
701 }
702
703 #ifdef HAVE_POSTGRESQLV7
704 DEFUN ("pq-reset-start", Fpq_reset_start, 1, 1, 0, /*
705 Reset connection to the backend asynchronously.
706 */
707        (conn))
708 {
709   PGconn *P;
710
711   CHECK_PGCONN (conn);
712   P = (XPGCONN (conn))->pgconn;
713   CHECK_LIVE_CONNECTION (P);
714
715   if (PQresetStart (P)) return Qt;
716   {
717     char *e = PQerrorMessage (P);
718     error ("libpq: %s", e);
719   }
720 }
721
722 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
723 Poll an asynchronous reset for completion.
724 */
725         (conn))
726 {
727   PGconn *P;
728   PostgresPollingStatusType polling_status;
729
730   CHECK_PGCONN (conn);
731
732   P = (XPGCONN (conn))->pgconn;
733   CHECK_LIVE_CONNECTION (P);
734
735   polling_status = PQresetPoll (P);
736   switch (polling_status)
737     {
738     case PGRES_POLLING_FAILED:
739       /* Something Bad has happened */
740       {
741         char *e = PQerrorMessage (P);
742         error ("libpq: %s", e);
743       }
744     case PGRES_POLLING_OK:
745       return Qpgres_polling_ok;
746     case PGRES_POLLING_READING:
747       return Qpgres_polling_reading;
748     case PGRES_POLLING_WRITING:
749       return Qpgres_polling_writing;
750     case PGRES_POLLING_ACTIVE:
751       return Qpgres_polling_active;
752     default:
753       /* they've added a new field we don't know about */
754       error ("Help!  Unknown status code %08x from backend!", polling_status);
755     }
756 }
757 #endif
758
759 DEFUN ("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
760 Attempt to request cancellation of the current operation.
761
762 The return value is t if the cancel request was successfully
763 dispatched, nil if not (in which case conn->errorMessage is set).
764 Note: successful dispatch is no guarantee that there will be any effect at
765 the backend.  The application must read the operation result as usual.
766 */
767        (conn))
768 {
769   PGconn *P;
770
771   CHECK_PGCONN (conn);
772   P = (XPGCONN (conn))->pgconn;
773   CHECK_LIVE_CONNECTION (P);
774
775   return PQrequestCancel (P) ? Qt : Qnil;
776 }
777
778 /* accessor function for the PGconn object */
779 DEFUN ("pq-pgconn", Fpq_pgconn, 2, 2, 0, /*
780 Accessor function for the PGconn object.
781 Currently recognized symbols for the field:
782 pq::db            Database name
783 pq::user          Database user name
784 pq::pass          Database user's password
785 pq::host          Hostname of PostgreSQL backend connected to
786 pq::port          TCP port number of connection
787 pq::tty           Debugging TTY (not used in Emacs)
788 pq::options       Additional backend options
789 pq::status        Connection status (either OK or BAD)
790 pq::error-message Last error message from the backend
791 pq::backend-pid   Process ID of backend process
792 */
793         (conn, field))
794 {
795   PGconn *P;
796
797   CHECK_PGCONN (conn);
798   P = (XPGCONN (conn))->pgconn;
799   PUKE_IF_NULL (P); /* BAD connections still have state to query */
800
801   if (EQ(field, Qpqdb))
802     /* PQdb Returns the database name of the connection.
803        char *PQdb(PGconn *conn)
804      */
805     return build_ext_string (PQdb(P), PG_OS_CODING);
806   else if (EQ (field, Qpquser))
807     /* PQuser Returns the user name of the connection.
808        char *PQuser(PGconn *conn)
809      */
810     return build_ext_string (PQuser(P), PG_OS_CODING);
811   else if (EQ (field, Qpqpass))
812     /* PQpass Returns the password of the connection.
813        char *PQpass(PGconn *conn)
814      */
815     return build_ext_string (PQpass(P), PG_OS_CODING);
816   else if (EQ (field, Qpqhost))
817     /* PQhost Returns the server host name of the connection.
818        char *PQhost(PGconn *conn)
819      */
820     return build_ext_string (PQhost(P), PG_OS_CODING);
821   else if (EQ (field, Qpqport))
822     {
823       char *p;
824       /* PQport Returns the port of the connection.
825          char *PQport(PGconn *conn)
826        */
827       if ((p = PQport(P)))
828         return make_int(atoi(p));
829       else
830         return make_int(-1);
831     }
832   else if (EQ (field, Qpqtty))
833     /* PQtty Returns the debug tty of the connection.
834        char *PQtty(PGconn *conn)
835      */
836     return build_ext_string (PQtty(P), PG_OS_CODING);
837   else if (EQ (field, Qpqoptions))
838   /* PQoptions Returns the backend options used in the connection.
839      char *PQoptions(PGconn *conn)
840    */
841     return build_ext_string (PQoptions(P), PG_OS_CODING);
842   else if (EQ (field, Qpqstatus))
843     {
844       ConnStatusType cst;
845       /* PQstatus Returns the status of the connection. The status can be
846          CONNECTION_OK or CONNECTION_BAD.
847          ConnStatusType PQstatus(PGconn *conn)
848       */
849       switch ((cst = PQstatus (P)))
850         {
851         case CONNECTION_OK: return Qpg_connection_ok;
852         case CONNECTION_BAD: return Qpg_connection_bad;
853 #ifdef HAVE_POSTGRESQLV7
854         case CONNECTION_STARTED: return Qpg_connection_started;
855         case CONNECTION_MADE: return Qpg_connection_made;
856         case CONNECTION_AWAITING_RESPONSE: return Qpg_connection_awaiting_response;
857         case CONNECTION_AUTH_OK: return Qpg_connection_auth_ok;
858         case CONNECTION_SETENV: return Qpg_connection_setenv;
859 #endif /* HAVE_POSTGRESQLV7 */
860         default:
861           /* they've added a new field we don't know about */
862           error ("Help!  Unknown connection status code %08x from backend!", cst);
863         }
864     }
865   else if (EQ (field, Qpqerrormessage))
866     /* PQerrorMessage Returns the error message most recently generated
867        by an operation on the connection.
868        char *PQerrorMessage(PGconn* conn);
869      */
870     return build_ext_string (PQerrorMessage(P), PG_OS_CODING);
871   else if (EQ (field, Qpqbackendpid))
872     /* PQbackendPID Returns the process ID of the backend server handling
873        this connection.
874        int PQbackendPID(PGconn *conn);
875      */
876     return make_int (PQbackendPID(P));
877   else
878     error ("bad PGconn accessor");
879 }
880
881 /* Query functions */
882 DEFUN ("pq-exec", Fpq_exec, 2, 2, 0, /*
883 Submit a query to Postgres and wait for the result.
884 */
885         (conn, query))
886 {
887   PGconn *P;
888   Lisp_PGresult *lisp_pgresult;
889   PGresult *R;
890   char *c_query;
891
892   CHECK_PGCONN (conn);
893   CHECK_STRING (query);
894
895   P = (XPGCONN (conn))->pgconn;
896   CHECK_LIVE_CONNECTION (P);
897
898   TO_EXTERNAL_FORMAT (LISP_STRING, query,
899                       C_STRING_ALLOCA, c_query, Qnative);
900
901   R = PQexec (P, c_query);
902   {
903     char *tag, buf[BLCKSZ];
904
905     if (!R) error ("query: out of memory");
906     else
907       switch (PQresultStatus (R))
908         {
909         case PGRES_BAD_RESPONSE:
910           tag = "bad response [%s]";
911           goto err;
912         case PGRES_NONFATAL_ERROR:
913           tag = "non-fatal error [%s]";
914           goto err;
915         case PGRES_FATAL_ERROR:
916           tag = "fatal error [%s]";
917 err:
918           strncpy (buf, PQresultErrorMessage (R), sizeof (buf));
919           buf [sizeof (buf) - 1] = '\0';
920           PQclear (R);
921           error (tag, buf);
922           /*NOTREACHED*/
923         default:
924           break;
925         }
926   }
927
928   lisp_pgresult = allocate_pgresult ();
929   lisp_pgresult->pgresult = R;
930
931   return make_pgresult (lisp_pgresult);
932 }
933
934 DEFUN ("pq-send-query", Fpq_send_query, 2, 2, 0, /*
935 Submit a query to Postgres and don't wait for the result.
936 Returns: t if successfully submitted
937          nil if error (conn->errorMessage is set)
938 */
939         (conn, query))
940 {
941   PGconn *P;
942   char *c_query;
943
944   CHECK_PGCONN (conn);
945   CHECK_STRING (query);
946
947   P = (XPGCONN (conn))->pgconn;
948   CHECK_LIVE_CONNECTION (P);
949
950   TO_EXTERNAL_FORMAT (LISP_STRING, query,
951                       C_STRING_ALLOCA, c_query, Qnative);
952
953   if (PQsendQuery (P, c_query)) return Qt;
954   else error ("async query: %s", PQerrorMessage (P));
955 }
956
957 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /*
958 Retrieve an asynchronous result from a query.
959 NIL is returned when no more query work remains.
960 */
961         (conn))
962 {
963   PGconn *P;
964   Lisp_PGresult *lisp_pgresult;
965   PGresult *R;
966
967   CHECK_PGCONN (conn);
968
969   P = (XPGCONN (conn))->pgconn;
970   CHECK_LIVE_CONNECTION (P);
971
972   R = PQgetResult (P);
973   if (!R) return Qnil; /* not an error, there's no more data to get */
974
975   {
976     char *tag, buf[BLCKSZ];
977
978     switch (PQresultStatus (R))
979       {
980       case PGRES_BAD_RESPONSE:
981         tag = "bad response [%s]";
982         goto err;
983       case PGRES_NONFATAL_ERROR:
984         tag = "non-fatal error [%s]";
985         goto err;
986       case PGRES_FATAL_ERROR:
987         tag = "fatal error [%s]";
988 err:
989         strncpy (buf, PQresultErrorMessage (R), sizeof (buf));
990         buf[sizeof (buf) - 1] = '\0';
991         PQclear (R);
992         error (tag, buf);
993         /*NOTREACHED*/
994       default:
995         break;
996       }
997   }
998
999   lisp_pgresult = allocate_pgresult();
1000   lisp_pgresult->pgresult = R;
1001
1002   return make_pgresult (lisp_pgresult);
1003 }
1004
1005 DEFUN ("pq-result-status", Fpq_result_status, 1, 1, 0, /*
1006 Return result status of the query.
1007 */
1008         (result))
1009 {
1010   PGresult *R;
1011   ExecStatusType est;
1012
1013   CHECK_PGRESULT (result);
1014   R = (XPGRESULT (result))->pgresult;
1015   PUKE_IF_NULL (R);
1016
1017   switch ((est = PQresultStatus (R))) {
1018   case PGRES_EMPTY_QUERY: return Qpgres_empty_query;
1019   case PGRES_COMMAND_OK: return Qpgres_command_ok;
1020   case PGRES_TUPLES_OK: return Qpgres_tuples_ok;
1021   case PGRES_COPY_OUT: return Qpgres_copy_out;
1022   case PGRES_COPY_IN: return Qpgres_copy_in;
1023   case PGRES_BAD_RESPONSE: return Qpgres_bad_response;
1024   case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error;
1025   case PGRES_FATAL_ERROR: return Qpgres_fatal_error;
1026   default:
1027     /* they've added a new field we don't know about */
1028     error ("Help!  Unknown exec status code %08x from backend!", est);
1029   }
1030 }
1031
1032 DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /*
1033 Return stringified result status of the query.
1034 */
1035         (result))
1036 {
1037   PGresult *R;
1038
1039   CHECK_PGRESULT (result);
1040   R = (XPGRESULT (result))->pgresult;
1041   PUKE_IF_NULL (R);
1042
1043   return build_ext_string (PQresStatus (PQresultStatus (R)), PG_OS_CODING);
1044 }
1045
1046 /* Sundry PGresult accessor functions */
1047 DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /*
1048 Return last message associated with the query.
1049 */
1050         (result))
1051 {
1052   PGresult *R;
1053
1054   CHECK_PGRESULT (result);
1055   R = (XPGRESULT (result))->pgresult;
1056   PUKE_IF_NULL (R);
1057
1058   return build_ext_string (PQresultErrorMessage (R), PG_OS_CODING);
1059 }
1060
1061 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
1062 Return the number of tuples (instances) in the query result.
1063 */
1064         (result))
1065 {
1066   PGresult *R;
1067
1068   CHECK_PGRESULT (result);
1069   R = (XPGRESULT (result))->pgresult;
1070   PUKE_IF_NULL (R);
1071
1072   return make_int (PQntuples (R));
1073 }
1074
1075 DEFUN ("pq-nfields", Fpq_nfields, 1, 1, 0, /*
1076 Return the number of fields (attributes) in each tuple of the query result.
1077 */
1078         (result))
1079 {
1080   PGresult *R;
1081
1082   CHECK_PGRESULT (result);
1083   R = (XPGRESULT (result))->pgresult;
1084   PUKE_IF_NULL (R);
1085
1086   return make_int (PQnfields (R));
1087 }
1088
1089 DEFUN ("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /*
1090 Return t if the query result contains binary data, nil otherwise.
1091 */
1092         (result))
1093 {
1094   PGresult *R;
1095
1096   CHECK_PGRESULT (result);
1097   R = (XPGRESULT (result))->pgresult;
1098   PUKE_IF_NULL (R);
1099
1100   return (PQbinaryTuples (R)) ? Qt : Qnil;
1101 }
1102
1103 DEFUN ("pq-fname", Fpq_fname, 2, 2, 0, /*
1104 Return the field (attribute) name associated with the given field index.
1105 Field indices start at 0.
1106 */
1107         (result, field_index))
1108 {
1109   PGresult *R;
1110
1111   CHECK_PGRESULT (result);
1112   CHECK_INT (field_index);
1113   R = (XPGRESULT (result))->pgresult;
1114   PUKE_IF_NULL (R);
1115
1116   return build_ext_string (PQfname (R, XINT (field_index)), PG_OS_CODING);
1117 }
1118
1119 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
1120 Return the number of fields (attributes) in each tuple of the query result.
1121 */
1122         (result, field_name))
1123 {
1124   PGresult *R;
1125   char *c_field_name;
1126
1127   CHECK_PGRESULT (result);
1128   CHECK_STRING (field_name);
1129   R = (XPGRESULT (result))->pgresult;
1130   PUKE_IF_NULL (R);
1131
1132   TO_EXTERNAL_FORMAT (LISP_STRING, field_name,
1133                       C_STRING_ALLOCA, c_field_name, Qnative);
1134
1135   return make_int (PQfnumber (R, c_field_name));
1136 }
1137
1138 DEFUN ("pq-ftype", Fpq_ftype, 2, 2, 0, /*
1139 Return the field type associated with the given field index.
1140 The integer returned is the internal coding of the type.  Field indices
1141 start at 0.
1142 */
1143         (result, field_num))
1144 {
1145   PGresult *R;
1146
1147   CHECK_PGRESULT (result);
1148   CHECK_INT (field_num);
1149   R = (XPGRESULT (result))->pgresult;
1150   PUKE_IF_NULL (R);
1151
1152   return make_int (PQftype (R, XINT (field_num)));
1153 }
1154
1155 DEFUN ("pq-fsize", Fpq_fsize, 2, 2, 0, /*
1156 Return the field size in bytes associated with the given field index.
1157 Field indices start at 0.
1158 */
1159         (result, field_index))
1160 {
1161   PGresult *R;
1162
1163   CHECK_PGRESULT (result);
1164   CHECK_INT (field_index);
1165   R = (XPGRESULT (result))->pgresult;
1166   PUKE_IF_NULL (R);
1167
1168   return make_int (PQftype (R, XINT (field_index)));
1169 }
1170
1171 DEFUN ("pq-fmod", Fpq_fmod, 2, 2, 0, /*
1172 Return the type modifier associated with a field.
1173 Field indices start at 0.
1174 */
1175         (result, field_index))
1176 {
1177   PGresult *R;
1178
1179   CHECK_PGRESULT (result);
1180   CHECK_INT (field_index);
1181   R = (XPGRESULT (result))->pgresult;
1182   PUKE_IF_NULL (R);
1183
1184   return make_int (PQfmod (R, XINT (field_index)));
1185 }
1186
1187 DEFUN ("pq-get-value", Fpq_get_value, 3, 3, 0, /*
1188 Return a single field (attribute) value of one tuple of a PGresult.
1189 Tuple and field indices start at 0.
1190 */
1191         (result, tup_num, field_num))
1192 {
1193   PGresult *R;
1194
1195   CHECK_PGRESULT (result);
1196   CHECK_INT (tup_num);
1197   CHECK_INT (field_num);
1198   R = (XPGRESULT (result))->pgresult;
1199   PUKE_IF_NULL (R);
1200
1201   return build_ext_string (PQgetvalue (R, XINT (tup_num), XINT (field_num)),
1202                            PG_OS_CODING);
1203 }
1204
1205 DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1206 Returns the length of a field value in bytes.
1207 If result is binary, i.e. a result of a binary portal, then the
1208 length returned does NOT include the size field of the varlena.  (The
1209 data returned by PQgetvalue doesn't either.)
1210 */
1211         (result, tup_num, field_num))
1212 {
1213   PGresult *R;
1214
1215   CHECK_PGRESULT (result);
1216   CHECK_INT (tup_num);
1217   CHECK_INT (field_num);
1218   R = (XPGRESULT (result))->pgresult;
1219   PUKE_IF_NULL (R);
1220
1221   return make_int (PQgetlength (R, XINT (tup_num), XINT (field_num)));
1222 }
1223
1224 DEFUN ("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /*
1225 Returns the null status of a field value.
1226 */
1227         (result, tup_num, field_num))
1228 {
1229   PGresult *R;
1230
1231   CHECK_PGRESULT (result);
1232   CHECK_INT (tup_num);
1233   CHECK_INT (field_num);
1234   R = (XPGRESULT (result))->pgresult;
1235   PUKE_IF_NULL (R);
1236
1237   return PQgetisnull (R, XINT (tup_num), XINT (field_num)) ? Qt : Qnil;
1238 }
1239
1240 DEFUN ("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
1241 Returns the command status string from the SQL command that generated the result.
1242 */
1243         (result))
1244 {
1245   PGresult *R;
1246
1247   CHECK_PGRESULT (result);
1248   R = (XPGRESULT (result))->pgresult;
1249   PUKE_IF_NULL (R);
1250
1251   return build_ext_string (PQcmdStatus (R), PG_OS_CODING);
1252 }
1253
1254 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1255 Returns the number of rows affected by the SQL command.
1256 */
1257         (result))
1258 {
1259   PGresult *R;
1260
1261   CHECK_PGRESULT (result);
1262   R = (XPGRESULT (result))->pgresult;
1263   PUKE_IF_NULL (R);
1264
1265   return build_ext_string (PQcmdTuples (R), PG_OS_CODING);
1266 }
1267
1268 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
1269 Returns the object id of the tuple inserted.
1270 */
1271         (result))
1272 {
1273   PGresult *R;
1274
1275   CHECK_PGRESULT (result);
1276   R = (XPGRESULT (result))->pgresult;
1277   PUKE_IF_NULL (R);
1278
1279 #ifdef HAVE_POSTGRESQLV7
1280   return make_int (PQoidValue (R));
1281 #else
1282   /* Use the old interface */
1283   return make_int (atoi (PQoidStatus (R)));
1284 #endif
1285 }
1286
1287 #ifdef HAVE_POSTGRESQLV7
1288 DEFUN ("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /*
1289 Sets the PGconn's database connection non-blocking if the arg is TRUE
1290 or makes it non-blocking if the arg is FALSE, this will not protect
1291 you from PQexec(), you'll only be safe when using the non-blocking API.
1292
1293 Needs to be called only on a connected database connection.
1294 */
1295        (conn, arg))
1296 {
1297   PGconn *P;
1298
1299   CHECK_PGCONN (conn);
1300   P = (XPGCONN (conn))->pgconn;
1301   CHECK_LIVE_CONNECTION (P);
1302
1303   return make_int (PQsetnonblocking (P, !NILP (arg)));
1304 }
1305
1306 DEFUN ("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
1307 Return the blocking status of the database connection.
1308 */
1309        (conn))
1310 {
1311   PGconn *P;
1312
1313   CHECK_PGCONN (conn);
1314   P = (XPGCONN (conn))->pgconn;
1315   CHECK_LIVE_CONNECTION (P);
1316
1317   return PQisnonblocking (P) ? Qt : Qnil;
1318 }
1319
1320 DEFUN ("pq-flush", Fpq_flush, 1, 1, 0, /*
1321 Force the write buffer to be written (or at least try).
1322 */
1323        (conn))
1324 {
1325   PGconn *P;
1326
1327   CHECK_PGCONN (conn);
1328   P = (XPGCONN (conn))->pgconn;
1329   CHECK_LIVE_CONNECTION (P);
1330
1331   return make_int (PQflush (P));
1332 }
1333 #endif
1334
1335 DEFUN ("pq-notifies", Fpq_notifies, 1, 1, 0, /*
1336 Return the latest async notification that has not yet been handled.
1337 If there has been a notification, then a list of two elements will be returned.
1338 The first element contains the relation name being notified, the second
1339 element contains the backend process ID number.  nil is returned if there
1340 aren't any notifications to process.
1341 */
1342        (conn))
1343 {
1344   /* This function cannot GC */
1345   PGconn *P;
1346   PGnotify *PGN;
1347
1348   CHECK_PGCONN (conn);
1349   P = (XPGCONN (conn))->pgconn;
1350   CHECK_LIVE_CONNECTION (P);
1351
1352   PGN = PQnotifies (P);
1353   if (!PGN)
1354     return Qnil;
1355   else
1356   {
1357     Lisp_Object temp;
1358
1359     temp = list2 (build_ext_string (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid));
1360     free ((void *)PGN);
1361     return temp;
1362   }
1363 }
1364
1365 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1366 DEFUN ("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
1367 Get encoding id from environment variable PGCLIENTENCODING.
1368 */
1369        ())
1370 {
1371   return make_int (PQenv2encoding ());
1372 }
1373 #endif /* MULE */
1374
1375 DEFUN ("pq-lo-import", Fpq_lo_import, 2, 2, 0, /*
1376 */
1377        (conn, filename))
1378 {
1379   PGconn *P;
1380   char *c_filename;
1381
1382   CHECK_PGCONN (conn);
1383   CHECK_STRING (filename);
1384
1385   P = (XPGCONN (conn))->pgconn;
1386   CHECK_LIVE_CONNECTION (P);
1387
1388   TO_EXTERNAL_FORMAT (LISP_STRING, filename,
1389                       C_STRING_ALLOCA, c_filename,
1390                       Qfile_name);
1391
1392   return make_int ((int)lo_import (P, c_filename));
1393 }
1394
1395 DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /*
1396 */
1397        (conn, oid, filename))
1398 {
1399   PGconn *P;
1400   char *c_filename;
1401
1402   CHECK_PGCONN (conn);
1403   CHECK_INT (oid);
1404   CHECK_STRING (filename);
1405
1406   P = (XPGCONN (conn))->pgconn;
1407   CHECK_LIVE_CONNECTION (P);
1408
1409   TO_EXTERNAL_FORMAT (LISP_STRING, filename,
1410                       C_STRING_ALLOCA, c_filename, Qfile_name);
1411
1412   return make_int ((int)lo_export (P, XINT (oid), c_filename));
1413 }
1414
1415 DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /*
1416 Make an empty PGresult object with the given status.
1417 */
1418        (conn, status))
1419 {
1420   PGconn *P;
1421   Lisp_PGresult *lpgr;
1422   PGresult *R;
1423   ExecStatusType est;
1424
1425   CHECK_PGCONN (conn);
1426   P = (XPGCONN (conn))->pgconn;
1427   CHECK_LIVE_CONNECTION (P); /* needed here? */
1428
1429   if (EQ (status, Qpgres_empty_query)) est = PGRES_EMPTY_QUERY;
1430   else if (EQ (status, Qpgres_command_ok)) est = PGRES_COMMAND_OK;
1431   else if (EQ (status, Qpgres_tuples_ok)) est = PGRES_TUPLES_OK;
1432   else if (EQ (status, Qpgres_copy_out)) est = PGRES_COPY_OUT;
1433   else if (EQ (status, Qpgres_copy_in)) est = PGRES_COPY_IN;
1434   else if (EQ (status, Qpgres_bad_response)) est = PGRES_BAD_RESPONSE;
1435   else if (EQ (status, Qpgres_nonfatal_error)) est = PGRES_NONFATAL_ERROR;
1436   else if (EQ (status, Qpgres_fatal_error)) est = PGRES_FATAL_ERROR;
1437   else signal_simple_error ("bad status symbol", status);
1438
1439   R = PQmakeEmptyPGresult (P, est);
1440   if (!R) error ("out of memory?");
1441
1442   lpgr = allocate_pgresult ();
1443   lpgr->pgresult = R;
1444
1445   return make_pgresult (lpgr);
1446 }
1447
1448 DEFUN ("pq-get-line", Fpq_get_line, 1, 1, 0, /*
1449 Retrieve a line from server in copy in operation.
1450 The return value is a dotted pair where the cons cell is an integer code:
1451    -1: Copying is complete
1452     0: A record is complete
1453     1: A record is incomplete, it will be continued in the next `pq-get-line'
1454        operation.
1455 and the cdr cell is returned string data.
1456
1457 The copy operation is complete when the value `\.' (backslash dot) is
1458 returned.
1459 */
1460        (conn))
1461 {
1462   char buffer[BLCKSZ]; /* size of a Postgres disk block */
1463   PGconn *P;
1464   int ret;
1465
1466   CHECK_PGCONN (conn);
1467   P = (XPGCONN (conn))->pgconn;
1468   CHECK_LIVE_CONNECTION (P);
1469
1470   ret = PQgetline (P, buffer, sizeof (buffer));
1471
1472   return Fcons (make_int (ret), build_ext_string (buffer, PG_OS_CODING));
1473 }
1474
1475 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /*
1476 Send a line to the server in copy out operation.
1477
1478 Returns t if the operation succeeded, nil otherwise.
1479 */
1480        (conn, string))
1481 {
1482   PGconn *P;
1483   char *c_string;
1484
1485   CHECK_PGCONN (conn);
1486   CHECK_STRING (string);
1487
1488   P = (XPGCONN (conn))->pgconn;
1489   CHECK_LIVE_CONNECTION (P);
1490   TO_EXTERNAL_FORMAT (LISP_STRING, string,
1491                       C_STRING_ALLOCA, c_string, Qnative);
1492
1493   return !PQputline (P, c_string) ? Qt : Qnil;
1494 }
1495
1496 DEFUN ("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
1497 Get a line from the server in copy in operation asynchronously.
1498
1499 This routine is for applications that want to do "COPY <rel> to stdout"
1500 asynchronously, that is without blocking.  Having issued the COPY command
1501 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
1502 and this routine until the end-of-data signal is detected.  Unlike
1503 PQgetline, this routine takes responsibility for detecting end-of-data.
1504
1505 On each call, PQgetlineAsync will return data if a complete newline-
1506 terminated data line is available in libpq's input buffer, or if the
1507 incoming data line is too long to fit in the buffer offered by the caller.
1508 Otherwise, no data is returned until the rest of the line arrives.
1509
1510 If -1 is returned, the end-of-data signal has been recognized (and removed
1511 from libpq's input buffer).  The caller *must* next call PQendcopy and
1512 then return to normal processing.
1513
1514 RETURNS:
1515       -1    if the end-of-copy-data marker has been recognized
1516       0         if no data is available
1517       >0    the number of bytes returned.
1518 The data returned will not extend beyond a newline character.  If possible
1519 a whole line will be returned at one time.  But if the buffer offered by
1520 the caller is too small to hold a line sent by the backend, then a partial
1521 data line will be returned.  This can be detected by testing whether the
1522 last returned byte is '\n' or not.
1523 The returned string is *not* null-terminated.
1524 */
1525        (conn))
1526 {
1527   PGconn *P;
1528   char buffer[BLCKSZ];
1529   int ret;
1530
1531   CHECK_PGCONN (conn);
1532
1533   P = (XPGCONN (conn))->pgconn;
1534   CHECK_LIVE_CONNECTION (P);
1535
1536   ret = PQgetlineAsync (P, buffer, sizeof (buffer));
1537
1538   if (ret == -1) return Qt; /* done! */
1539   else if (!ret) return Qnil; /* no data yet */
1540   else return Fcons (make_int (ret),
1541                      make_ext_string ((Extbyte *) buffer, ret, PG_OS_CODING));
1542 }
1543
1544 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1545 Asynchronous copy out.
1546 */
1547        (conn, data))
1548 {
1549   /* NULs are not allowed.  I don't think this matters at this time. */
1550   PGconn *P;
1551   char *c_data;
1552
1553   CHECK_PGCONN (conn);
1554   CHECK_STRING (data);
1555
1556   P = (XPGCONN (conn))->pgconn;
1557   CHECK_LIVE_CONNECTION (P);
1558   TO_EXTERNAL_FORMAT (LISP_STRING, data,
1559                       C_STRING_ALLOCA, c_data, Qnative);
1560
1561   return !PQputnbytes (P, c_data, strlen (c_data)) ? Qt : Qnil;
1562 }
1563
1564 DEFUN ("pq-end-copy", Fpq_end_copy, 1, 1, 0, /*
1565 End a copying operation.
1566 */
1567        (conn))
1568 {
1569   PGconn *P;
1570
1571   CHECK_PGCONN (conn);
1572   P = (XPGCONN (conn))->pgconn;
1573   CHECK_LIVE_CONNECTION (P);
1574
1575   return PQendcopy (P) ? Qt : Qnil;
1576 }
1577
1578 void
1579 syms_of_postgresql(void)
1580 {
1581 #ifndef RUNNING_XEMACS_21_1
1582   INIT_LRECORD_IMPLEMENTATION (pgconn);
1583   INIT_LRECORD_IMPLEMENTATION (pgresult);
1584 #endif
1585   defsymbol (&Qpostgresql, "postgresql");
1586
1587   /* opaque exported types */
1588   defsymbol (&Qpgconnp, "pgconnp");
1589   defsymbol (&Qpgresultp, "pgresultp");
1590
1591   /* connection status types */
1592   defsymbol (&Qpg_connection_ok, "pg::connection-ok");
1593   defsymbol (&Qpg_connection_bad, "pg::connection-bad");
1594   defsymbol (&Qpg_connection_started, "pg::connection-started");
1595   defsymbol (&Qpg_connection_made, "pg::connection-made");
1596   defsymbol (&Qpg_connection_awaiting_response, "pg::connection-awaiting-response");
1597   defsymbol (&Qpg_connection_auth_ok, "pg::connection-auth-ok");
1598   defsymbol (&Qpg_connection_setenv, "pg::connection-setenv");
1599
1600   /* Fields of PGconn */
1601   defsymbol (&Qpqdb, "pq::db");
1602   defsymbol (&Qpquser, "pq::user");
1603   defsymbol (&Qpqpass, "pq::pass");
1604   defsymbol (&Qpqhost, "pq::host");
1605   defsymbol (&Qpqport, "pq::port");
1606   defsymbol (&Qpqtty, "pq::tty");
1607   defsymbol (&Qpqoptions, "pq::options");
1608   defsymbol (&Qpqstatus, "pq::status");
1609   defsymbol (&Qpqerrormessage, "pq::error-message");
1610   defsymbol (&Qpqbackendpid, "pq::backend-pid");
1611
1612   /* Query status results */
1613   defsymbol (&Qpgres_empty_query, "pgres::empty-query");
1614   defsymbol (&Qpgres_command_ok, "pgres::command-ok");
1615   defsymbol (&Qpgres_tuples_ok, "pgres::tuples-ok");
1616   defsymbol (&Qpgres_copy_out, "pgres::copy-out");
1617   defsymbol (&Qpgres_copy_in, "pgres::copy-in");
1618   defsymbol (&Qpgres_bad_response, "pgres::bad-response");
1619   defsymbol (&Qpgres_nonfatal_error, "pgres::nonfatal-error");
1620   defsymbol (&Qpgres_fatal_error, "pgres::fatal-error");
1621
1622   /* Poll status results */
1623   defsymbol (&Qpgres_polling_failed, "pgres::polling-failed");
1624   defsymbol (&Qpgres_polling_reading, "pgres::polling-reading");
1625   defsymbol (&Qpgres_polling_writing, "pgres::polling-writing");
1626   defsymbol (&Qpgres_polling_ok, "pgres::polling-ok");
1627   defsymbol (&Qpgres_polling_active, "pgres::polling-active");
1628
1629 #ifdef HAVE_POSTGRESQLV7
1630   DEFSUBR (Fpq_connect_start);
1631   DEFSUBR (Fpq_connect_poll);
1632 #ifdef MULE
1633   DEFSUBR (Fpq_client_encoding);
1634   DEFSUBR (Fpq_set_client_encoding);
1635 #endif /* MULE */
1636 #endif /* HAVE_POSTGRESQLV7 */
1637   DEFSUBR (Fpq_conn_defaults);
1638   DEFSUBR (Fpq_connectdb);
1639   DEFSUBR (Fpq_finish);
1640   DEFSUBR (Fpq_clear);
1641   DEFSUBR (Fpq_is_busy);
1642   DEFSUBR (Fpq_consume_input);
1643
1644   DEFSUBR (Fpq_reset);
1645 #ifdef HAVE_POSTGRESQLV7
1646   DEFSUBR (Fpq_reset_start);
1647   DEFSUBR (Fpq_reset_poll);
1648 #endif
1649   DEFSUBR (Fpq_request_cancel);
1650   DEFSUBR (Fpq_pgconn);
1651
1652   DEFSUBR (Fpq_exec);
1653   DEFSUBR (Fpq_send_query);
1654   DEFSUBR (Fpq_get_result);
1655   DEFSUBR (Fpq_result_status);
1656   DEFSUBR (Fpq_res_status);
1657   DEFSUBR (Fpq_result_error_message);
1658   DEFSUBR (Fpq_ntuples);
1659   DEFSUBR (Fpq_nfields);
1660   DEFSUBR (Fpq_binary_tuples);
1661   DEFSUBR (Fpq_fname);
1662   DEFSUBR (Fpq_fnumber);
1663   DEFSUBR (Fpq_ftype);
1664   DEFSUBR (Fpq_fsize);
1665   DEFSUBR (Fpq_fmod);
1666   /***/
1667   DEFSUBR (Fpq_get_value);
1668   DEFSUBR (Fpq_get_length);
1669   DEFSUBR (Fpq_get_is_null);
1670   DEFSUBR (Fpq_cmd_status);
1671   DEFSUBR (Fpq_cmd_tuples);
1672   DEFSUBR (Fpq_oid_value);
1673
1674 #ifdef HAVE_POSTGRESQLV7
1675   DEFSUBR (Fpq_set_nonblocking);
1676   DEFSUBR (Fpq_is_nonblocking);
1677   DEFSUBR (Fpq_flush);
1678 #endif
1679   DEFSUBR (Fpq_notifies);
1680
1681 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1682   DEFSUBR (Fpq_env_2_encoding);
1683 #endif
1684
1685   DEFSUBR (Fpq_lo_import);
1686   DEFSUBR (Fpq_lo_export);
1687
1688   DEFSUBR (Fpq_make_empty_pgresult);
1689
1690   /* copy in/out functions */
1691   DEFSUBR (Fpq_get_line);
1692   DEFSUBR (Fpq_put_line);
1693   DEFSUBR (Fpq_get_line_async);
1694   DEFSUBR (Fpq_put_nbytes);
1695   DEFSUBR (Fpq_end_copy);
1696 }
1697
1698 void
1699 vars_of_postgresql(void)
1700 {
1701   Fprovide (Qpostgresql);
1702 #ifdef HAVE_POSTGRESQLV7
1703   Fprovide (intern ("postgresqlv7"));
1704 #endif
1705 #ifndef RUNNING_XEMACS_21_1
1706   Vpg_coding_system = Qnative;
1707   DEFVAR_LISP ("pg-coding-system", &Vpg_coding_system /*
1708 Default Postgres client coding system.
1709 */ );
1710 #endif
1711
1712   DEFVAR_LISP ("pg:host", &VXPGHOST /*
1713 Default PostgreSQL server name.
1714 If not set, the server running on the local host is used.  The
1715 initial value is set from the PGHOST environment variable.
1716 */ );
1717
1718   DEFVAR_LISP ("pg:user", &VXPGUSER /*
1719 Default PostgreSQL user name.
1720 This value is used when connecting to a database for authentication.
1721 The initial value is set from the PGUSER environment variable.
1722 */ );
1723
1724   DEFVAR_LISP ("pg:options", &VXPGOPTIONS /*
1725 Default PostgreSQL user name.
1726 This value is used when connecting to a database for authentication.
1727 The initial value is set from the PGUSER environment variable.
1728 */ );
1729
1730   DEFVAR_LISP ("pg:port", &VXPGPORT /*
1731 Default port to connect to PostgreSQL backend.
1732 This value is used when connecting to a database.
1733 The initial value is set from the PGPORT environment variable.
1734 */ );
1735
1736   DEFVAR_LISP ("pg:tty", &VXPGTTY /*
1737 Default debugging TTY.
1738 There is no useful setting of this variable in the XEmacs Lisp API.
1739 The initial value is set from the PGTTY environment variable.
1740 */ );
1741
1742   DEFVAR_LISP ("pg:database", &VXPGDATABASE /*
1743 Default database to connect to.
1744 The initial value is set from the PGDATABASE environment variable.
1745 */ );
1746
1747   DEFVAR_LISP ("pg:realm", &VXPGREALM /*
1748 Default kerberos realm to use for authentication.
1749 The initial value is set from the PGREALM environment variable.
1750 */ );
1751
1752 #ifdef MULE
1753   /* It's not clear whether this is any use.  My intent is to
1754      autodetect the coding system from the database. */
1755   DEFVAR_LISP ("pg:client-encoding", &VXPGCLIENTENCODING /*
1756 Default client encoding to use.
1757 The initial value is set from the PGCLIENTENCODING environment variable.
1758 */ );
1759 #endif
1760
1761 #if !defined(HAVE_POSTGRESQLV7)
1762   DEFVAR_LISP ("pg:authtype", &VXPGAUTHTYPE /*
1763 Default authentication to use.
1764 The initial value is set from the PGAUTHTYPE environment variable.
1765
1766 WARNING:  This variable has gone away in versions of PostgreSQL newer
1767 than 6.5.
1768 */ );
1769 #endif
1770
1771   DEFVAR_LISP ("pg:geqo", &VXPGGEQO /*
1772 Genetic Query Optimizer options.
1773 The initial value is set from the PGGEQO environment variable.
1774 */ );
1775
1776   DEFVAR_LISP ("pg:cost-index", &VXPGCOSTINDEX /*
1777 Default cost index options.
1778 The initial value is set from the PGCOSTINDEX environment variable.
1779 */ );
1780
1781   DEFVAR_LISP ("pg:cost-heap", &VXPGCOSTHEAP /*
1782 Default cost heap options.
1783 The initial value is set from the PGCOSTHEAP environment variable.
1784 */ );
1785
1786   DEFVAR_LISP ("pg:tz", &VXPGTZ /*
1787 Default timezone to use.
1788 The initial value is set from the PGTZ environment variable.
1789 */ );
1790
1791   DEFVAR_LISP ("pg:date-style", &VXPGDATESTYLE /*
1792 Default date style to use.
1793 The initial value is set from the PGDATESTYLE environment variable.
1794 */ );
1795 }
1796
1797 /* These initializations should not be done at dump-time. */
1798 void
1799 init_postgresql_from_environment(void)
1800 {
1801   char *p;
1802
1803   if ((p = getenv ("PGHOST")))
1804     {
1805       VXPGHOST = build_ext_string (p, PG_OS_CODING);
1806     }
1807   else
1808     {
1809       VXPGHOST = Qnil;
1810     }
1811
1812   if ((p = getenv ("PGUSER")))
1813     {
1814       VXPGUSER = build_ext_string (p, PG_OS_CODING);
1815     }
1816   else
1817     {
1818       VXPGUSER = Qnil;
1819     }
1820
1821   if ((p = getenv ("PGOPTIONS")))
1822     {
1823       VXPGOPTIONS = build_ext_string (p, PG_OS_CODING);
1824     }
1825   else
1826     {
1827       VXPGOPTIONS = Qnil;
1828     }
1829
1830   if ((p = getenv ("PGPORT")))
1831     {
1832       VXPGPORT = make_int (atoi (p));
1833     }
1834   else
1835     {
1836       VXPGPORT = Qnil;
1837     }
1838
1839   if ((p = getenv ("PGTTY")))
1840     {
1841       VXPGTTY = build_ext_string (p, PG_OS_CODING);
1842     }
1843   else
1844     {
1845       VXPGTTY = Qnil;
1846     }
1847
1848   if ((p = getenv ("PGDATABASE")))
1849     {
1850       VXPGDATABASE = build_ext_string (p, PG_OS_CODING);
1851     }
1852   else
1853     {
1854       VXPGDATABASE = Qnil;
1855     }
1856
1857   if ((p = getenv ("PGREALM")))
1858     {
1859       VXPGREALM = build_ext_string (p, PG_OS_CODING);
1860     }
1861   else
1862     {
1863       VXPGREALM = Qnil;
1864     }
1865
1866 #ifdef MULE
1867   /* It's not clear whether this is any use.  My intent is to
1868      autodetect the coding system from the database. */
1869   if ((p = getenv ("PGCLIENTENCODING")))
1870     {
1871       VXPGCLIENTENCODING = build_ext_string (p, PG_OS_CODING);
1872     }
1873   else
1874     {
1875       VXPGCLIENTENCODING = Qnil;
1876     }
1877 #endif
1878
1879 #if !defined(HAVE_POSTGRESQLV7)
1880   if ((p = getenv ("PGAUTHTYPE")))
1881     {
1882       VXPGAUTHTYPE = build_ext_string (p, PG_OS_CODING);
1883     }
1884   else
1885     {
1886       VXPGAUTHTYPE = Qnil;
1887     }
1888 #endif
1889
1890   if ((p = getenv ("PGGEQO")))
1891     {
1892       VXPGGEQO = build_ext_string (p, PG_OS_CODING);
1893     }
1894   else
1895     {
1896       VXPGGEQO = Qnil;
1897     }
1898
1899   if ((p = getenv ("PGCOSTINDEX")))
1900     {
1901       VXPGCOSTINDEX = build_ext_string (p, PG_OS_CODING);
1902     }
1903   else
1904     {
1905       VXPGCOSTINDEX = Qnil;
1906     }
1907
1908   if ((p = getenv ("PGCOSTHEAP")))
1909     {
1910       VXPGCOSTHEAP = build_ext_string (p, PG_OS_CODING);
1911     }
1912   else
1913     {
1914       VXPGCOSTHEAP = Qnil;
1915     }
1916
1917   if ((p = getenv ("PGTZ")))
1918     {
1919       VXPGTZ = build_ext_string (p, PG_OS_CODING);
1920     }
1921   else
1922     {
1923       VXPGTZ = Qnil;
1924     }
1925
1926   if ((p = getenv ("PGDATESTYLE")))
1927     {
1928       VXPGDATESTYLE = build_ext_string (p, PG_OS_CODING);
1929     }
1930   else
1931     {
1932       VXPGDATESTYLE = Qnil;
1933     }
1934 }
1935