1 /** postgresql.c -- elisp binding to libpq.so
3 * Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
4 * Copyright (C) 2005-2008 Sebastian Freundt <hroptatyr@sxemacs.org>
6 * Original author: SL Baur <steve@beopen.com>
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted provided that the following conditions
13 * 1. Redistributions of source code must retain the above copyright
14 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
20 * 3. Neither the name of the author nor the names of any contributors
21 * may be used to endorse or promote products derived from this
22 * software without specific prior written permission.
24 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
28 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
31 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
33 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
34 * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 * This file is part of SXEmacs.
41 Implementation notes (written by Steve Baur):
42 0. Supported PostgreSQL versions
43 This code was developed against libpq-8.0.1 and libpq-8.1.0-CVS. Earlier
44 versions do work. V7 support is more complete than V6.5 support.
45 V8 support is currently experimental.
47 Non-ASCII databases have been tested on 6.5, 7.3, 7.4 and 8.0.
48 2. Asynchronous Operation
49 Starting with libpq-7.0, an asynchronous interface is offered. This
50 binding supports the asynchronous calls to a limited extent. Since the
51 SXEmacs 22.1 core does not support a sensible interface to add managed but
52 unreadable (by SXEmacs) file descriptors to the main select code, polling
53 is required to drive the asynchronous calls. XtAppAddInput would work
54 fine, but we want to be able to use the database when running strictly in
57 Various calls have been deliberately not exported to Lisp. The
58 unexported calls are either left-over backwards compatibility code that
59 aren't needed, calls that cannot be implemented sensibly, or calls that
60 cannot be implemented safely. A list of all global functions in libpq
61 but not exported to Lisp is below.
63 This interface tries very hard to not set any policy towards how database
64 code in Emacs Lisp will be written.
66 For full lisp programming documentation, see the SXEmacs Lisp Reference
67 Manual. For PostgreSQL documentation, see the PostgreSQL distribution.
69 TODO (in rough order of priority):
70 1. The large object interface needs work with Emacs buffers in addition
71 to files. Need two functions buffer->large_object, and large_object->
74 - PQprepare, PQexecPrepared
77 - PQftable, PQftablecol, PQfformat
80 - PQsendPrepare, PQsendQueryPrepared
81 - PQgetCancel, PQfreeCancel, PQcancel, PQrequestCancel
83 - PQputCopyData, PQputCopyEnd, PQgetCopyData
89 Unimplemented functions: [TODO]
90 PQsetNoticeProcessor - done 2005/05/03 hroptatyr
92 Unsupported functions:
93 PQsetdbLogin -- This function is deprecated, has a subset of the
94 functionality of PQconnectdb, and is better done in Lisp.
95 -- and I say, no it is not! I hate the single string interface!
96 PQsetdb -- Same as for PQsetdbLogin
97 -- same as my comment there :)
98 PQsocket -- Abstraction error, file descriptors should not be leaked
100 PQprint -- print to a file descriptor, deprecated, better done in Lisp
101 PQdisplayTuples -- deprecated
102 PQprintTuples -- really, really deprecated
103 PQmblen -- Returns the length in bytes of multibyte character encoded
105 PQtrace -- controls debug print tracing to a tty.
106 PQuntrace -- Ditto. I don't see any way to do this sensibly.
107 PQoidStatus -- deprecated and nearly identical to PQoidValue
108 PQfn -- "Fast path" interface; This is a trapdoor into system internals
109 and can be a potential security hole.
110 Most users will not need this feature.
112 lo_open (large object) [*]
113 lo_close (large object) [*]
114 lo_read (large object) [*]
115 lo_write (large object) [*]
116 lo_lseek (large object) [*]
117 lo_creat (large object) [*]
118 lo_tell (large object) [*]
119 lo_unlink (large object) [*]
126 #include "postgresql.h"
133 #define PG_OS_CODING Fget_coding_system(Vpg_coding_system)
135 #define PG_OS_CODING Qnative
137 Lisp_Object Vpg_coding_system;
139 #define CHECK_CONNECTION_ALIVE(P) \
141 PQstatus(P) != CONNECTION_OK) { \
142 char *e = "bad value"; \
144 e = PQerrorMessage(P); \
146 error("dead connection [%s]", e); \
148 #define CHECK_CONNECTION_ELIGIBLE(P) \
150 PQstatus(P) == CONNECTION_BAD) { \
151 char *e = "bad value"; \
153 e = PQerrorMessage(P); \
155 error("dead connection [%s]", e); \
157 #define PUKE_IF_NULL(p) \
159 error ("bad value"); \
162 static Lisp_Object VXPGHOST;
163 static Lisp_Object VXPGUSER;
164 static Lisp_Object VXPGOPTIONS;
165 static Lisp_Object VXPGPORT;
166 static Lisp_Object VXPGTTY; /* This needs to be blanked! */
167 static Lisp_Object VXPGDATABASE;
168 static Lisp_Object VXPGREALM;
170 static Lisp_Object VXPGCLIENTENCODING;
174 PGAUTHTYPE -- not used after PostgreSQL 6.5
181 #ifndef HAVE_POSTGRESQLV7
182 static Lisp_Object VXPGAUTHTYPE;
184 static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE;
186 static Lisp_Object Qpostgresql;
187 static Lisp_Object Q_pg_connection_ok, Q_pg_connection_bad;
188 static Lisp_Object Q_pg_connection_started, Q_pg_connection_made;
189 static Lisp_Object Q_pg_connection_awaiting_response, Q_pg_connection_auth_ok;
190 static Lisp_Object Q_pg_connection_setenv;
193 static Lisp_Object Q_pg_trans_idle, Q_pg_trans_active, Q_pg_trans_intrans;
194 static Lisp_Object Q_pg_trans_inerror, Q_pg_trans_unknown;
196 static Lisp_Object Q_pq_db, Q_pq_user, Q_pq_pass, Q_pq_host, Q_pq_port;
197 static Lisp_Object Q_pq_tty;
198 static Lisp_Object Q_pq_options, Q_pq_error_message, Q_pq_backend_pid;
199 static Lisp_Object Q_pq_status, Q_pq_transaction_status, Q_pq_parameter_status;
200 static Lisp_Object Q_pq_protocol_version, Q_pq_server_version;
202 static Lisp_Object Q_pq_getssl;
205 static Lisp_Object Q_pgres_empty_query, Q_pgres_command_ok, Q_pgres_tuples_ok;
206 static Lisp_Object Q_pgres_copy_out, Q_pgres_copy_in, Q_pgres_bad_response;
207 static Lisp_Object Q_pgres_nonfatal_error, Q_pgres_fatal_error;
209 static Lisp_Object Q_pgres_polling_failed, Q_pgres_polling_reading;
210 static Lisp_Object Q_pgres_polling_writing, Q_pgres_polling_ok;
211 static Lisp_Object Q_pgres_polling_active;
214 /* PGconn is an opaque object and we need to be able to store them in
215 Lisp code because libpq supports multiple connections.
217 Lisp_Object Qpgconnp;
219 static Lisp_Object make_pgconn(Lisp_PGconn * pgconn)
221 Lisp_Object lisp_pgconn;
222 XSETPGCONN(lisp_pgconn, pgconn);
227 mark_pgconn(Lisp_Object obj)
233 print_pgconn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
238 char *host = "", *db = "", *user = "", *port = "";
240 P = (XPGCONN(obj))->pgconn;
243 /* this may happen since we allow PQfinish() to be called */
244 strncpy(buf, "#<PGconn DEAD>", countof(buf));
245 } else if ((cst = PQstatus(P)) == CONNECTION_OK) {
246 if (!(host = PQhost(P)))
250 if (!(user = PQuser(P))) {
253 snprintf(buf, sizeof(buf), "#<PGconn %s:%s %s/%s>", /* evil! */
254 !strlen(host) ? "localhost" : host, port, user, db);
255 } else if (cst == CONNECTION_BAD) {
256 strncpy(buf, "#<PGconn BAD>", countof(buf));
258 strncpy(buf, "#<PGconn connecting>", countof(buf));
260 write_c_string(buf, printcharfun);
265 allocate_pgconn(void)
267 Lisp_PGconn *pgconn =
268 alloc_lcrecord_type(Lisp_PGconn, &lrecord_pgconn);
269 pgconn->pgconn = (PGconn *) NULL;
274 finalize_pgconn(void *header, int for_disksave)
276 Lisp_PGconn *pgconn = (Lisp_PGconn *) header;
280 ("Can't dump an emacs containing PGconn objects",
281 make_pgconn(pgconn));
284 if (pgconn->pgconn) {
285 PQfinish(pgconn->pgconn);
286 pgconn->pgconn = (PGconn *) NULL;
290 DEFINE_LRECORD_IMPLEMENTATION("pgconn", pgconn,
291 mark_pgconn, print_pgconn, finalize_pgconn,
292 NULL, NULL, 0, Lisp_PGconn);
295 /* PGresult is an opaque object and we need to be able to store them in
298 Lisp_Object Qpgresultp;
301 make_pgresult(Lisp_PGresult * pgresult)
303 Lisp_Object lisp_pgresult;
304 XSETPGRESULT(lisp_pgresult, pgresult);
305 return lisp_pgresult;
309 mark_pgresult(Lisp_Object obj)
314 #define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>"
315 #define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>"
316 #define RESULT_DEFAULT_FMT "#<PGresult %s - %s>"
319 print_pgresult(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
324 res = (XPGRESULT(obj))->pgresult;
327 switch (PQresultStatus(res)) {
328 case PGRES_TUPLES_OK:
329 /* Add number of tuples of result to output */
330 snprintf(buf, countof(buf), RESULT_TUPLES_FMT,
331 PQresStatus(PQresultStatus(res)),
332 PQntuples(res), PQcmdStatus(res));
334 case PGRES_COMMAND_OK:
335 /* Add number of tuples affected by output-less
337 if (!strlen(PQcmdTuples(res)))
339 snprintf(buf, countof(buf), RESULT_CMD_TUPLES_FMT,
340 PQresStatus(PQresultStatus(res)),
341 PQcmdTuples(res), PQcmdStatus(res));
345 /* No counts to print */
346 snprintf(buf, countof(buf), RESULT_DEFAULT_FMT,
347 PQresStatus(PQresultStatus(res)),
352 strncpy(buf, "#<PGresult DEAD>", countof(buf));
355 write_c_string(buf, printcharfun);
359 #undef RESULT_TUPLES_FMT
360 #undef RESULT_CMD_TUPLES_FMT
361 #undef RESULT_DEFAULT_FMT
363 static Lisp_PGresult*
364 allocate_pgresult(void)
366 Lisp_PGresult *pgresult = alloc_lcrecord_type(
367 Lisp_PGresult, &lrecord_pgresult);
368 pgresult->pgresult = (PGresult *) NULL;
373 finalize_pgresult(void *header, int for_disksave)
375 Lisp_PGresult *pgresult = (Lisp_PGresult *) header;
379 ("Can't dump an emacs containing PGresult objects",
380 make_pgresult(pgresult));
383 if (pgresult->pgresult) {
384 PQclear(pgresult->pgresult);
385 pgresult->pgresult = (PGresult *) NULL;
389 DEFINE_LRECORD_IMPLEMENTATION("pgresult", pgresult,
390 mark_pgresult, print_pgresult, finalize_pgresult,
391 NULL, NULL, 0, Lisp_PGresult);
393 /***********************/
395 /* Notice Processor Stuff */
396 /* Okay, let's imagine how such a notice processor wants to look like.
397 * The only sensible thing I can imagine is a defun (like a sentinel for
401 sxemacs_notice_processor(Lisp_PGconn *conn, const char *msg)
403 /* (Lisp_PGconn *)conn; */
405 /* void *arg is my sentinel function */
406 Lisp_Object sentinel = conn->notice_processor;
409 warn_when_safe(Qpostgresql, Qnotice, "%s", msg);
411 running_asynch_code = 1;
412 call2_trapping_errors("Error in notice processor",
413 sentinel, make_pgconn(conn),
415 running_asynch_code = 0;
419 /* HOWTO evoke notices:
420 * (let ((res (pq-exec <conn> "SELECT * FROM <sometable> LIMIT 0")))
421 * (pq-get-is-null res 0 0))
423 * msg <- `row number 0 is out of range 0..-1'
425 DEFUN("pq-set-notice-processor", Fpq_set_notice_processor, 2, 2, 0, /*
426 Give CONN the notice processor SENTINEL; nil for none.
427 The notice processor is called as a function whenever the pq backend
429 It gets two arguments: the connection, and a message string.
435 XPGCONN(conn)->notice_processor = sentinel;
441 /* There are four ways (as of PostgreSQL v7) to connect to a database.
442 Two of them, PQsetdb and PQsetdbLogin, are deprecated. Both of those
443 routines take a number of positional parameters and are better done in Lisp.
444 Note that PQconnectStart does not exist prior to v7.
447 DEFUN("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /*
448 Return a connection default structure.
452 /* This function can GC */
453 PQconninfoOption *pcio;
454 Lisp_Object temp, temp1;
457 /* WHAT A FOOKING MESS! */
458 pcio = PQconndefaults();
460 return Qnil; /* can never happen in libpq-7.0 */
461 temp = list1(Fcons(build_ext_string(pcio[0].keyword, PG_OS_CODING),
462 Fcons(build_ext_string(pcio[0].envvar, PG_OS_CODING),
463 Fcons(build_ext_string
464 (pcio[0].compiled, PG_OS_CODING),
465 Fcons(build_ext_string
466 (pcio[0].val, PG_OS_CODING),
467 Fcons(build_ext_string
470 Fcons(build_ext_string
478 for (i = 1; pcio[i].keyword; i++) {
481 (build_ext_string(pcio[i].keyword, PG_OS_CODING),
482 Fcons(build_ext_string(pcio[i].envvar, PG_OS_CODING),
483 Fcons(build_ext_string
484 (pcio[i].compiled, PG_OS_CODING),
485 Fcons(build_ext_string
486 (pcio[i].val, PG_OS_CODING),
487 Fcons(build_ext_string
490 Fcons(build_ext_string
501 /* Fappend GCPROs its arguments */
502 temp = Fappend(2, args);
509 /* PQconnectdb Makes a new connection to a backend.
510 PGconn *PQconnectdb(const char *conninfo)
513 DEFUN("pq-connectdb", Fpq_connectdb, 1, 1, 0, /*
514 Open and return a new database connection using the parameters from the
517 Unlike `pq-set-db-login' below, the parameter set can be extended without
518 changing the function signature, so use of this function (or its nonblocking
519 analogues `pq-connect-start' and `pq-connect-poll') is preferred for new
520 application programming.
522 The passed string can be empty to use all default parameters, or it can
523 contain one or more parameter settings separated by whitespace. Each
524 parameter setting is in the form `keyword = value'. Spaces around the equal
525 sign are optional. To write an empty value or a value containing spaces,
526 surround it with single quotes, e.g., `keyword = \'a value\''. Single
527 quotes and backslashes within the value must be escaped with a backslash,
530 The currently recognized parameter key words are:
534 Name of host to connect to. If this begins with a slash, it specifies
535 Unix-domain communication rather than TCP/IP communication; the value is the
536 name of the directory in which the socket file is stored.
538 The default behaviour when `host' is not specified is to connect to a
539 Unix-domain socket in /tmp (or whatever socket directory was specified when
540 PostgreSQL was built).
542 On machines without Unix-domain sockets, the default is to connect to
548 Numeric IP address of host to connect to. This should be in the standard
549 IPv4 address format, e.g., 172.28.40.9.
551 If your machine supports IPv6, you can also use those addresses.
553 TCP/IP communication is always used when a nonempty string is specified for
556 Using `hostaddr' instead of `host' allows the application to avoid a host
557 name look-up, which may be important in applications with time constraints.
558 However, Kerberos authentication requires the host name.
560 The following therefore applies:
561 - If `host' is specified without `hostaddr' a host name lookup occurs.
562 - If `hostaddr' is specified without `host' the value for `hostaddr' gives
564 - When Kerberos is used, a reverse name query occurs to obtain the host
566 - If both `host' and `hostaddr' are specified, the value for `hostaddr'
567 gives the remote address; the value for `host' is ignored, unless
568 Kerberos is used, in which case that value is used for Kerberos
571 Note: Authentication is likely to fail if libpq is passed a host name that
572 is not the name of the machine at `hostaddr'.
573 Also, `host' rather than `hostaddr' is used to identify the connection in
577 Without either a host name or host address, libpq will connect using a local
578 Unix-domain socket; or on machines without Unix-domain sockets, it will
579 attempt to connect to localhost.
584 Port number to connect to at the server host, or socket file name extension
585 for Unix-domain connections.
591 Defaults to be the same as the user name.
596 PostgreSQL user name to connect as.
597 Defaults to be the same as the operating system name of the user running the
603 Password to be used if the server demands password authentication.
608 Maximum wait for connection, in seconds (write as a decimal integer string).
609 Zero or not specified means wait indefinitely.
610 It is not recommended to use a timeout of less than 2 seconds.
615 Command-line options to be sent to the server.
620 Ignored (formerly, this specified where to send server debug output).
625 This option determines whether or with what priority an SSL connection will
626 be negotiated with the server.
627 There are four modes:
628 - `disable' will attempt only an unencrypted SSL connection;
629 - `allow' will negotiate, trying first a non-SSL connection, then if that
630 fails, trying an SSL connection;
631 - `prefer' (the default) will negotiate, trying first an SSL connection,
632 then if that fails, trying a regular non-SSL connection;
633 - `require' will try only an SSL connection.
635 Note: If PostgreSQL is compiled without SSL support, using option require
636 will cause an error, while options allow and prefer will be accepted but
637 libpq will not in fact attempt an SSL connection.
641 This option is deprecated in favour of the sslmode setting.
643 If set to 1, an SSL connection to the server is required (this is equivalent
644 to sslmode require). libpq will then refuse to connect if the server does
645 not accept an SSL connection.
646 If set to 0 (default), libpq will negotiate the connection type with the
647 server (equivalent to sslmode prefer).
649 This option is only available if PostgreSQL is compiled with SSL support.
654 Service name to use for additional parameters.
655 It specifies a service name in pg_service.conf that holds additional
656 connection parameters. This allows applications to specify only a service
657 name so connection parameters can be centrally maintained.
658 See share/pg_service.conf.sample in the installation directory for
659 information on how to set up the file.
662 If any parameter is unspecified, then the corresponding environment variable
663 is checked. If the environment variable is not set either, then the
664 indicated built-in defaults are used.
669 Lisp_PGconn *lisp_pgconn;
670 char *error_message = "Out of Memory?";
675 CHECK_STRING(conninfo);
677 TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
678 C_STRING_ALLOCA, c_conninfo, Qnative);
679 P = PQconnectdb(c_conninfo);
680 if (P && (PQstatus(P) == CONNECTION_OK)) {
681 lisp_pgconn = allocate_pgconn();
682 lisp_pgconn->pgconn = P;
683 lisp_pgconn->notice_processor = Qnil;
684 conn = make_pgconn(lisp_pgconn);
687 (PQnoticeProcessor)sxemacs_notice_processor,
688 /* this is stupid, but libpq wants a void pointer */
689 (Lisp_PGconn *)lisp_pgconn);
692 /* Connection failed. Destroy the connection and signal an
695 strncpy(buf, error_message, sizeof(buf)-1);
696 buf[sizeof(buf) - 1] = '\0';
698 /* storage for the error message gets erased when
700 /* so we must temporarily stash it somewhere */
701 strncpy(buf, PQerrorMessage(P), sizeof(buf)-1);
702 buf[sizeof(buf) - 1] = '\0';
705 error("libpq: %s", buf);
709 /* PQconnectStart Makes a new asynchronous connection to a backend.
710 PGconn *PQconnectStart(const char *conninfo)
713 #ifdef HAVE_POSTGRESQLV7
714 DEFUN("pq-connect-start", Fpq_connect_start, 1, 1, 0, /*
715 Make a new asynchronous connection to a PostgreSQL backend.
717 See `pq-connectdb' for a complete description of conninfo.
722 Lisp_PGconn *lisp_pgconn;
723 char *error_message = "Out of Memory?";
728 CHECK_STRING(conninfo);
729 TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
730 C_STRING_ALLOCA, c_conninfo, Qnative);
731 P = PQconnectStart(c_conninfo);
733 if (P && (PQstatus(P) != CONNECTION_BAD)) {
734 lisp_pgconn = allocate_pgconn();
735 lisp_pgconn->pgconn = P;
736 lisp_pgconn->notice_processor = Qnil;
737 conn = make_pgconn(lisp_pgconn);
740 (PQnoticeProcessor)sxemacs_notice_processor,
744 /* capture the error message before destroying the object */
746 strncpy(buf, error_message, sizeof(buf)-1);
747 buf[sizeof(buf) - 1] = '\0';
749 strncpy(buf, PQerrorMessage(P), sizeof(buf)-1);
750 buf[sizeof(buf) - 1] = '\0';
753 error("libpq: %s", buf);
758 DEFUN("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
759 Poll an asynchronous connection for completion
764 PostgresPollingStatusType polling_status;
768 P = (XPGCONN(conn))->pgconn;
769 CHECK_CONNECTION_ELIGIBLE(P);
771 polling_status = PQconnectPoll(P);
772 switch (polling_status) {
773 case PGRES_POLLING_FAILED:
774 /* Something Bad has happened */
776 char *e = PQerrorMessage(P);
777 error("libpq: %s", e);
779 case PGRES_POLLING_OK:
780 return Q_pgres_polling_ok;
781 case PGRES_POLLING_READING:
782 return Q_pgres_polling_reading;
783 case PGRES_POLLING_WRITING:
784 return Q_pgres_polling_writing;
785 case PGRES_POLLING_ACTIVE:
786 return Q_pgres_polling_active;
788 /* they've added a new field we don't know about */
789 error("Help! Unknown status code %08x from backend!",
795 DEFUN("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /*
796 Return client coding system.
803 P = (XPGCONN(conn))->pgconn;
804 CHECK_CONNECTION_ALIVE(P);
806 return make_int(PQclientEncoding(P));
809 DEFUN("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /*
810 Set client coding system.
819 CHECK_STRING(encoding);
821 P = (XPGCONN(conn))->pgconn;
822 CHECK_CONNECTION_ALIVE(P);
824 TO_EXTERNAL_FORMAT(LISP_STRING, encoding,
825 C_STRING_ALLOCA, c_encoding, Qnative);
827 if ((rc = PQsetClientEncoding(P, c_encoding)) < 0)
828 error("bad encoding");
834 #endif /* HAVE_POSTGRESQLV7 */
836 /* PQfinish Close the connection to the backend. Also frees memory
837 used by the PGconn object.
838 void PQfinish(PGconn *conn)
840 DEFUN("pq-finish", Fpq_finish, 1, 1, 0, /*
841 Close the connection to the backend.
848 P = (XPGCONN(conn))->pgconn;
852 /* #### PQfinish deallocates the PGconn structure, so we now have a
854 /* Genocided all @'s ... */
855 (XPGCONN(conn))->pgconn = (PGconn *) NULL; /* You feel DEAD inside */
859 DEFUN("pq-clear", Fpq_clear, 1, 1, 0, /*
860 Forcibly erase a PGresult object.
867 R = (XPGRESULT(res))->pgresult;
871 /* Genocided all @'s ... */
872 (XPGRESULT(res))->pgresult = (PGresult *) NULL; /* You feel DEAD inside */
877 DEFUN("pq-is-busy", Fpq_is_busy, 1, 1, 0, /*
878 Return t if PQgetResult would block waiting for input.
885 P = (XPGCONN(conn))->pgconn;
886 CHECK_CONNECTION_ALIVE(P);
888 return PQisBusy(P) ? Qt : Qnil;
891 DEFUN("pq-consume-input", Fpq_consume_input, 1, 1, 0, /*
892 Consume any available input from the backend.
893 Returns nil if something bad happened.
900 P = (XPGCONN(conn))->pgconn;
901 CHECK_CONNECTION_ALIVE(P);
903 return PQconsumeInput(P) ? Qt : Qnil;
906 /* PQreset Reset the communication port with the backend.
907 void PQreset(PGconn *conn)
909 DEFUN("pq-reset", Fpq_reset, 1, 1, 0, /*
910 Reset the connection to the backend.
911 This function will close the connection to the backend and attempt to
912 reestablish a new connection to the same postmaster, using all the same
913 parameters previously used. This may be useful for error recovery if a
914 working connection is lost.
921 P = (XPGCONN(conn))->pgconn;
923 /* we can resurrect a BAD connection, but not a dead one. */
930 #ifdef HAVE_POSTGRESQLV7
931 DEFUN("pq-reset-start", Fpq_reset_start, 1, 1, 0, /*
932 Reset connection to the backend asynchronously.
939 P = (XPGCONN(conn))->pgconn;
940 CHECK_CONNECTION_ALIVE(P);
945 char *e = PQerrorMessage(P);
946 error("libpq: %s", e);
950 DEFUN("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
951 Poll an asynchronous reset for completion.
956 PostgresPollingStatusType polling_status;
960 P = (XPGCONN(conn))->pgconn;
961 CHECK_CONNECTION_ELIGIBLE(P);
963 polling_status = PQresetPoll(P);
964 switch (polling_status) {
965 case PGRES_POLLING_FAILED:
966 /* Something Bad has happened */
968 char *e = PQerrorMessage(P);
969 error("libpq: %s", e);
971 case PGRES_POLLING_OK:
972 return Q_pgres_polling_ok;
973 case PGRES_POLLING_READING:
974 return Q_pgres_polling_reading;
975 case PGRES_POLLING_WRITING:
976 return Q_pgres_polling_writing;
977 case PGRES_POLLING_ACTIVE:
978 return Q_pgres_polling_active;
980 /* they've added a new field we don't know about */
981 error("Help! Unknown status code %08x from backend!",
987 DEFUN("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
988 Attempt to request cancellation of the current operation.
990 The return value is t if the cancel request was successfully
991 dispatched, nil if not (in which case conn->errorMessage is set).
992 Note: successful dispatch is no guarantee that there will be any effect at
993 the backend. The application must read the operation result as usual.
1000 P = (XPGCONN(conn))->pgconn;
1001 CHECK_CONNECTION_ALIVE(P);
1003 return PQrequestCancel(P) ? Qt : Qnil;
1006 /* accessor function for the PGconn object */
1007 DEFUN("pq-connection-status", Fpq_connection_status, 2, 2, 0, /*
1008 Accessor function for the PGconn object.
1009 Currently recognized symbols for the field:
1010 :pq-db Database name
1011 :pq-user Database user name
1012 :pq-pass Database user's password
1013 :pq-host Hostname of PostgreSQL backend connected to
1014 :pq-port TCP port number of connection
1015 :pq-tty Debugging TTY (not used in Emacs)
1016 :pq-options Additional backend options
1017 :pq-status Connection status (either OK or BAD)
1018 :pq-transaction-status Current in-transaction status of the server
1019 :pq-parameter-status Current parameter setting of the server
1020 :pq-protocol-version Frontend/Backend protocol
1021 :pq-server-version Integer representing the backend version
1022 :pq-error-message Last error message from the backend
1023 :pq-backend-pid Process ID of backend process
1024 :pq-getssl SSL session used in the connection
1031 P = (XPGCONN(conn))->pgconn;
1032 PUKE_IF_NULL(P); /* BAD connections still have state to query */
1034 if (EQ(field, Q_pq_db)) {
1035 /* PQdb Returns the database name of the connection.
1036 char *PQdb(PGconn *conn)
1038 return build_ext_string(PQdb(P), PG_OS_CODING);
1039 } else if (EQ(field, Q_pq_user)) {
1040 /* PQuser Returns the user name of the connection.
1041 char *PQuser(PGconn *conn)
1043 return build_ext_string(PQuser(P), PG_OS_CODING);
1044 } else if (EQ(field, Q_pq_pass)) {
1045 /* PQpass Returns the password of the connection.
1046 char *PQpass(PGconn *conn)
1048 return build_ext_string(PQpass(P), PG_OS_CODING);
1049 } else if (EQ(field, Q_pq_host)) {
1050 /* PQhost Returns the server host name of the connection.
1051 char *PQhost(PGconn *conn)
1053 return build_ext_string(PQhost(P), PG_OS_CODING);
1054 } else if (EQ(field, Q_pq_port)) {
1056 /* PQport Returns the port of the connection.
1057 char *PQport(PGconn *conn)
1059 if ((p = PQport(P)))
1060 return make_int(atoi(p));
1062 return make_int(-1);
1063 } else if (EQ(field, Q_pq_tty)) {
1064 /* PQtty Returns the debug tty of the connection.
1065 char *PQtty(PGconn *conn)
1067 return build_ext_string(PQtty(P), PG_OS_CODING);
1068 } else if (EQ(field, Q_pq_options)) {
1069 /* PQoptions Returns the backend options used in the connection.
1070 char *PQoptions(PGconn *conn)
1072 return build_ext_string(PQoptions(P), PG_OS_CODING);
1073 } else if (EQ(field, Q_pq_status)) {
1075 /* PQstatus Returns the status of the connection. The status can be
1076 CONNECTION_OK or CONNECTION_BAD.
1077 ConnStatusType PQstatus(PGconn *conn)
1079 switch ((cst = PQstatus(P))) {
1081 return Q_pg_connection_ok;
1082 case CONNECTION_BAD:
1083 return Q_pg_connection_bad;
1084 #ifdef HAVE_POSTGRESQLV7
1085 case CONNECTION_STARTED:
1086 return Q_pg_connection_started;
1087 case CONNECTION_MADE:
1088 return Q_pg_connection_made;
1089 case CONNECTION_AWAITING_RESPONSE:
1090 return Q_pg_connection_awaiting_response;
1091 case CONNECTION_AUTH_OK:
1092 return Q_pg_connection_auth_ok;
1093 case CONNECTION_SETENV:
1094 return Q_pg_connection_setenv;
1095 #endif /* HAVE_POSTGRESQLV7 */
1097 /* they've added a new field we don't know about */
1098 error("Help! Unknown connection status code %08x "
1102 } else if (EQ(field, Q_pq_transaction_status)) {
1103 PGTransactionStatusType ts;
1104 switch ((ts = PQtransactionStatus(P))) {
1106 return Q_pg_trans_idle;
1107 case PQTRANS_ACTIVE:
1108 return Q_pg_trans_active;
1109 case PQTRANS_INTRANS:
1110 return Q_pg_trans_intrans;
1111 case PQTRANS_INERROR:
1112 return Q_pg_trans_inerror;
1113 case PQTRANS_UNKNOWN:
1114 return Q_pg_trans_unknown;
1116 /* they've added a new field we don't know about */
1117 error("Help! Unknown transaction status code %08x "
1121 } else if (EQ(field, Q_pq_parameter_status)) {
1123 } else if (EQ(field, Q_pq_protocol_version)) {
1124 return make_int(PQprotocolVersion(P));
1125 #if HAVE_PQSERVERVERSION
1126 } else if (EQ(field, Q_pq_server_version)) {
1127 return make_int(PQserverVersion(P));
1129 } else if (EQ(field, Q_pq_server_version)) {
1130 char *vstr = xstrdup(PQparameterStatus(P,"server_version"));
1131 char *tmp, previous;
1132 int major, minor, patch;
1136 tmp = strtok(vstr,".");
1138 tmp = strtok(NULL,".");
1140 tmp = strtok(NULL,".");
1143 return make_int(major*10000+minor*100+patch);
1145 } else if (EQ(field, Q_pq_error_message)) {
1146 /* PQerrorMessage Returns the error message most recently
1147 * generated by an operation on the connection.
1148 * char *PQerrorMessage(PGconn* conn);
1150 return build_ext_string(PQerrorMessage(P), PG_OS_CODING);
1151 } else if (EQ(field, Q_pq_backend_pid)) {
1152 /* PQbackendPID Returns the process ID of the backend server
1153 * handling this connection.
1154 * int PQbackendPID(PGconn *conn);
1156 return make_int(PQbackendPID(P));
1158 } else if (EQ(field, Q_pq_getssl)) {
1159 /* PQgetssl Returns the SSL structure used in the connection,
1160 * or NULL if SSL is not in use.
1161 * SSL *PQgetssl(PGconn *conn);
1164 ssl_conn = (SSL*)PQgetssl(P);
1165 if (ssl_conn == NULL)
1166 return Qnil; /* meaning: no SSL in use */
1168 Lisp_SSL_CONN *pqssl = allocate_ssl_conn();
1169 pqssl->ssl_conn = ssl_conn;
1170 pqssl->parent = conn;
1171 pqssl->protected_p = 1;
1172 return make_ssl_conn(pqssl);
1173 /* Should we use a copy of the SSL session here?
1174 * Otherwise it's safe to obtain a nice segfault by:
1175 * (setq m (pq-pgconn foo \'pq::getssl))
1176 * (setq m \'something-else)
1177 * M-x garbage-collect RET
1178 * (pq-send-query foo ...)
1179 * You will see SXE dump in ssl*_write or the like
1180 * since the _original_ session handle has been gc'd
1182 * Nah, _for the moment_ I assume our users to be
1183 * smart enough to rethink twice before they do
1184 * something like this.
1191 message("bad PGconn accessor");
1195 DEFUN("pq-connection-alive-p", Fpq_connection_alive_p, 1, 1, 0, /*
1196 Return non-nil when CONN is considered alive.
1198 This is roughly the same as calling (pq-connection-status CONN :status)
1206 P = (XPGCONN(conn))->pgconn;
1208 if (PQstatus(P) == CONNECTION_OK) {
1214 DEFUN("pq-connection-p", Fpq_connection_p, 1, 1, 0, /*
1215 Return non-nil if OBJECT is a pq connection object.
1219 return PGCONNP(object) ? Qt : Qnil;
1222 /* Query functions */
1223 DEFUN("pq-exec", Fpq_exec, 2, 2, 0, /*
1224 Submit a query to Postgres and wait for the result.
1229 Lisp_PGresult *lisp_pgresult;
1234 CHECK_STRING(query);
1236 P = (XPGCONN(conn))->pgconn;
1237 CHECK_CONNECTION_ALIVE(P);
1239 TO_EXTERNAL_FORMAT(LISP_STRING, query,
1240 C_STRING_ALLOCA, c_query, Qnative);
1242 R = PQexec(P, c_query);
1244 char *tag, buf[BLCKSZ];
1247 error("query: out of memory");
1249 switch (PQresultStatus(R)) {
1250 case PGRES_BAD_RESPONSE:
1251 tag = "bad response [%s]";
1253 case PGRES_NONFATAL_ERROR:
1254 tag = "non-fatal error [%s]";
1256 case PGRES_FATAL_ERROR:
1257 tag = "fatal error [%s]";
1259 strncpy(buf, PQresultErrorMessage(R),
1261 buf[sizeof(buf) - 1] = '\0';
1264 /*NOTREACHED*/ default:
1269 lisp_pgresult = allocate_pgresult();
1270 lisp_pgresult->pgresult = R;
1272 return make_pgresult(lisp_pgresult);
1275 DEFUN("pq-send-query", Fpq_send_query, 2, 2, 0, /*
1276 Submit a query to Postgres and don't wait for the result.
1277 Returns: t if successfully submitted
1278 nil if error (conn->errorMessage is set)
1286 CHECK_STRING(query);
1288 P = (XPGCONN(conn))->pgconn;
1289 CHECK_CONNECTION_ALIVE(P);
1291 TO_EXTERNAL_FORMAT(LISP_STRING, query,
1292 C_STRING_ALLOCA, c_query, Qnative);
1294 if (PQsendQuery(P, c_query))
1297 error("async query: %s", PQerrorMessage(P));
1300 DEFUN("pq-result-p", Fpq_result_p, 1, 1, 0, /*
1301 Return non-nil if OBJECT is a pq query result object.
1305 return PGRESULTP(object) ? Qt : Qnil;
1308 DEFUN("pq-get-result", Fpq_get_result, 1, 1, 0, /*
1309 Retrieve an asynchronous result from a query.
1310 NIL is returned when no more query work remains.
1315 Lisp_PGresult *lisp_pgresult;
1320 P = (XPGCONN(conn))->pgconn;
1321 CHECK_CONNECTION_ALIVE(P);
1325 return Qnil; /* not an error, there's no more data to get */
1328 char *tag, buf[BLCKSZ];
1330 switch (PQresultStatus(R)) {
1331 case PGRES_BAD_RESPONSE:
1332 tag = "bad response [%s]";
1334 case PGRES_NONFATAL_ERROR:
1335 tag = "non-fatal error [%s]";
1337 case PGRES_FATAL_ERROR:
1338 tag = "fatal error [%s]";
1340 strncpy(buf, PQresultErrorMessage(R), sizeof(buf));
1341 buf[sizeof(buf) - 1] = '\0';
1344 /*NOTREACHED*/ default:
1349 lisp_pgresult = allocate_pgresult();
1350 lisp_pgresult->pgresult = R;
1352 return make_pgresult(lisp_pgresult);
1355 DEFUN("pq-result-status", Fpq_result_status, 1, 1, 0, /*
1356 Return result status of the query.
1363 CHECK_PGRESULT(result);
1364 R = (XPGRESULT(result))->pgresult;
1367 switch ((est = PQresultStatus(R))) {
1368 case PGRES_EMPTY_QUERY:
1369 return Q_pgres_empty_query;
1370 case PGRES_COMMAND_OK:
1371 return Q_pgres_command_ok;
1372 case PGRES_TUPLES_OK:
1373 return Q_pgres_tuples_ok;
1374 case PGRES_COPY_OUT:
1375 return Q_pgres_copy_out;
1377 return Q_pgres_copy_in;
1378 case PGRES_BAD_RESPONSE:
1379 return Q_pgres_bad_response;
1380 case PGRES_NONFATAL_ERROR:
1381 return Q_pgres_nonfatal_error;
1382 case PGRES_FATAL_ERROR:
1383 return Q_pgres_fatal_error;
1385 /* they've added a new field we don't know about */
1386 error("Help! Unknown exec status code %08x from backend!",
1391 DEFUN("pq-result-status-string", Fpq_result_status_string, 1, 1, 0, /*
1392 Return stringified result status of the query.
1398 CHECK_PGRESULT(result);
1399 R = (XPGRESULT(result))->pgresult;
1402 return build_ext_string(PQresStatus(PQresultStatus(R)), PG_OS_CODING);
1405 /* Sundry PGresult accessor functions */
1406 DEFUN("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /*
1407 Return last message associated with the query.
1413 CHECK_PGRESULT(result);
1414 R = (XPGRESULT(result))->pgresult;
1417 return build_ext_string(PQresultErrorMessage(R), PG_OS_CODING);
1420 DEFUN("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
1421 Return the number of tuples (instances) in the query result.
1427 CHECK_PGRESULT(result);
1428 R = (XPGRESULT(result))->pgresult;
1431 return make_int(PQntuples(R));
1434 DEFUN("pq-nfields", Fpq_nfields, 1, 1, 0, /*
1435 Return the number of fields (attributes) in each tuple of the query result.
1441 CHECK_PGRESULT(result);
1442 R = (XPGRESULT(result))->pgresult;
1445 return make_int(PQnfields(R));
1448 DEFUN("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /*
1449 Return t if the query result contains binary data, nil otherwise.
1455 CHECK_PGRESULT(result);
1456 R = (XPGRESULT(result))->pgresult;
1459 return (PQbinaryTuples(R)) ? Qt : Qnil;
1462 DEFUN("pq-fname", Fpq_fname, 2, 2, 0, /*
1463 Return the field (attribute) name associated with the given field index.
1464 Field indices start at 0.
1466 (result, field_index))
1470 CHECK_PGRESULT(result);
1471 CHECK_INT(field_index);
1472 R = (XPGRESULT(result))->pgresult;
1475 return build_ext_string(PQfname(R, XINT(field_index)), PG_OS_CODING);
1478 DEFUN("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
1479 Return the number of fields (attributes) in each tuple of the query result.
1481 (result, field_name))
1486 CHECK_PGRESULT(result);
1487 CHECK_STRING(field_name);
1488 R = (XPGRESULT(result))->pgresult;
1491 TO_EXTERNAL_FORMAT(LISP_STRING, field_name,
1492 C_STRING_ALLOCA, c_field_name, Qnative);
1494 return make_int(PQfnumber(R, c_field_name));
1497 DEFUN("pq-ftype", Fpq_ftype, 2, 2, 0, /*
1498 Return the field type associated with the given field index.
1499 The integer returned is the internal coding of the type. Field indices
1502 (result, field_num))
1506 CHECK_PGRESULT(result);
1507 CHECK_INT(field_num);
1508 R = (XPGRESULT(result))->pgresult;
1511 return make_int(PQftype(R, XINT(field_num)));
1514 DEFUN("pq-fsize", Fpq_fsize, 2, 2, 0, /*
1515 Return the field size in bytes associated with the given field index.
1516 Field indices start at 0.
1518 (result, field_index))
1522 CHECK_PGRESULT(result);
1523 CHECK_INT(field_index);
1524 R = (XPGRESULT(result))->pgresult;
1527 return make_int(PQftype(R, XINT(field_index)));
1530 DEFUN("pq-fmod", Fpq_fmod, 2, 2, 0, /*
1531 Return the type modifier associated with a field.
1532 Field indices start at 0.
1534 (result, field_index))
1538 CHECK_PGRESULT(result);
1539 CHECK_INT(field_index);
1540 R = (XPGRESULT(result))->pgresult;
1543 return make_int(PQfmod(R, XINT(field_index)));
1546 DEFUN("pq-get-value", Fpq_get_value, 3, 3, 0, /*
1547 Return a single field (attribute) value of one tuple of a PGresult.
1548 Tuple and field indices start at 0.
1550 (result, tup_num, field_num))
1554 CHECK_PGRESULT(result);
1556 CHECK_INT(field_num);
1557 R = (XPGRESULT(result))->pgresult;
1560 return build_ext_string(PQgetvalue(R, XINT(tup_num), XINT(field_num)),
1564 DEFUN("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1565 Returns the length of a field value in bytes.
1566 If result is binary, i.e. a result of a binary portal, then the
1567 length returned does NOT include the size field of the varlena. (The
1568 data returned by PQgetvalue doesn't either.)
1570 (result, tup_num, field_num))
1574 CHECK_PGRESULT(result);
1576 CHECK_INT(field_num);
1577 R = (XPGRESULT(result))->pgresult;
1580 return make_int(PQgetlength(R, XINT(tup_num), XINT(field_num)));
1583 DEFUN("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /*
1584 Returns the null status of a field value.
1586 (result, tup_num, field_num))
1590 CHECK_PGRESULT(result);
1592 CHECK_INT(field_num);
1593 R = (XPGRESULT(result))->pgresult;
1596 return PQgetisnull(R, XINT(tup_num), XINT(field_num)) ? Qt : Qnil;
1599 DEFUN("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
1600 Returns the command status string from the SQL command that generated the result.
1606 CHECK_PGRESULT(result);
1607 R = (XPGRESULT(result))->pgresult;
1610 return build_ext_string(PQcmdStatus(R), PG_OS_CODING);
1613 DEFUN("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1614 Returns the number of rows affected by the SQL command.
1620 CHECK_PGRESULT(result);
1621 R = (XPGRESULT(result))->pgresult;
1624 return build_ext_string(PQcmdTuples(R), PG_OS_CODING);
1627 DEFUN("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
1628 Returns the object id of the tuple inserted.
1634 CHECK_PGRESULT(result);
1635 R = (XPGRESULT(result))->pgresult;
1638 #ifdef HAVE_POSTGRESQLV7
1639 return make_int(PQoidValue(R));
1641 /* Use the old interface */
1642 return make_int(atoi(PQoidStatus(R)));
1646 #ifdef HAVE_POSTGRESQLV7
1647 DEFUN("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /*
1648 Sets the PGconn's database connection non-blocking if the arg is TRUE
1649 or makes it non-blocking if the arg is FALSE, this will not protect
1650 you from PQexec(), you'll only be safe when using the non-blocking API.
1652 Needs to be called only on a connected database connection.
1659 P = (XPGCONN(conn))->pgconn;
1660 CHECK_CONNECTION_ALIVE(P);
1662 return make_int(PQsetnonblocking(P, !NILP(arg)));
1665 DEFUN("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
1666 Return the blocking status of the database connection.
1673 P = (XPGCONN(conn))->pgconn;
1674 CHECK_CONNECTION_ALIVE(P);
1676 return PQisnonblocking(P) ? Qt : Qnil;
1679 DEFUN("pq-flush", Fpq_flush, 1, 1, 0, /*
1680 Force the write buffer to be written (or at least try).
1687 P = (XPGCONN(conn))->pgconn;
1688 CHECK_CONNECTION_ALIVE(P);
1690 return make_int(PQflush(P));
1694 DEFUN("pq-notifies", Fpq_notifies, 1, 1, 0, /*
1695 Return the latest async notification that has not yet been handled.
1696 If there has been a notification, then a list of two elements will be returned.
1697 The first element contains the relation name being notified, the second
1698 element contains the backend process ID number. nil is returned if there
1699 aren't any notifications to process.
1703 /* This function cannot GC */
1708 P = (XPGCONN(conn))->pgconn;
1709 CHECK_CONNECTION_ALIVE(P);
1711 PGN = PQnotifies(P);
1717 temp = list2(build_ext_string(PGN->relname, PG_OS_CODING),
1718 make_int(PGN->be_pid));
1724 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1725 DEFUN("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
1726 Get encoding id from environment variable PGCLIENTENCODING.
1730 return make_int(PQenv2encoding());
1734 DEFUN("pq-lo-import", Fpq_lo_import, 2, 2, 0, /*
1742 CHECK_STRING(filename);
1744 P = (XPGCONN(conn))->pgconn;
1745 CHECK_CONNECTION_ALIVE(P);
1747 TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1748 C_STRING_ALLOCA, c_filename, Qfile_name);
1750 return make_int((int)lo_import(P, c_filename));
1753 DEFUN("pq-lo-export", Fpq_lo_export, 3, 3, 0, /*
1755 (conn, oid, filename))
1762 CHECK_STRING(filename);
1764 P = (XPGCONN(conn))->pgconn;
1765 CHECK_CONNECTION_ALIVE(P);
1767 TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1768 C_STRING_ALLOCA, c_filename, Qfile_name);
1770 return make_int((int)lo_export(P, XINT(oid), c_filename));
1773 DEFUN("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /*
1774 Make an empty PGresult object with the given status.
1779 Lisp_PGresult *lpgr;
1784 P = (XPGCONN(conn))->pgconn;
1785 CHECK_CONNECTION_ALIVE(P); /* needed here? */
1787 if (EQ(status, Q_pgres_empty_query))
1788 est = PGRES_EMPTY_QUERY;
1789 else if (EQ(status, Q_pgres_command_ok))
1790 est = PGRES_COMMAND_OK;
1791 else if (EQ(status, Q_pgres_tuples_ok))
1792 est = PGRES_TUPLES_OK;
1793 else if (EQ(status, Q_pgres_copy_out))
1794 est = PGRES_COPY_OUT;
1795 else if (EQ(status, Q_pgres_copy_in))
1796 est = PGRES_COPY_IN;
1797 else if (EQ(status, Q_pgres_bad_response))
1798 est = PGRES_BAD_RESPONSE;
1799 else if (EQ(status, Q_pgres_nonfatal_error))
1800 est = PGRES_NONFATAL_ERROR;
1801 else if (EQ(status, Q_pgres_fatal_error))
1802 est = PGRES_FATAL_ERROR;
1804 signal_simple_error("bad status symbol", status);
1806 R = PQmakeEmptyPGresult(P, est);
1808 error("out of memory?");
1810 lpgr = allocate_pgresult();
1813 return make_pgresult(lpgr);
1816 #ifdef HAVE_POSTGRESQLV7
1817 /* actually I don't know when this made its way to libpq
1818 * I just assume 7.4 here
1819 * Bite me, if that's wrong ;P
1821 DEFUN("pq-escape-string", Fpq_escape_string, 1, 1, 0, /*
1822 Return an SQL-suited escaped version of STRING.
1828 /* buffers for our args */
1832 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1833 C_STRING_ALLOCA, string_ext, PG_OS_CODING);
1834 string_len = (int)XSTRING_CHAR_LENGTH(string);
1836 result = (char *)xmalloc_atomic(4*XSTRING_LENGTH(string));
1838 result_len = PQescapeString(result, string_ext, string_len);
1840 return make_ext_string(result, result_len, PG_OS_CODING);
1843 DEFUN("pq-escape-bytea", Fpq_escape_bytea, 1, 1, 0, /*
1844 Return an SQL-suited escaped version of binary DATA.
1849 unsigned int result_len;
1850 /* buffers for our args */
1854 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1855 C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1856 data_len = (int)XSTRING_CHAR_LENGTH(data);
1858 result = (char*)PQescapeBytea((unsigned char*)data_ext, data_len,
1864 return make_ext_string(result,result_len-1,PG_OS_CODING);
1867 DEFUN("pq-unescape-bytea", Fpq_unescape_bytea, 1, 1, 0, /*
1868 Return the unescaped form of DATA (which may be binary).
1869 Such binary data may result from a BYTEA column.
1871 Note: Of course, escaped SQL strings are elisp-escaped again
1872 so you may have to use `pq-unescape-bytea' twice.
1877 unsigned int result_len;
1878 /* buffers for our args */
1881 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1882 C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1884 result = (char*)PQunescapeBytea((unsigned char*)data_ext,
1890 return make_ext_string(result,result_len,PG_OS_CODING);
1894 DEFUN("pq-get-line", Fpq_get_line, 1, 1, 0, /*
1895 Retrieve a line from server in copy in operation.
1896 The return value is a dotted pair where the cons cell is an integer code:
1897 -1: Copying is complete
1898 0: A record is complete
1899 1: A record is incomplete, it will be continued in the next `pq-get-line'
1901 and the cdr cell is returned string data.
1903 The copy operation is complete when the value `\.' (backslash dot) is
1908 char buffer[BLCKSZ]; /* size of a Postgres disk block */
1913 P = (XPGCONN(conn))->pgconn;
1914 CHECK_CONNECTION_ALIVE(P);
1916 ret = PQgetline(P, buffer, sizeof(buffer));
1918 return Fcons(make_int(ret), build_ext_string(buffer, PG_OS_CODING));
1921 DEFUN("pq-put-line", Fpq_put_line, 2, 2, 0, /*
1922 Send a line to the server in copy out operation.
1924 Returns t if the operation succeeded, nil otherwise.
1932 CHECK_STRING(string);
1934 P = (XPGCONN(conn))->pgconn;
1935 CHECK_CONNECTION_ALIVE(P);
1936 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1937 C_STRING_ALLOCA, c_string, Qnative);
1939 return !PQputline(P, c_string) ? Qt : Qnil;
1942 DEFUN("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
1943 Get a line from the server in copy in operation asynchronously.
1945 This routine is for applications that want to do "COPY <rel> to stdout"
1946 asynchronously, that is without blocking. Having issued the COPY command
1947 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
1948 and this routine until the end-of-data signal is detected. Unlike
1949 PQgetline, this routine takes responsibility for detecting end-of-data.
1951 On each call, PQgetlineAsync will return data if a complete newline-
1952 terminated data line is available in libpq's input buffer, or if the
1953 incoming data line is too long to fit in the buffer offered by the caller.
1954 Otherwise, no data is returned until the rest of the line arrives.
1956 If -1 is returned, the end-of-data signal has been recognized (and removed
1957 from libpq's input buffer). The caller *must* next call PQendcopy and
1958 then return to normal processing.
1961 -1 if the end-of-copy-data marker has been recognized
1962 0 if no data is available
1963 >0 the number of bytes returned.
1964 The data returned will not extend beyond a newline character. If possible
1965 a whole line will be returned at one time. But if the buffer offered by
1966 the caller is too small to hold a line sent by the backend, then a partial
1967 data line will be returned. This can be detected by testing whether the
1968 last returned byte is '\n' or not.
1969 The returned string is *not* null-terminated.
1974 char buffer[BLCKSZ];
1979 P = (XPGCONN(conn))->pgconn;
1980 CHECK_CONNECTION_ALIVE(P);
1982 ret = PQgetlineAsync(P, buffer, sizeof(buffer));
1985 return Qt; /* done! */
1987 return Qnil; /* no data yet */
1989 return Fcons(make_int(ret),
1990 make_ext_string((Extbyte *) buffer, ret,
1994 DEFUN("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1995 Asynchronous copy out.
1999 /* NULs are not allowed. I don't think this matters at this time. */
2006 P = (XPGCONN(conn))->pgconn;
2007 CHECK_CONNECTION_ALIVE(P);
2008 TO_EXTERNAL_FORMAT(LISP_STRING, data, C_STRING_ALLOCA, c_data, Qnative);
2010 return !PQputnbytes(P, c_data, strlen(c_data)) ? Qt : Qnil;
2013 DEFUN("pq-end-copy", Fpq_end_copy, 1, 1, 0, /*
2014 End a copying operation.
2021 P = (XPGCONN(conn))->pgconn;
2022 CHECK_CONNECTION_ALIVE(P);
2024 return PQendcopy(P) ? Qt : Qnil;
2029 syms_of_postgresql(void)
2031 INIT_LRECORD_IMPLEMENTATION(pgconn);
2032 INIT_LRECORD_IMPLEMENTATION(pgresult);
2034 defsymbol(&Qpostgresql, "postgresql");
2036 /* opaque exported types */
2037 defsymbol(&Qpgconnp, "pgconnp");
2038 defsymbol(&Qpgresultp, "pgresultp");
2040 /* connection status types
2041 * now implemented as keywords */
2042 DEFKEYWORD(Q_pg_connection_ok);
2043 DEFKEYWORD(Q_pg_connection_bad);
2044 DEFKEYWORD(Q_pg_connection_started);
2045 DEFKEYWORD(Q_pg_connection_made);
2046 DEFKEYWORD(Q_pg_connection_awaiting_response);
2047 DEFKEYWORD(Q_pg_connection_auth_ok);
2048 DEFKEYWORD(Q_pg_connection_setenv);
2050 /* transaction status types */
2051 DEFKEYWORD(Q_pg_trans_idle);
2052 DEFKEYWORD(Q_pg_trans_active);
2053 DEFKEYWORD(Q_pg_trans_intrans);
2054 DEFKEYWORD(Q_pg_trans_inerror);
2055 DEFKEYWORD(Q_pg_trans_unknown);
2057 /* Fields of PGconn */
2058 DEFKEYWORD(Q_pq_db);
2059 DEFKEYWORD(Q_pq_user);
2060 DEFKEYWORD(Q_pq_pass);
2061 DEFKEYWORD(Q_pq_host);
2062 DEFKEYWORD(Q_pq_port);
2063 DEFKEYWORD(Q_pq_tty);
2064 DEFKEYWORD(Q_pq_options);
2065 DEFKEYWORD(Q_pq_status);
2066 DEFKEYWORD(Q_pq_transaction_status);
2067 DEFKEYWORD(Q_pq_parameter_status);
2068 DEFKEYWORD(Q_pq_protocol_version);
2069 DEFKEYWORD(Q_pq_server_version);
2070 DEFKEYWORD(Q_pq_error_message);
2071 DEFKEYWORD(Q_pq_backend_pid);
2073 DEFKEYWORD(Q_pq_getssl);
2076 /* Query status results */
2077 DEFKEYWORD(Q_pgres_empty_query);
2078 DEFKEYWORD(Q_pgres_command_ok);
2079 DEFKEYWORD(Q_pgres_tuples_ok);
2080 DEFKEYWORD(Q_pgres_copy_out);
2081 DEFKEYWORD(Q_pgres_copy_in);
2082 DEFKEYWORD(Q_pgres_bad_response);
2083 DEFKEYWORD(Q_pgres_nonfatal_error);
2084 DEFKEYWORD(Q_pgres_fatal_error);
2086 /* Poll status results */
2087 DEFKEYWORD(Q_pgres_polling_failed);
2088 DEFKEYWORD(Q_pgres_polling_reading);
2089 DEFKEYWORD(Q_pgres_polling_writing);
2090 DEFKEYWORD(Q_pgres_polling_ok);
2091 DEFKEYWORD(Q_pgres_polling_active);
2093 #ifdef HAVE_POSTGRESQLV7
2094 DEFSUBR(Fpq_connect_start);
2095 DEFSUBR(Fpq_connect_poll);
2097 DEFSUBR(Fpq_client_encoding);
2098 DEFSUBR(Fpq_set_client_encoding);
2100 #endif /* HAVE_POSTGRESQLV7 */
2101 DEFSUBR(Fpq_set_notice_processor);
2103 DEFSUBR(Fpq_connection_p);
2104 DEFSUBR(Fpq_conn_defaults);
2105 DEFSUBR(Fpq_connectdb);
2106 DEFSUBR(Fpq_finish);
2108 DEFSUBR(Fpq_is_busy);
2109 DEFSUBR(Fpq_consume_input);
2111 #ifdef HAVE_POSTGRESQLV7
2112 DEFSUBR(Fpq_escape_string);
2113 DEFSUBR(Fpq_escape_bytea);
2114 DEFSUBR(Fpq_unescape_bytea);
2118 #ifdef HAVE_POSTGRESQLV7
2119 DEFSUBR(Fpq_reset_start);
2120 DEFSUBR(Fpq_reset_poll);
2122 DEFSUBR(Fpq_request_cancel);
2123 DEFSUBR(Fpq_connection_status);
2124 DEFSUBR(Fpq_connection_alive_p);
2127 DEFSUBR(Fpq_send_query);
2128 DEFSUBR(Fpq_result_p);
2129 DEFSUBR(Fpq_get_result);
2130 DEFSUBR(Fpq_result_status);
2131 DEFSUBR(Fpq_result_status_string);
2132 DEFSUBR(Fpq_result_error_message);
2133 DEFSUBR(Fpq_ntuples);
2134 DEFSUBR(Fpq_nfields);
2135 DEFSUBR(Fpq_binary_tuples);
2137 DEFSUBR(Fpq_fnumber);
2142 DEFSUBR(Fpq_get_value);
2143 DEFSUBR(Fpq_get_length);
2144 DEFSUBR(Fpq_get_is_null);
2145 DEFSUBR(Fpq_cmd_status);
2146 DEFSUBR(Fpq_cmd_tuples);
2147 DEFSUBR(Fpq_oid_value);
2149 #ifdef HAVE_POSTGRESQLV7
2150 DEFSUBR(Fpq_set_nonblocking);
2151 DEFSUBR(Fpq_is_nonblocking);
2154 DEFSUBR(Fpq_notifies);
2156 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
2157 DEFSUBR(Fpq_env_2_encoding);
2160 DEFSUBR(Fpq_lo_import);
2161 DEFSUBR(Fpq_lo_export);
2163 DEFSUBR(Fpq_make_empty_pgresult);
2165 /* copy in/out functions */
2166 DEFSUBR(Fpq_get_line);
2167 DEFSUBR(Fpq_put_line);
2168 DEFSUBR(Fpq_get_line_async);
2169 DEFSUBR(Fpq_put_nbytes);
2170 DEFSUBR(Fpq_end_copy);
2173 void vars_of_postgresql(void)
2175 Fprovide(Qpostgresql);
2176 #ifdef HAVE_POSTGRESQLV7
2177 Fprovide(intern("postgresqlv7"));
2179 Vpg_coding_system = Qnative;
2180 DEFVAR_LISP("pg-coding-system", &Vpg_coding_system /*
2181 Default Postgres client coding system.
2184 DEFVAR_LISP("pg:host", &VXPGHOST /*
2185 Default PostgreSQL server name.
2186 If not set, the server running on the local host is used. The
2187 initial value is set from the PGHOST environment variable.
2190 DEFVAR_LISP("pg:user", &VXPGUSER /*
2191 Default PostgreSQL user name.
2192 This value is used when connecting to a database for authentication.
2193 The initial value is set from the PGUSER environment variable.
2196 DEFVAR_LISP("pg:options", &VXPGOPTIONS /*
2197 Default PostgreSQL user name.
2198 This value is used when connecting to a database for authentication.
2199 The initial value is set from the PGUSER environment variable.
2202 DEFVAR_LISP("pg:port", &VXPGPORT /*
2203 Default port to connect to PostgreSQL backend.
2204 This value is used when connecting to a database.
2205 The initial value is set from the PGPORT environment variable.
2208 DEFVAR_LISP("pg:tty", &VXPGTTY /*
2209 Default debugging TTY.
2210 There is no useful setting of this variable in the XEmacs Lisp API.
2211 The initial value is set from the PGTTY environment variable.
2214 DEFVAR_LISP("pg:database", &VXPGDATABASE /*
2215 Default database to connect to.
2216 The initial value is set from the PGDATABASE environment variable.
2219 DEFVAR_LISP("pg:realm", &VXPGREALM /*
2220 Default kerberos realm to use for authentication.
2221 The initial value is set from the PGREALM environment variable.
2225 /* It's not clear whether this is any use. My intent is to
2226 autodetect the coding system from the database. */
2227 DEFVAR_LISP("pg:client-encoding", &VXPGCLIENTENCODING /*
2228 Default client encoding to use.
2229 The initial value is set from the PGCLIENTENCODING environment variable.
2233 #if !defined(HAVE_POSTGRESQLV7)
2234 DEFVAR_LISP("pg:authtype", &VXPGAUTHTYPE /*
2235 Default authentication to use.
2236 The initial value is set from the PGAUTHTYPE environment variable.
2238 WARNING: This variable has gone away in versions of PostgreSQL newer
2243 DEFVAR_LISP("pg:geqo", &VXPGGEQO /*
2244 Genetic Query Optimizer options.
2245 The initial value is set from the PGGEQO environment variable.
2248 DEFVAR_LISP("pg:cost-index", &VXPGCOSTINDEX /*
2249 Default cost index options.
2250 The initial value is set from the PGCOSTINDEX environment variable.
2253 DEFVAR_LISP("pg:cost-heap", &VXPGCOSTHEAP /*
2254 Default cost heap options.
2255 The initial value is set from the PGCOSTHEAP environment variable.
2258 DEFVAR_LISP("pg:tz", &VXPGTZ /*
2259 Default timezone to use.
2260 The initial value is set from the PGTZ environment variable.
2263 DEFVAR_LISP("pg:date-style", &VXPGDATESTYLE /*
2264 Default date style to use.
2265 The initial value is set from the PGDATESTYLE environment variable.
2269 /* These initializations should not be done at dump-time. */
2271 init_postgresql_from_environment(void)
2275 if ((p = getenv("PGHOST"))) {
2276 VXPGHOST = build_ext_string(p, PG_OS_CODING);
2281 if ((p = getenv("PGUSER"))) {
2282 VXPGUSER = build_ext_string(p, PG_OS_CODING);
2287 if ((p = getenv("PGOPTIONS"))) {
2288 VXPGOPTIONS = build_ext_string(p, PG_OS_CODING);
2293 if ((p = getenv("PGPORT"))) {
2294 VXPGPORT = make_int(atoi(p));
2299 if ((p = getenv("PGTTY"))) {
2300 VXPGTTY = build_ext_string(p, PG_OS_CODING);
2305 if ((p = getenv("PGDATABASE"))) {
2306 VXPGDATABASE = build_ext_string(p, PG_OS_CODING);
2308 VXPGDATABASE = Qnil;
2311 if ((p = getenv("PGREALM"))) {
2312 VXPGREALM = build_ext_string(p, PG_OS_CODING);
2318 /* It's not clear whether this is any use. My intent is to
2319 autodetect the coding system from the database. */
2320 if ((p = getenv("PGCLIENTENCODING"))) {
2321 VXPGCLIENTENCODING = build_ext_string(p, PG_OS_CODING);
2323 VXPGCLIENTENCODING = Qnil;
2327 #if !defined(HAVE_POSTGRESQLV7)
2328 if ((p = getenv("PGAUTHTYPE"))) {
2329 VXPGAUTHTYPE = build_ext_string(p, PG_OS_CODING);
2331 VXPGAUTHTYPE = Qnil;
2335 if ((p = getenv("PGGEQO"))) {
2336 VXPGGEQO = build_ext_string(p, PG_OS_CODING);
2341 if ((p = getenv("PGCOSTINDEX"))) {
2342 VXPGCOSTINDEX = build_ext_string(p, PG_OS_CODING);
2344 VXPGCOSTINDEX = Qnil;
2347 if ((p = getenv("PGCOSTHEAP"))) {
2348 VXPGCOSTHEAP = build_ext_string(p, PG_OS_CODING);
2350 VXPGCOSTHEAP = Qnil;
2353 if ((p = getenv("PGTZ"))) {
2354 VXPGTZ = build_ext_string(p, PG_OS_CODING);
2359 if ((p = getenv("PGDATESTYLE"))) {
2360 VXPGDATESTYLE = build_ext_string(p, PG_OS_CODING);
2362 VXPGDATESTYLE = Qnil;
2366 /* postgresql.c ends here */