2 postgresql.c -- Emacs Lisp binding to libpq.so
3 Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
4 Licensed to the Free Software Foundation.
6 Author: SL Baur <steve@beopen.com>
7 Maintainer: SL Baur <steve@beopen.com>
9 Please send patches to this file to me first before submitting them to
13 KNOWN PROBLEMS (Last update 15-March-2000)
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.
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
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.
37 This interface tries very hard to not set any policy towards how database
38 code in Emacs Lisp will be written.
40 For full lisp programming documentation, see the XEmacs Lisp Reference
41 Manual. For PostgreSQL documentation, see the PostgreSQL distribution.
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->
51 Unimplemented functions: [TODO]
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 PQsetenvStart (Asynch. Queries)
61 PQsetenvPoll (Asynch. Queries)
62 PQsetenvHandle (Asynch. Queries)
64 Unsupported functions:
65 PQsetdbLogin -- This function is deprecated, has a subset of the
66 functionality of PQconnectdb, and is better done in Lisp.
67 PQsetdb -- Same as for PQsetdbLogin
68 PQsocket -- Abstraction error, file descriptors should not be leaked
70 PQprint -- print to a file descriptor, deprecated, better done in Lisp
71 PQdisplayTuples -- deprecated
72 PQprintTuples -- really, really deprecated
73 PQmblen -- Returns the length in bytes of multibyte character encoded
75 PQtrace -- controls debug print tracing to a tty.
76 PQuntrace -- Ditto. I don't see any way to do this sensibly.
77 PQoidStatus -- deprecated and nearly identical to PQoidValue
78 PQfn -- "Fast path" interface
79 lo_open (large object) [*]
80 lo_close (large object) [*]
81 lo_read (large object) [*]
82 lo_write (large object) [*]
83 lo_lseek (large object) [*]
84 lo_creat (large object) [*]
85 lo_tell (large object) [*]
86 lo_unlink (large object) [*]
91 /* This must be portable with XEmacs 21.1 so long as it is the official
92 released version of XEmacs and provides the basis of InfoDock. The
93 interface to lcrecord handling has changed with 21.2, so unfortunately
94 we will need a few snippets of backwards compatibility code.
96 #if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION < 2)
97 #define RUNNING_XEMACS_21_1 1
100 /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */
106 #include <libpq-fe.h>
107 /* Undefine the following when asynchronous setenvs are fixed in libpq. */
108 /* #define LIBPQ_7_0_IS_FIXED */
109 #include "postgresql.h"
111 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */
112 #define I_HATE_CONST CONST
113 #define PG_OS_CODING FORMAT_FILENAME
114 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to)
116 #define I_HATE_CONST const
118 #define PG_OS_CODING Fget_coding_system(Vpg_coding_system)
120 #define PG_OS_CODING Qnative
122 Lisp_Object Vpg_coding_system;
125 #define CHECK_LIVE_CONNECTION(P) { \
126 if (!P || (PQstatus (P) != CONNECTION_OK)) { \
127 char *e = "bad value"; \
128 if (P) e = PQerrorMessage (P); \
129 error ("dead connection [%s]", e); \
131 #define PUKE_IF_NULL(p) { \
132 if (!p) error ("bad value"); \
135 static Lisp_Object VXPGHOST;
136 static Lisp_Object VXPGUSER;
137 static Lisp_Object VXPGOPTIONS;
138 static Lisp_Object VXPGPORT;
139 static Lisp_Object VXPGTTY; /* This needs to be blanked! */
140 static Lisp_Object VXPGDATABASE;
141 static Lisp_Object VXPGREALM;
143 static Lisp_Object VXPGCLIENTENCODING;
147 PGAUTHTYPE -- not used after PostgreSQL 6.5
154 #ifndef HAVE_POSTGRESQLV7
155 static Lisp_Object VXPGAUTHTYPE;
157 static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE;
159 static Lisp_Object Qpostgresql;
160 static Lisp_Object Qpg_connection_ok, Qpg_connection_bad;
161 static Lisp_Object Qpg_connection_started, Qpg_connection_made;
162 static Lisp_Object Qpg_connection_awaiting_response, Qpg_connection_auth_ok;
163 static Lisp_Object Qpg_connection_setenv;
165 static Lisp_Object Qpqdb, Qpquser, Qpqpass, Qpqhost, Qpqport, Qpqtty;
166 static Lisp_Object Qpqoptions, Qpqstatus, Qpqerrormessage, Qpqbackendpid;
168 static Lisp_Object Qpgres_empty_query, Qpgres_command_ok, Qpgres_tuples_ok;
169 static Lisp_Object Qpgres_copy_out, Qpgres_copy_in, Qpgres_bad_response;
170 static Lisp_Object Qpgres_nonfatal_error, Qpgres_fatal_error;
172 static Lisp_Object Qpgres_polling_failed, Qpgres_polling_reading;
173 static Lisp_Object Qpgres_polling_writing, Qpgres_polling_ok;
174 static Lisp_Object Qpgres_polling_active;
177 /* PGconn is an opaque object and we need to be able to store them in
178 Lisp code because libpq supports multiple connections.
180 Lisp_Object Qpgconnp;
183 make_pgconn (Lisp_PGconn *pgconn)
185 Lisp_Object lisp_pgconn;
186 XSETPGCONN (lisp_pgconn, pgconn);
191 #ifdef RUNNING_XEMACS_21_1
192 mark_pgconn (Lisp_Object obj, void (*markobj) (Lisp_Object))
194 mark_pgconn (Lisp_Object obj)
201 print_pgconn (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
206 char *host="", *db="", *user="", *port="";
208 P = (XPGCONN (obj))->pgconn;
210 if (!P) /* this may happen since we allow PQfinish() to be called */
211 strcpy (buf, "#<PGconn DEAD>"); /* evil! */
212 else if ((cst = PQstatus (P)) == CONNECTION_OK)
214 if (!(host = PQhost (P)))
218 if (!(user = PQuser (P)))
220 sprintf (buf, "#<PGconn %s:%s %s/%s>", /* evil! */
221 !strlen (host) ? "localhost" : host,
226 else if (cst == CONNECTION_BAD)
227 strcpy (buf, "#<PGconn BAD>"); /* evil! */
229 strcpy (buf, "#<PGconn connecting>"); /* evil! */
232 error ("printing unreadable object %s", buf);
234 write_c_string (buf, printcharfun);
238 allocate_pgconn (void)
240 #ifdef RUNNING_XEMACS_21_1
241 Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn,
244 Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn,
247 pgconn->pgconn = (PGconn *)NULL;
252 finalize_pgconn (void *header, int for_disksave)
254 Lisp_PGconn *pgconn = (Lisp_PGconn *)header;
257 signal_simple_error ("Can't dump an emacs containing PGconn objects",
258 make_pgconn (pgconn));
262 PQfinish (pgconn->pgconn);
263 pgconn->pgconn = (PGconn *)NULL;
267 #ifdef RUNNING_XEMACS_21_1
268 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
269 mark_pgconn, print_pgconn, finalize_pgconn,
273 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
274 mark_pgconn, print_pgconn, finalize_pgconn,
281 /* PGresult is an opaque object and we need to be able to store them in
284 Lisp_Object Qpgresultp;
287 make_pgresult (Lisp_PGresult *pgresult)
289 Lisp_Object lisp_pgresult;
290 XSETPGRESULT (lisp_pgresult, pgresult);
291 return lisp_pgresult;
295 #ifdef RUNNING_XEMACS_21_1
296 mark_pgresult (Lisp_Object obj, void (*markobj) (Lisp_Object))
298 mark_pgresult (Lisp_Object obj)
304 #define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>"
305 #define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>"
306 #define RESULT_DEFAULT_FMT "#<PGresult %s - %s>"
308 print_pgresult (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
313 res = (XPGRESULT (obj))->pgresult;
317 switch (PQresultStatus (res))
319 case PGRES_TUPLES_OK:
320 /* Add number of tuples of result to output */
321 sprintf (buf, RESULT_TUPLES_FMT, /* evil! */
322 PQresStatus (PQresultStatus (res)),
326 case PGRES_COMMAND_OK:
327 /* Add number of tuples affected by output-less command */
328 if (!strlen (PQcmdTuples (res))) goto notuples;
329 sprintf (buf, RESULT_CMD_TUPLES_FMT, /* evil! */
330 PQresStatus (PQresultStatus (res)),
336 /* No counts to print */
337 sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */
338 PQresStatus (PQresultStatus (res)),
344 strcpy (buf, "#<PGresult DEAD>"); /* evil! */
347 error ("printing unreadable object %s", buf);
349 write_c_string (buf, printcharfun);
352 #undef RESULT_TUPLES_FMT
353 #undef RESULT_CMD_TUPLES_FMT
354 #undef RESULT_DEFAULT_FMT
356 static Lisp_PGresult *
357 allocate_pgresult (void)
359 #ifdef RUNNING_XEMACS_21_1
360 Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult,
363 Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult,
366 pgresult->pgresult = (PGresult *)NULL;
371 finalize_pgresult (void *header, int for_disksave)
373 Lisp_PGresult *pgresult = (Lisp_PGresult *)header;
376 signal_simple_error ("Can't dump an emacs containing PGresult objects",
377 make_pgresult (pgresult));
379 if (pgresult->pgresult)
381 PQclear (pgresult->pgresult);
382 pgresult->pgresult = (PGresult *)NULL;
386 #ifdef RUNNING_XEMACS_21_1
387 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
388 mark_pgresult, print_pgresult, finalize_pgresult,
392 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
393 mark_pgresult, print_pgresult, finalize_pgresult,
400 #ifdef HAVE_POSTGRESQLV7
401 /* PGsetenvHandle is an opaque object and we need to be able to store them in
402 Lisp code so we can make asynchronous environmental calls.
404 Asynchronous setenv calls were introduced in libpq-7.0.
406 #ifdef LIBPQ_7_0_IS_FIXED
408 Lisp_Object Qpgsetenvp;
411 make_pgsetenv (Lisp_PGsetenvHandle *pgsetenv)
413 Lisp_Object lisp_pgsetenv;
414 XSETPGSETENV (lisp_pgsetenv, pgsetenv);
415 return lisp_pgsetenv;
419 #ifdef RUNNING_XEMACS_21_1
420 mark_pgsetenv (Lisp_Object obj, void (*markobj) (Lisp_Object))
422 mark_pgsetenv (Lisp_Object obj)
429 print_pgsetenv (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
431 char *fmt = "#<PGsetenvHandle %s>";
435 h = (XPGSETENV (obj))->pgsetenv;
437 sprintf (buf, fmt, h ? "live" : "DEAD");
439 /* There are no accessor functions to retrieve any fields, so we must */
440 /* treat this as being completely opaque. */
442 error ("printing unreadable object %s", buf);
444 write_c_string (buf, printcharfun);
447 static Lisp_PGsetenvHandle *
448 allocate_pgresult (void)
450 #ifdef RUNNING_XEMACS_21_1
451 Lisp_PGsetenvHandle *pgsetenv =
452 alloc_lcrecord_type (Lisp_PGsetenvHandle, lrecord_pgsetenv);
454 Lisp_PGsetenvHandle *pgsetenv =
455 alloc_lcrecord_type (Lisp_PGsetenvHandle, &lrecord_pgsetenv);
457 pgsetenv->pgsetenv = (PGsetenvState *)NULL;
462 finalize_pgsetenv (void *header, int for_disksave)
464 Lisp_PGsetenvHandle *pgsetenv = (Lisp_PGsetenvHandle *)header;
467 signal_simple_error ("Can't dump an emacs containing PGsetenvHandle objects",
468 make_pgsetenv (pgsetenv));
470 /* #### PGsetenvHandle's are allocated with malloc(), however in
471 libpq-7.0 the treatment of them is little short of disastrous.
472 We don't dare attempt to free it, because there are many code
473 paths which lead to the handle being freed internally. The
474 connection routines leak setenv handles and so will we until
475 libpq gets cleaned up.
476 Actually, in 7.0b1 asynchronous setenv cannot work outside libpq, so
477 these functions are disabled in this API.
479 if (pgsetenv->pgsetenv)
481 free (pgsetenv->pgsetenv);
482 pgsetenv->pgsetenv = (PGsetenvHandle *)NULL;
486 #ifdef RUNNING_XEMACS_21_1
487 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
488 mark_pgresult, print_pgresult, finalize_pgresult,
492 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
493 mark_pgresult, print_pgresult, finalize_pgresult,
497 #endif /* RUNNING_XEMACS_21_1 */
499 #endif /* LIBPQ_7_0_IS_FIXED */
500 #endif /* HAVE_POSTGRESQLV7 */
502 /***********************/
506 xemacs_notice_processor (void *arg, I_HATE_CONST char *msg)
508 warn_when_safe (Qpostgresql, Qnotice, "%s", msg);
511 /* There are four ways (as of PostgreSQL v7) to connect to a database.
512 Two of them, PQsetdb and PQsetdbLogin, are deprecated. Both of those
513 routines take a number of positional parameters and are better done in Lisp.
514 Note that PQconnectStart does not exist prior to v7.
517 DEFUN ("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /*
518 Return a connection default structure.
522 /* This function can GC */
523 PQconninfoOption *pcio;
524 Lisp_Object temp, temp1;
527 pcio = PQconndefaults();
528 if (!pcio) return Qnil; /* can never happen in libpq-7.0 */
529 temp = list1 (Fcons (build_ext_string (pcio[0].keyword, PG_OS_CODING),
530 Fcons (build_ext_string (pcio[0].envvar, PG_OS_CODING),
531 Fcons (build_ext_string (pcio[0].compiled, PG_OS_CODING),
532 Fcons (build_ext_string (pcio[0].val, PG_OS_CODING),
533 Fcons (build_ext_string (pcio[0].label, PG_OS_CODING),
534 Fcons (build_ext_string (pcio[0].dispchar, PG_OS_CODING),
535 Fcons (make_int (pcio[0].dispsize), Qnil))))))));
537 for (i = 1; pcio[i].keyword; i++)
539 temp1 = list1 (Fcons (build_ext_string (pcio[i].keyword, PG_OS_CODING),
540 Fcons (build_ext_string (pcio[i].envvar, PG_OS_CODING),
541 Fcons (build_ext_string (pcio[i].compiled, PG_OS_CODING),
542 Fcons (build_ext_string (pcio[i].val, PG_OS_CODING),
543 Fcons (build_ext_string (pcio[i].label, PG_OS_CODING),
544 Fcons (build_ext_string (pcio[i].dispchar, PG_OS_CODING),
545 Fcons (make_int (pcio[i].dispsize), Qnil))))))));
550 /* Fappend GCPROs its arguments */
551 temp = Fappend (2, args);
558 /* PQconnectdb Makes a new connection to a backend.
559 PGconn *PQconnectdb(const char *conninfo)
562 DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /*
563 Make a new connection to a PostgreSQL backend.
568 Lisp_PGconn *lisp_pgconn;
569 char *error_message = "Out of Memory?";
572 CHECK_STRING (conninfo);
574 TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
575 C_STRING_ALLOCA, c_conninfo, Qnative);
576 P = PQconnectdb (c_conninfo);
577 if (P && (PQstatus (P) == CONNECTION_OK))
579 (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
580 lisp_pgconn = allocate_pgconn();
581 lisp_pgconn->pgconn = P;
582 return make_pgconn (lisp_pgconn);
586 /* Connection failed. Destroy the connection and signal an error. */
588 strcpy (buf, error_message);
591 /* storage for the error message gets erased when call PQfinish */
592 /* so we must temporarily stash it somewhere */
593 strncpy (buf, PQerrorMessage (P), sizeof (buf));
594 buf[sizeof (buf) - 1] = '\0';
597 error ("libpq: %s", buf);
601 /* PQconnectStart Makes a new asynchronous connection to a backend.
602 PGconn *PQconnectStart(const char *conninfo)
605 #ifdef HAVE_POSTGRESQLV7
606 DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /*
607 Make a new asynchronous connection to a PostgreSQL backend.
612 Lisp_PGconn *lisp_pgconn;
613 char *error_message = "Out of Memory?";
616 CHECK_STRING (conninfo);
617 TO_EXTERNAL_FORMAT (LISP_STRING, conninfo,
618 C_STRING_ALLOCA, c_conninfo, Qnative);
619 P = PQconnectStart (c_conninfo);
621 if (P && (PQstatus (P) != CONNECTION_BAD))
623 (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
624 lisp_pgconn = allocate_pgconn();
625 lisp_pgconn->pgconn = P;
627 return make_pgconn (lisp_pgconn);
631 /* capture the error message before destroying the object */
633 strcpy (buf, error_message);
636 strncpy (buf, PQerrorMessage (P), sizeof (buf));
637 buf[sizeof (buf) - 1] = '\0';
640 error ("libpq: %s", buf);
644 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
645 Poll an asynchronous connection for completion
650 PostgresPollingStatusType PS;
654 P = (XPGCONN (conn))->pgconn;
655 CHECK_LIVE_CONNECTION (P);
657 PS = PQconnectPoll (P);
660 case PGRES_POLLING_FAILED:
661 /* Something Bad has happened */
663 char *e = PQerrorMessage (P);
664 error ("libpq: %s", e);
666 case PGRES_POLLING_OK:
667 return Qpgres_polling_ok;
668 case PGRES_POLLING_READING:
669 return Qpgres_polling_reading;
670 case PGRES_POLLING_WRITING:
671 return Qpgres_polling_writing;
672 case PGRES_POLLING_ACTIVE:
673 return Qpgres_polling_active;
675 /* they've added a new field we don't know about */
676 error ("Help! Unknown status code %08x from backend!", PS);
681 DEFUN ("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /*
682 Return client coding system.
689 P = (XPGCONN (conn))->pgconn;
690 CHECK_LIVE_CONNECTION (P);
692 return make_int (PQclientEncoding (P));
695 DEFUN ("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /*
696 Set client coding system.
705 CHECK_STRING (encoding);
707 P = (XPGCONN (conn))->pgconn;
708 CHECK_LIVE_CONNECTION (P);
710 TO_EXTERNAL_FORMAT (LISP_STRING, encoding,
711 C_STRING_ALLOCA, c_encoding, Qnative);
713 if ((rc = PQsetClientEncoding (P, c_encoding)) < 0)
714 error ("bad encoding");
716 return make_int (rc);
720 #endif /* HAVE_POSTGRESQLV7 */
722 /* PQfinish Close the connection to the backend. Also frees memory
723 used by the PGconn object.
724 void PQfinish(PGconn *conn)
726 DEFUN ("pq-finish", Fpq_finish, 1, 1, 0, /*
727 Close the connection to the backend.
734 P = (XPGCONN (conn))->pgconn;
738 /* #### PQfinish deallocates the PGconn structure, so we now have a
740 /* Genocided all @'s ... */
741 (XPGCONN (conn))->pgconn = (PGconn *)NULL; /* You feel DEAD inside */
745 DEFUN ("pq-clear", Fpq_clear, 1, 1, 0, /*
746 Forcibly erase a PGresult object.
752 CHECK_PGRESULT (res);
753 R = (XPGRESULT (res))->pgresult;
757 /* Genocided all @'s ... */
758 (XPGRESULT (res))->pgresult = (PGresult *)NULL; /* You feel DEAD inside */
763 DEFUN ("pq-is-busy", Fpq_is_busy, 1, 1, 0, /*
764 Return t if PQgetResult would block waiting for input.
771 P = (XPGCONN (conn))->pgconn;
772 CHECK_LIVE_CONNECTION (P);
774 return PQisBusy (P) ? Qt : Qnil;
777 DEFUN ("pq-consume-input", Fpq_consume_input, 1, 1, 0, /*
778 Consume any available input from the backend.
779 Returns nil if something bad happened.
786 P = (XPGCONN (conn))->pgconn;
787 CHECK_LIVE_CONNECTION (P);
789 return PQconsumeInput (P) ? Qt : Qnil;
792 /* PQreset Reset the communication port with the backend.
793 void PQreset(PGconn *conn)
795 DEFUN ("pq-reset", Fpq_reset, 1, 1, 0, /*
796 Reset the connection to the backend.
797 This function will close the connection to the backend and attempt to
798 reestablish a new connection to the same postmaster, using all the same
799 parameters previously used. This may be useful for error recovery if a
800 working connection is lost.
807 P = (XPGCONN (conn))->pgconn;
808 PUKE_IF_NULL (P);/* we can resurrect a BAD connection, but not a dead one. */
815 #ifdef HAVE_POSTGRESQLV7
816 DEFUN ("pq-reset-start", Fpq_reset_start, 1, 1, 0, /*
817 Reset connection to the backend asynchronously.
824 P = (XPGCONN (conn))->pgconn;
825 CHECK_LIVE_CONNECTION (P);
827 if (PQresetStart (P)) return Qt;
829 char *e = PQerrorMessage (P);
830 error ("libpq: %s", e);
834 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
835 Poll an asynchronous reset for completion
840 PostgresPollingStatusType PS;
844 P = (XPGCONN (conn))->pgconn;
845 CHECK_LIVE_CONNECTION (P);
847 PS = PQresetPoll (P);
850 case PGRES_POLLING_FAILED:
851 /* Something Bad has happened */
853 char *e = PQerrorMessage (P);
854 error ("libpq: %s", e);
856 case PGRES_POLLING_OK:
857 return Qpgres_polling_ok;
858 case PGRES_POLLING_READING:
859 return Qpgres_polling_reading;
860 case PGRES_POLLING_WRITING:
861 return Qpgres_polling_writing;
862 case PGRES_POLLING_ACTIVE:
863 return Qpgres_polling_active;
865 /* they've added a new field we don't know about */
866 error ("Help! Unknown status code %08x from backend!", PS);
871 DEFUN ("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
872 Attempt to request cancellation of the current operation.
874 The return value is t if the cancel request was successfully
875 dispatched, nil if not (in which case conn->errorMessage is set).
876 Note: successful dispatch is no guarantee that there will be any effect at
877 the backend. The application must read the operation result as usual.
884 P = (XPGCONN (conn))->pgconn;
885 CHECK_LIVE_CONNECTION (P);
887 return PQrequestCancel (P) ? Qt : Qnil;
890 /* accessor function for the PGconn object */
891 DEFUN ("pq-pgconn", Fpq_pgconn, 2, 2, 0, /*
892 Accessor function for the PGconn object.
893 Currently recognized symbols for the field:
895 pq::user Database user name
896 pq::pass Database user's password
897 pq::host Hostname of PostgreSQL backend connected to
898 pq::port TCP port number of connection
899 pq::tty Debugging TTY (not used in Emacs)
900 pq::options Additional backend options
901 pq::status Connection status (either OK or BAD)
902 pq::error-message Last error message from the backend
903 pq::backend-pid Process ID of backend process
910 P = (XPGCONN (conn))->pgconn;
911 PUKE_IF_NULL (P); /* BAD connections still have state to query */
913 if (EQ(field, Qpqdb))
914 /* PQdb Returns the database name of the connection.
915 char *PQdb(PGconn *conn)
917 return build_ext_string (PQdb(P), PG_OS_CODING);
918 else if (EQ (field, Qpquser))
919 /* PQuser Returns the user name of the connection.
920 char *PQuser(PGconn *conn)
922 return build_ext_string (PQuser(P), PG_OS_CODING);
923 else if (EQ (field, Qpqpass))
924 /* PQpass Returns the password of the connection.
925 char *PQpass(PGconn *conn)
927 return build_ext_string (PQpass(P), PG_OS_CODING);
928 else if (EQ (field, Qpqhost))
929 /* PQhost Returns the server host name of the connection.
930 char *PQhost(PGconn *conn)
932 return build_ext_string (PQhost(P), PG_OS_CODING);
933 else if (EQ (field, Qpqport))
936 /* PQport Returns the port of the connection.
937 char *PQport(PGconn *conn)
940 return make_int(atoi(p));
944 else if (EQ (field, Qpqtty))
945 /* PQtty Returns the debug tty of the connection.
946 char *PQtty(PGconn *conn)
948 return build_ext_string (PQtty(P), PG_OS_CODING);
949 else if (EQ (field, Qpqoptions))
950 /* PQoptions Returns the backend options used in the connection.
951 char *PQoptions(PGconn *conn)
953 return build_ext_string (PQoptions(P), PG_OS_CODING);
954 else if (EQ (field, Qpqstatus))
957 /* PQstatus Returns the status of the connection. The status can be
958 CONNECTION_OK or CONNECTION_BAD.
959 ConnStatusType PQstatus(PGconn *conn)
961 switch ((est = PQstatus (P)))
963 case CONNECTION_OK: return Qpg_connection_ok;
964 case CONNECTION_BAD: return Qpg_connection_bad;
965 #ifdef HAVE_POSTGRESQLV7
966 case CONNECTION_STARTED: return Qpg_connection_started;
967 case CONNECTION_MADE: return Qpg_connection_made;
968 case CONNECTION_AWAITING_RESPONSE: return Qpg_connection_awaiting_response;
969 case CONNECTION_AUTH_OK: return Qpg_connection_auth_ok;
970 case CONNECTION_SETENV: return Qpg_connection_setenv;
971 #endif /* HAVE_POSTGRESQLV7 */
973 /* they've added a new field we don't know about */
974 error ("Help! Unknown exec status code %08x from backend!", est);
977 else if (EQ (field, Qpqerrormessage))
978 /* PQerrorMessage Returns the error message most recently generated
979 by an operation on the connection.
980 char *PQerrorMessage(PGconn* conn);
982 return build_ext_string (PQerrorMessage(P), PG_OS_CODING);
983 else if (EQ (field, Qpqbackendpid))
984 /* PQbackendPID Returns the process ID of the backend server handling
986 int PQbackendPID(PGconn *conn);
988 return make_int (PQbackendPID(P));
990 error ("bad PGconn accessor");
993 /* Query functions */
994 DEFUN ("pq-exec", Fpq_exec, 2, 2, 0, /*
995 Submit a query to Postgres and wait for the result.
1000 Lisp_PGresult *lisp_pgresult;
1004 CHECK_PGCONN (conn);
1005 CHECK_STRING (query);
1007 P = (XPGCONN (conn))->pgconn;
1008 CHECK_LIVE_CONNECTION (P);
1010 TO_EXTERNAL_FORMAT (LISP_STRING, query,
1011 C_STRING_ALLOCA, c_query, Qnative);
1013 R = PQexec (P, c_query);
1015 char *tag, buf[BLCKSZ];
1017 if (!R) error ("query: out of memory");
1019 switch (PQresultStatus (R))
1021 case PGRES_BAD_RESPONSE:
1022 tag = "bad response [%s]";
1024 case PGRES_NONFATAL_ERROR:
1025 tag = "non-fatal error [%s]";
1027 case PGRES_FATAL_ERROR:
1028 tag = "fatal error [%s]";
1030 strncpy (buf, PQresultErrorMessage (R), sizeof (buf));
1031 buf [sizeof (buf) - 1] = '\0';
1040 lisp_pgresult = allocate_pgresult ();
1041 lisp_pgresult->pgresult = R;
1043 return make_pgresult (lisp_pgresult);
1046 DEFUN ("pq-send-query", Fpq_send_query, 2, 2, 0, /*
1047 Submit a query to Postgres and don't wait for the result.
1048 Returns: t if successfully submitted
1049 nil if error (conn->errorMessage is set)
1056 CHECK_PGCONN (conn);
1057 CHECK_STRING (query);
1059 P = (XPGCONN (conn))->pgconn;
1060 CHECK_LIVE_CONNECTION (P);
1062 TO_EXTERNAL_FORMAT (LISP_STRING, query,
1063 C_STRING_ALLOCA, c_query, Qnative);
1065 if (PQsendQuery (P, c_query)) return Qt;
1066 else error ("async query: %s", PQerrorMessage (P));
1069 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /*
1070 Retrieve an asynchronous result from a query.
1071 NIL is returned when no more query work remains.
1076 Lisp_PGresult *lisp_pgresult;
1079 CHECK_PGCONN (conn);
1081 P = (XPGCONN (conn))->pgconn;
1082 CHECK_LIVE_CONNECTION (P);
1084 R = PQgetResult (P);
1085 if (!R) return Qnil; /* not an error, there's no more data to get */
1088 char *tag, buf[BLCKSZ];
1090 switch (PQresultStatus (R))
1092 case PGRES_BAD_RESPONSE:
1093 tag = "bad response [%s]";
1095 case PGRES_NONFATAL_ERROR:
1096 tag = "non-fatal error [%s]";
1098 case PGRES_FATAL_ERROR:
1099 tag = "fatal error [%s]";
1101 strncpy (buf, PQresultErrorMessage (R), sizeof (buf));
1102 buf[sizeof (buf) - 1] = '\0';
1111 lisp_pgresult = allocate_pgresult();
1112 lisp_pgresult->pgresult = R;
1114 return make_pgresult (lisp_pgresult);
1117 DEFUN ("pq-result-status", Fpq_result_status, 1, 1, 0, /*
1118 Return result status of the query.
1125 CHECK_PGRESULT (result);
1126 R = (XPGRESULT (result))->pgresult;
1129 switch ((est = PQresultStatus (R))) {
1130 case PGRES_EMPTY_QUERY: return Qpgres_empty_query;
1131 case PGRES_COMMAND_OK: return Qpgres_command_ok;
1132 case PGRES_TUPLES_OK: return Qpgres_tuples_ok;
1133 case PGRES_COPY_OUT: return Qpgres_copy_out;
1134 case PGRES_COPY_IN: return Qpgres_copy_in;
1135 case PGRES_BAD_RESPONSE: return Qpgres_bad_response;
1136 case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error;
1137 case PGRES_FATAL_ERROR: return Qpgres_fatal_error;
1139 /* they've added a new field we don't know about */
1140 error ("Help! Unknown exec status code %08x from backend!", est);
1144 DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /*
1145 Return stringified result status of the query.
1151 CHECK_PGRESULT (result);
1152 R = (XPGRESULT (result))->pgresult;
1155 return build_ext_string (PQresStatus (PQresultStatus (R)), PG_OS_CODING);
1158 /* Sundry PGresult accessor functions */
1159 DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /*
1160 Return last message associated with the query.
1166 CHECK_PGRESULT (result);
1167 R = (XPGRESULT (result))->pgresult;
1170 return build_ext_string (PQresultErrorMessage (R), PG_OS_CODING);
1173 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
1174 Return the number of tuples (instances) in the query result.
1180 CHECK_PGRESULT (result);
1181 R = (XPGRESULT (result))->pgresult;
1184 return make_int (PQntuples (R));
1187 DEFUN ("pq-nfields", Fpq_nfields, 1, 1, 0, /*
1188 Return the number of fields (attributes) in each tuple of the query result.
1194 CHECK_PGRESULT (result);
1195 R = (XPGRESULT (result))->pgresult;
1198 return make_int (PQnfields (R));
1201 DEFUN ("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /*
1202 Return t if the query result contains binary data, nil otherwise.
1208 CHECK_PGRESULT (result);
1209 R = (XPGRESULT (result))->pgresult;
1212 return (PQbinaryTuples (R)) ? Qt : Qnil;
1215 DEFUN ("pq-fname", Fpq_fname, 2, 2, 0, /*
1216 Return the field (attribute) name associated with the given field index.
1217 Field indices start at 0.
1219 (result, field_index))
1223 CHECK_PGRESULT (result);
1224 CHECK_INT (field_index);
1225 R = (XPGRESULT (result))->pgresult;
1228 return build_ext_string (PQfname (R, XINT (field_index)), PG_OS_CODING);
1231 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
1232 Return the number of fields (attributes) in each tuple of the query result.
1234 (result, field_name))
1239 CHECK_PGRESULT (result);
1240 CHECK_STRING (field_name);
1241 R = (XPGRESULT (result))->pgresult;
1244 TO_EXTERNAL_FORMAT (LISP_STRING, field_name,
1245 C_STRING_ALLOCA, c_field_name, Qnative);
1247 return make_int (PQfnumber (R, c_field_name));
1250 DEFUN ("pq-ftype", Fpq_ftype, 2, 2, 0, /*
1251 Return the field type associated with the given field index.
1252 The integer returned is the internal coding of the type. Field indices
1255 (result, field_num))
1259 CHECK_PGRESULT (result);
1260 CHECK_INT (field_num);
1261 R = (XPGRESULT (result))->pgresult;
1264 return make_int (PQftype (R, XINT (field_num)));
1267 DEFUN ("pq-fsize", Fpq_fsize, 2, 2, 0, /*
1268 Return the field size in bytes associated with the given field index.
1269 Field indices start at 0.
1271 (result, field_index))
1275 CHECK_PGRESULT (result);
1276 CHECK_INT (field_index);
1277 R = (XPGRESULT (result))->pgresult;
1280 return make_int (PQftype (R, XINT (field_index)));
1283 DEFUN ("pq-fmod", Fpq_fmod, 2, 2, 0, /*
1284 Return the type modifier associated with a field.
1285 Field indices start at 0.
1287 (result, field_index))
1291 CHECK_PGRESULT (result);
1292 CHECK_INT (field_index);
1293 R = (XPGRESULT (result))->pgresult;
1296 return make_int (PQfmod (R, XINT (field_index)));
1299 DEFUN ("pq-get-value", Fpq_get_value, 3, 3, 0, /*
1300 Return a single field (attribute) value of one tuple of a PGresult.
1301 Tuple and field indices start at 0.
1303 (result, tup_num, field_num))
1307 CHECK_PGRESULT (result);
1308 CHECK_INT (tup_num);
1309 CHECK_INT (field_num);
1310 R = (XPGRESULT (result))->pgresult;
1313 return build_ext_string (PQgetvalue (R, XINT (tup_num), XINT (field_num)),
1317 DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1318 Returns the length of a field value in bytes.
1319 If result is binary, i.e. a result of a binary portal, then the
1320 length returned does NOT include the size field of the varlena. (The
1321 data returned by PQgetvalue doesn't either.)
1323 (result, tup_num, field_num))
1327 CHECK_PGRESULT (result);
1328 CHECK_INT (tup_num);
1329 CHECK_INT (field_num);
1330 R = (XPGRESULT (result))->pgresult;
1333 return make_int (PQgetlength (R, XINT (tup_num), XINT (field_num)));
1336 DEFUN ("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /*
1337 Returns the null status of a field value.
1339 (result, tup_num, field_num))
1343 CHECK_PGRESULT (result);
1344 CHECK_INT (tup_num);
1345 CHECK_INT (field_num);
1346 R = (XPGRESULT (result))->pgresult;
1349 return PQgetisnull (R, XINT (tup_num), XINT (field_num)) ? Qt : Qnil;
1352 DEFUN ("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
1353 Returns the command status string from the SQL command that generated the result.
1359 CHECK_PGRESULT (result);
1360 R = (XPGRESULT (result))->pgresult;
1363 return build_ext_string (PQcmdStatus (R), PG_OS_CODING);
1366 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1367 Returns the number of rows affected by the SQL command
1373 CHECK_PGRESULT (result);
1374 R = (XPGRESULT (result))->pgresult;
1377 return build_ext_string (PQcmdTuples (R), PG_OS_CODING);
1380 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
1381 Returns the object id of the tuple inserted.
1387 CHECK_PGRESULT (result);
1388 R = (XPGRESULT (result))->pgresult;
1391 #ifdef HAVE_POSTGRESQLV7
1392 return make_int (PQoidValue (R));
1394 /* Use the old interface */
1395 return make_int (atoi (PQoidStatus (R)));
1399 #ifdef HAVE_POSTGRESQLV7
1400 DEFUN ("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /*
1401 Sets the PGconn's database connection non-blocking if the arg is TRUE
1402 or makes it non-blocking if the arg is FALSE, this will not protect
1403 you from PQexec(), you'll only be safe when using the non-blocking API.
1405 Needs to be called only on a connected database connection.
1411 CHECK_PGCONN (conn);
1412 P = (XPGCONN (conn))->pgconn;
1413 CHECK_LIVE_CONNECTION (P);
1415 return make_int (PQsetnonblocking (P, !NILP (arg)));
1418 DEFUN ("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
1419 Return the blocking status of the database connection
1425 CHECK_PGCONN (conn);
1426 P = (XPGCONN (conn))->pgconn;
1427 CHECK_LIVE_CONNECTION (P);
1429 return PQisnonblocking (P) ? Qt : Qnil;
1432 DEFUN ("pq-flush", Fpq_flush, 1, 1, 0, /*
1433 Force the write buffer to be written (or at least try)
1439 CHECK_PGCONN (conn);
1440 P = (XPGCONN (conn))->pgconn;
1441 CHECK_LIVE_CONNECTION (P);
1443 return make_int (PQflush (P));
1447 DEFUN ("pq-notifies", Fpq_notifies, 1, 1, 0, /*
1448 Return the latest async notification that has not yet been handled.
1449 If there has been a notification, then a list of two elements will be returned.
1450 The first element contains the relation name being notified, the second
1451 element contains the backend process ID number. nil is returned if there
1452 aren't any notifications to process.
1456 /* This function cannot GC */
1460 CHECK_PGCONN (conn);
1461 P = (XPGCONN (conn))->pgconn;
1462 CHECK_LIVE_CONNECTION (P);
1464 PGN = PQnotifies (P);
1471 temp = list2 (build_ext_string (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid));
1477 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1478 DEFUN ("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
1479 Get encoding id from environment variable PGCLIENTENCODING.
1483 return make_int (PQenv2encoding ());
1487 DEFUN ("pq-lo-import", Fpq_lo_import, 2, 2, 0, /*
1494 CHECK_PGCONN (conn);
1495 CHECK_STRING (filename);
1497 P = (XPGCONN (conn))->pgconn;
1498 CHECK_LIVE_CONNECTION (P);
1500 TO_EXTERNAL_FORMAT (LISP_STRING, filename,
1501 C_STRING_ALLOCA, c_filename,
1504 return make_int ((int)lo_import (P, c_filename));
1507 DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /*
1509 (conn, oid, filename))
1514 CHECK_PGCONN (conn);
1516 CHECK_STRING (filename);
1518 P = (XPGCONN (conn))->pgconn;
1519 CHECK_LIVE_CONNECTION (P);
1521 TO_EXTERNAL_FORMAT (LISP_STRING, filename,
1522 C_STRING_ALLOCA, c_filename, Qfile_name);
1524 return make_int ((int)lo_export (P, XINT (oid), c_filename));
1527 DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /*
1528 Make an empty PGresult object with the given status.
1533 Lisp_PGresult *lpgr;
1537 CHECK_PGCONN (conn);
1538 P = (XPGCONN (conn))->pgconn;
1539 CHECK_LIVE_CONNECTION (P); /* needed here? */
1541 if (EQ (status, Qpgres_empty_query)) est = PGRES_EMPTY_QUERY;
1542 else if (EQ (status, Qpgres_command_ok)) est = PGRES_COMMAND_OK;
1543 else if (EQ (status, Qpgres_tuples_ok)) est = PGRES_TUPLES_OK;
1544 else if (EQ (status, Qpgres_copy_out)) est = PGRES_COPY_OUT;
1545 else if (EQ (status, Qpgres_copy_in)) est = PGRES_COPY_IN;
1546 else if (EQ (status, Qpgres_bad_response)) est = PGRES_BAD_RESPONSE;
1547 else if (EQ (status, Qpgres_nonfatal_error)) est = PGRES_NONFATAL_ERROR;
1548 else if (EQ (status, Qpgres_fatal_error)) est = PGRES_FATAL_ERROR;
1549 else signal_simple_error ("bad status symbol", status);
1551 R = PQmakeEmptyPGresult (P, est);
1552 if (!R) error ("out of memory?");
1554 lpgr = allocate_pgresult ();
1557 return make_pgresult (lpgr);
1560 DEFUN ("pq-get-line", Fpq_get_line, 1, 1, 0, /*
1561 Retrieve a line from server in copy in operation.
1562 The return value is a dotted pair where the cons cell is an integer code:
1563 -1: Copying is complete
1564 0: A record is complete
1565 1: A record is incomplete, it will be continued in the next `pq-get-line'
1567 and the cdr cell is returned string data.
1569 The copy operation is complete when the value `\.' (backslash dot) is
1574 char buffer[BLCKSZ]; /* size of a Postgres disk block */
1578 CHECK_PGCONN (conn);
1579 P = (XPGCONN (conn))->pgconn;
1580 CHECK_LIVE_CONNECTION (P);
1582 ret = PQgetline (P, buffer, sizeof (buffer));
1584 return Fcons (make_int (ret), build_ext_string (buffer, PG_OS_CODING));
1587 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /*
1588 Send a line to the server in copy out operation.
1590 Returns t if the operation succeeded, nil otherwise.
1597 CHECK_PGCONN (conn);
1598 CHECK_STRING (string);
1600 P = (XPGCONN (conn))->pgconn;
1601 CHECK_LIVE_CONNECTION (P);
1602 TO_EXTERNAL_FORMAT (LISP_STRING, string,
1603 C_STRING_ALLOCA, c_string, Qnative);
1605 return !PQputline (P, c_string) ? Qt : Qnil;
1608 DEFUN ("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
1609 Get a line from the server in copy in operation asynchronously.
1611 This routine is for applications that want to do "COPY <rel> to stdout"
1612 asynchronously, that is without blocking. Having issued the COPY command
1613 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
1614 and this routine until the end-of-data signal is detected. Unlike
1615 PQgetline, this routine takes responsibility for detecting end-of-data.
1617 On each call, PQgetlineAsync will return data if a complete newline-
1618 terminated data line is available in libpq's input buffer, or if the
1619 incoming data line is too long to fit in the buffer offered by the caller.
1620 Otherwise, no data is returned until the rest of the line arrives.
1622 If -1 is returned, the end-of-data signal has been recognized (and removed
1623 from libpq's input buffer). The caller *must* next call PQendcopy and
1624 then return to normal processing.
1627 -1 if the end-of-copy-data marker has been recognized
1628 0 if no data is available
1629 >0 the number of bytes returned.
1630 The data returned will not extend beyond a newline character. If possible
1631 a whole line will be returned at one time. But if the buffer offered by
1632 the caller is too small to hold a line sent by the backend, then a partial
1633 data line will be returned. This can be detected by testing whether the
1634 last returned byte is '\n' or not.
1635 The returned string is *not* null-terminated.
1640 char buffer[BLCKSZ];
1643 CHECK_PGCONN (conn);
1645 P = (XPGCONN (conn))->pgconn;
1646 CHECK_LIVE_CONNECTION (P);
1648 ret = PQgetlineAsync (P, buffer, sizeof (buffer));
1650 if (ret == -1) return Qt; /* done! */
1651 else if (!ret) return Qnil; /* no data yet */
1652 else return Fcons (make_int (ret),
1653 make_ext_string (buffer, ret, PG_OS_CODING));
1656 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1657 Asynchronous copy out.
1661 /* NULs are not allowed. I don't think this matters at this time. */
1665 CHECK_PGCONN (conn);
1666 CHECK_STRING (data);
1668 P = (XPGCONN (conn))->pgconn;
1669 CHECK_LIVE_CONNECTION (P);
1670 TO_EXTERNAL_FORMAT (LISP_STRING, data,
1671 C_STRING_ALLOCA, c_data, Qnative);
1673 return !PQputnbytes (P, c_data, strlen (c_data)) ? Qt : Qnil;
1676 DEFUN ("pq-end-copy", Fpq_end_copy, 1, 1, 0, /*
1677 End a copying operation.
1683 CHECK_PGCONN (conn);
1684 P = (XPGCONN (conn))->pgconn;
1685 CHECK_LIVE_CONNECTION (P);
1687 return PQendcopy (P) ? Qt : Qnil;
1690 /* The setenv suite of functions. The author of the libpq manual doesn't
1691 know a whole lot about them, and neither do I.
1693 #if !defined (HAVE_POSTGRESQLV7) || defined (LIBPQ_7_0_IS_FIXED)
1694 DEFUN ("pq-setenv", Fpq_setenv, 1, 1, 0, /*
1695 Set environmental parameters on the backend synchronously.
1696 Returns t if the operation was successful, nil otherwise.
1702 CHECK_PGCONN (conn);
1703 P = (XPGCONN (conn))->pgconn;
1704 CHECK_LIVE_CONNECTION (P);
1706 return PQsetenv (P) ? Qt : Qnil;
1710 #ifdef LIBPQ_7_0_IS_FIXED
1712 DEFUN ("pq-setenv-start", Fpq_setenv_start, 1, 1, 0, /*
1713 Set environmental parameters on the backend asynchronously.
1714 A PGsetenvHandle is returned on success, nil otherwise.
1719 PGsetenvHandle *handle;
1720 Lisp_setenvHandle *lseh;
1722 CHECK_PGCONN (conn);
1723 P = (XPGCONN (conn))->pgconn;
1724 CHECK_LIVE_CONNECTION (P);
1726 handle = PQsetenvStart (P);
1727 if (!handle) error ("out of memory?");
1729 lseh = allocate_pgsetenv ();
1730 lseh->setenv = handle;
1732 return make_pgsetenv (lseh);
1735 DEFUN ("pq-setenv-poll", Fpq_setenv_poll, 1, 1, 0, /*
1736 Poll an asynchronous setenv operation for completion.
1741 PostgresPollingStatusType pst;
1743 CHECK_PGCONN (conn);
1744 P = (XPGCONN (conn))->pgconn;
1745 CHECK_LIVE_CONNECTION (P);
1747 pst = PQsetenvPoll (P);
1750 case PGRES_POLLING_FAILED:
1751 /* Something Bad has happened */
1753 char *e = PQerrorMessage (P);
1754 error ("libpq: %s", e);
1756 case PGRES_POLLING_OK:
1757 return Qpgres_polling_ok;
1758 case PGRES_POLLING_READING:
1759 return Qpgres_polling_reading;
1760 case PGRES_POLLING_WRITING:
1761 return Qpgres_polling_writing;
1762 case PGRES_POLLING_ACTIVE:
1763 return Qpgres_polling_active;
1765 /* they've added a new field we don't know about */
1766 error ("Help! Unknown status code %08x from backend!", PS);
1770 DEFUN ("pq-setenv-abort", Fpq_setenv_abort, 1, 1, 0, /*
1771 Attempt to abort an in-progress asynchronous setenv operation.
1777 CHECK_PGSETENV (handle);
1778 h = (XPGSETENV (handle))->pgsetenv;
1782 /* PQsetenvAbort usually free(3)'s the handle, don't take any chances. */
1783 (XSETENV (handle))->pgsetenv = (PGsetenvHandle *)NULL;
1787 #endif /* LIBPQ_7_0_IS_FIXED */
1790 syms_of_postgresql(void)
1792 #ifndef RUNNING_XEMACS_21_1
1793 INIT_LRECORD_IMPLEMENTATION (pgconn);
1794 INIT_LRECORD_IMPLEMENTATION (pgresult);
1795 #ifdef LIBPQ_7_0_IS_FIXED
1796 INIT_LRECORD_IMPLEMENTATION (pgsetenv);
1799 defsymbol (&Qpostgresql, "postgresql");
1801 /* opaque exported types */
1802 defsymbol (&Qpgconnp, "pgconnp");
1803 defsymbol (&Qpgresultp, "pgresultp");
1805 /* connection status types */
1806 defsymbol (&Qpg_connection_ok, "pg::connection-ok");
1807 defsymbol (&Qpg_connection_bad, "pg::connection-bad");
1808 defsymbol (&Qpg_connection_started, "pg::connection-started");
1809 defsymbol (&Qpg_connection_made, "pg::connection-made");
1810 defsymbol (&Qpg_connection_awaiting_response, "pg::connection-awaiting-response");
1811 defsymbol (&Qpg_connection_auth_ok, "pg::connection-auth-ok");
1812 defsymbol (&Qpg_connection_setenv, "pg::connection-setenv");
1814 /* Fields of PGconn */
1815 defsymbol (&Qpqdb, "pq::db");
1816 defsymbol (&Qpquser, "pq::user");
1817 defsymbol (&Qpqpass, "pq::pass");
1818 defsymbol (&Qpqhost, "pq::host");
1819 defsymbol (&Qpqport, "pq::port");
1820 defsymbol (&Qpqtty, "pq::tty");
1821 defsymbol (&Qpqoptions, "pq::options");
1822 defsymbol (&Qpqstatus, "pq::status");
1823 defsymbol (&Qpqerrormessage, "pq::error-message");
1824 defsymbol (&Qpqbackendpid, "pq::backend-pid");
1826 /* Query status results */
1827 defsymbol (&Qpgres_empty_query, "pgres::empty-query");
1828 defsymbol (&Qpgres_command_ok, "pgres::command-ok");
1829 defsymbol (&Qpgres_tuples_ok, "pgres::tuples-ok");
1830 defsymbol (&Qpgres_copy_out, "pgres::copy-out");
1831 defsymbol (&Qpgres_copy_in, "pgres::copy-in");
1832 defsymbol (&Qpgres_bad_response, "pgres::bad-response");
1833 defsymbol (&Qpgres_nonfatal_error, "pgres::nonfatal-error");
1834 defsymbol (&Qpgres_fatal_error, "pgres::fatal-error");
1836 /* Poll status results */
1837 defsymbol (&Qpgres_polling_failed, "pgres::polling-failed");
1838 defsymbol (&Qpgres_polling_reading, "pgres::polling-reading");
1839 defsymbol (&Qpgres_polling_writing, "pgres::polling-writing");
1840 defsymbol (&Qpgres_polling_ok, "pgres::polling-ok");
1841 defsymbol (&Qpgres_polling_active, "pgres::polling-active");
1843 #ifdef HAVE_POSTGRESQLV7
1844 DEFSUBR (Fpq_connect_start);
1845 DEFSUBR (Fpq_connect_poll);
1847 DEFSUBR (Fpq_client_encoding);
1848 DEFSUBR (Fpq_set_client_encoding);
1850 #endif /* HAVE_POSTGRESQLV7 */
1851 DEFSUBR (Fpq_conn_defaults);
1852 DEFSUBR (Fpq_connectdb);
1853 DEFSUBR (Fpq_finish);
1854 DEFSUBR (Fpq_clear);
1855 DEFSUBR (Fpq_is_busy);
1856 DEFSUBR (Fpq_consume_input);
1858 DEFSUBR (Fpq_reset);
1859 #ifdef HAVE_POSTGRESQLV7
1860 DEFSUBR (Fpq_reset_start);
1861 DEFSUBR (Fpq_reset_poll);
1863 DEFSUBR (Fpq_request_cancel);
1864 DEFSUBR (Fpq_pgconn);
1867 DEFSUBR (Fpq_send_query);
1868 DEFSUBR (Fpq_get_result);
1869 DEFSUBR (Fpq_result_status);
1870 DEFSUBR (Fpq_res_status);
1871 DEFSUBR (Fpq_result_error_message);
1872 DEFSUBR (Fpq_ntuples);
1873 DEFSUBR (Fpq_nfields);
1874 DEFSUBR (Fpq_binary_tuples);
1875 DEFSUBR (Fpq_fname);
1876 DEFSUBR (Fpq_fnumber);
1877 DEFSUBR (Fpq_ftype);
1878 DEFSUBR (Fpq_fsize);
1881 DEFSUBR (Fpq_get_value);
1882 DEFSUBR (Fpq_get_length);
1883 DEFSUBR (Fpq_get_is_null);
1884 DEFSUBR (Fpq_cmd_status);
1885 DEFSUBR (Fpq_cmd_tuples);
1886 DEFSUBR (Fpq_oid_value);
1888 #ifdef HAVE_POSTGRESQLV7
1889 DEFSUBR (Fpq_set_nonblocking);
1890 DEFSUBR (Fpq_is_nonblocking);
1891 DEFSUBR (Fpq_flush);
1893 DEFSUBR (Fpq_notifies);
1895 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1896 DEFSUBR (Fpq_env_2_encoding);
1899 DEFSUBR (Fpq_lo_import);
1900 DEFSUBR (Fpq_lo_export);
1902 DEFSUBR (Fpq_make_empty_pgresult);
1904 /* copy in/out functions */
1905 DEFSUBR (Fpq_get_line);
1906 DEFSUBR (Fpq_put_line);
1907 DEFSUBR (Fpq_get_line_async);
1908 DEFSUBR (Fpq_put_nbytes);
1909 DEFSUBR (Fpq_end_copy);
1911 /* The value of the setenv functions is questioned in the libpq manual. */
1912 #if !defined (HAVE_POSTGRESQLV7) || defined (LIBPQ_7_0_IS_FIXED)
1913 DEFSUBR (Fpq_setenv);
1915 #ifdef LIBPQ_7_0_IS_FIXED
1916 DEFSUBR (Fpq_setenv_start);
1917 DEFSUBR (Fpq_setenv_poll);
1918 DEFSUBR (Fpq_setenv_abort);
1919 #endif /* LIBPQ_7_0_IS_FIXED */
1923 vars_of_postgresql(void)
1927 Fprovide (Qpostgresql);
1928 #ifdef HAVE_POSTGRESQLV7
1929 Fprovide (intern ("postgresqlv7"));
1931 #ifndef RUNNING_XEMACS_21_1
1932 Vpg_coding_system = Qnative;
1933 DEFVAR_LISP ("pg-coding-system", &Vpg_coding_system /*
1934 Default Postgres client coding system.
1938 if ((p = getenv ("PGHOST")))
1940 VXPGHOST = build_ext_string (p, PG_OS_CODING);
1946 DEFVAR_LISP ("pg:host", &VXPGHOST /*
1947 Default PostgreSQL server name.
1948 If not set, the server running on the local host is used. The
1949 initial value is set from the PGHOST environment variable.
1952 if ((p = getenv ("PGUSER")))
1954 VXPGUSER = build_ext_string (p, PG_OS_CODING);
1960 DEFVAR_LISP ("pg:user", &VXPGUSER /*
1961 Default PostgreSQL user name.
1962 This value is used when connecting to a database for authentication.
1963 The initial value is set from the PGUSER environment variable.
1966 if ((p = getenv ("PGOPTIONS")))
1968 VXPGOPTIONS = build_ext_string (p, PG_OS_CODING);
1974 DEFVAR_LISP ("pg:options", &VXPGOPTIONS /*
1975 Default PostgreSQL user name.
1976 This value is used when connecting to a database for authentication.
1977 The initial value is set from the PGUSER environment variable.
1980 if ((p = getenv ("PGPORT")))
1982 VXPGPORT = make_int (atoi (p));
1988 DEFVAR_LISP ("pg:port", &VXPGPORT /*
1989 Default port to connect to PostgreSQL backend.
1990 This value is used when connecting to a database.
1991 The initial value is set from the PGPORT environment variable.
1994 if ((p = getenv ("PGTTY")))
1996 VXPGTTY = build_ext_string (p, PG_OS_CODING);
2002 DEFVAR_LISP ("pg:tty", &VXPGTTY /*
2003 Default debugging TTY.
2004 There is no useful setting of this variable in the XEmacs Lisp API.
2005 The initial value is set from the PGTTY environment variable.
2008 if ((p = getenv ("PGDATABASE")))
2010 VXPGDATABASE = build_ext_string (p, PG_OS_CODING);
2014 VXPGDATABASE = Qnil;
2016 DEFVAR_LISP ("pg:database", &VXPGDATABASE /*
2017 Default database to connect to.
2018 The initial value is set from the PGDATABASE environment variable.
2021 if ((p = getenv ("PGREALM")))
2023 VXPGREALM = build_ext_string (p, PG_OS_CODING);
2029 DEFVAR_LISP ("pg:realm", &VXPGREALM /*
2030 Default kerberos realm to use for authentication.
2031 The initial value is set from the PGREALM environment variable.
2035 /* It's not clear whether this is any use. My intent is to
2036 autodetect the coding system from the database. */
2037 if ((p = getenv ("PGCLIENTENCODING")))
2039 VXPGCLIENTENCODING = build_ext_string (p, PG_OS_CODING);
2043 VXPGCLIENTENCODING = Qnil;
2045 DEFVAR_LISP ("pg:client-encoding", &VXPGCLIENTENCODING /*
2046 Default client encoding to use.
2047 The initial value is set from the PGCLIENTENCODING environment variable.
2051 #if !defined(HAVE_POSTGRESQLV7)
2052 if ((p = getenv ("PGAUTHTYPE")))
2054 VXPGAUTHTYPE = build_ext_string (p, PG_OS_CODING);
2058 VXPGAUTHTYPE = Qnil;
2060 DEFVAR_LISP ("pg:authtype", &VXPGAUTHTYPE /*
2061 Default authentication to use.
2062 The initial value is set from the PGAUTHTYPE environment variable.
2064 WARNING: This variable has gone away in versions of PostgreSQL newer
2069 if ((p = getenv ("PGGEQO")))
2071 VXPGGEQO = build_ext_string (p, PG_OS_CODING);
2077 DEFVAR_LISP ("pg:geqo", &VXPGGEQO /*
2078 Genetic Query Optimizer options.
2079 The initial value is set from the PGGEQO environment variable.
2082 if ((p = getenv ("PGCOSTINDEX")))
2084 VXPGCOSTINDEX = build_ext_string (p, PG_OS_CODING);
2088 VXPGCOSTINDEX = Qnil;
2090 DEFVAR_LISP ("pg:cost-index", &VXPGCOSTINDEX /*
2091 Default cost index options.
2092 The initial value is set from the PGCOSTINDEX environment variable.
2095 if ((p = getenv ("PGCOSTHEAP")))
2097 VXPGCOSTHEAP = build_ext_string (p, PG_OS_CODING);
2101 VXPGCOSTHEAP = Qnil;
2103 DEFVAR_LISP ("pg:cost-heap", &VXPGCOSTHEAP /*
2104 Default cost heap options.
2105 The initial value is set from the PGCOSTHEAP environment variable.
2108 if ((p = getenv ("PGTZ")))
2110 VXPGTZ = build_ext_string (p, PG_OS_CODING);
2116 DEFVAR_LISP ("pg:tz", &VXPGTZ /*
2117 Default timezone to use.
2118 The initial value is set from the PGTZ environment variable.
2121 if ((p = getenv ("PGDATESTYLE")))
2123 VXPGDATESTYLE = build_ext_string (p, PG_OS_CODING);
2127 VXPGDATESTYLE = Qnil;
2129 DEFVAR_LISP ("pg:date-style", &VXPGDATESTYLE /*
2130 Default date style to use.
2131 The initial value is set from the PGDATESTYLE environment variable.