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)
237 char *host = "", *db = "", *user = "", *port = "";
239 P = (XPGCONN(obj))->pgconn;
242 /* this may happen since we allow PQfinish() to be called */
243 write_c_string("#<PGconn DEAD>", printcharfun);
244 } else if ((cst = PQstatus(P)) == CONNECTION_OK) {
245 if (!(host = PQhost(P)))
249 if (!(user = PQuser(P))) {
252 write_fmt_string(printcharfun, "#<PGconn %s:%s %s/%s>",
254 "localhost" : host) /* evil! */,
256 } else if (cst == CONNECTION_BAD) {
257 write_c_string("#<PGconn BAD>", printcharfun);
259 write_c_string("#<PGconn connecting>", 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)
323 res = (XPGRESULT(obj))->pgresult;
326 switch (PQresultStatus(res)) {
327 case PGRES_TUPLES_OK:
328 /* Add number of tuples of result to output */
329 write_fmt_string(printcharfun, RESULT_TUPLES_FMT,
330 PQresStatus(PQresultStatus(res)),
331 PQntuples(res), PQcmdStatus(res));
333 case PGRES_COMMAND_OK:
334 /* Add number of tuples affected by output-less
336 if (!strlen(PQcmdTuples(res)))
338 write_fmt_string(printcharfun, RESULT_CMD_TUPLES_FMT,
339 PQresStatus(PQresultStatus(res)),
340 PQcmdTuples(res), PQcmdStatus(res));
344 /* No counts to print */
345 write_fmt_string(printcharfun, RESULT_DEFAULT_FMT,
346 PQresStatus(PQresultStatus(res)),
351 write_c_string("#<PGresult DEAD>", printcharfun);
356 #undef RESULT_TUPLES_FMT
357 #undef RESULT_CMD_TUPLES_FMT
358 #undef RESULT_DEFAULT_FMT
360 static Lisp_PGresult*
361 allocate_pgresult(void)
363 Lisp_PGresult *pgresult = alloc_lcrecord_type(
364 Lisp_PGresult, &lrecord_pgresult);
365 pgresult->pgresult = (PGresult *) NULL;
370 finalize_pgresult(void *header, int for_disksave)
372 Lisp_PGresult *pgresult = (Lisp_PGresult *) header;
376 ("Can't dump an emacs containing PGresult objects",
377 make_pgresult(pgresult));
380 if (pgresult->pgresult) {
381 PQclear(pgresult->pgresult);
382 pgresult->pgresult = (PGresult *) NULL;
386 DEFINE_LRECORD_IMPLEMENTATION("pgresult", pgresult,
387 mark_pgresult, print_pgresult, finalize_pgresult,
388 NULL, NULL, 0, Lisp_PGresult);
390 /***********************/
392 /* Notice Processor Stuff */
393 /* Okay, let's imagine how such a notice processor wants to look like.
394 * The only sensible thing I can imagine is a defun (like a sentinel for
398 sxemacs_notice_processor(Lisp_PGconn *conn, const char *msg)
400 /* (Lisp_PGconn *)conn; */
402 /* void *arg is my sentinel function */
403 Lisp_Object sentinel = conn->notice_processor;
406 warn_when_safe(Qpostgresql, Qnotice, "%s", msg);
408 running_asynch_code = 1;
409 call2_trapping_errors("Error in notice processor",
410 sentinel, make_pgconn(conn),
412 running_asynch_code = 0;
416 /* HOWTO evoke notices:
417 * (let ((res (pq-exec <conn> "SELECT * FROM <sometable> LIMIT 0")))
418 * (pq-get-is-null res 0 0))
420 * msg <- `row number 0 is out of range 0..-1'
422 DEFUN("pq-set-notice-processor", Fpq_set_notice_processor, 2, 2, 0, /*
423 Give CONN the notice processor SENTINEL; nil for none.
424 The notice processor is called as a function whenever the pq backend
426 It gets two arguments: the connection, and a message string.
432 XPGCONN(conn)->notice_processor = sentinel;
438 /* There are four ways (as of PostgreSQL v7) to connect to a database.
439 Two of them, PQsetdb and PQsetdbLogin, are deprecated. Both of those
440 routines take a number of positional parameters and are better done in Lisp.
441 Note that PQconnectStart does not exist prior to v7.
444 DEFUN("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /*
445 Return a connection default structure.
449 /* This function can GC */
450 PQconninfoOption *pcio;
451 Lisp_Object temp, temp1;
454 /* WHAT A FOOKING MESS! */
455 pcio = PQconndefaults();
457 return Qnil; /* can never happen in libpq-7.0 */
458 temp = list1(Fcons(build_ext_string(pcio[0].keyword, PG_OS_CODING),
459 Fcons(build_ext_string(pcio[0].envvar, PG_OS_CODING),
460 Fcons(build_ext_string
461 (pcio[0].compiled, PG_OS_CODING),
462 Fcons(build_ext_string
463 (pcio[0].val, PG_OS_CODING),
464 Fcons(build_ext_string
467 Fcons(build_ext_string
475 for (i = 1; pcio[i].keyword; i++) {
478 (build_ext_string(pcio[i].keyword, PG_OS_CODING),
479 Fcons(build_ext_string(pcio[i].envvar, PG_OS_CODING),
480 Fcons(build_ext_string
481 (pcio[i].compiled, PG_OS_CODING),
482 Fcons(build_ext_string
483 (pcio[i].val, PG_OS_CODING),
484 Fcons(build_ext_string
487 Fcons(build_ext_string
498 /* Fappend GCPROs its arguments */
499 temp = Fappend(2, args);
506 /* PQconnectdb Makes a new connection to a backend.
507 PGconn *PQconnectdb(const char *conninfo)
510 DEFUN("pq-connectdb", Fpq_connectdb, 1, 1, 0, /*
511 Open and return a new database connection using the parameters from the
514 Unlike `pq-set-db-login' below, the parameter set can be extended without
515 changing the function signature, so use of this function (or its nonblocking
516 analogues `pq-connect-start' and `pq-connect-poll') is preferred for new
517 application programming.
519 The passed string can be empty to use all default parameters, or it can
520 contain one or more parameter settings separated by whitespace. Each
521 parameter setting is in the form `keyword = value'. Spaces around the equal
522 sign are optional. To write an empty value or a value containing spaces,
523 surround it with single quotes, e.g., `keyword = \'a value\''. Single
524 quotes and backslashes within the value must be escaped with a backslash,
527 The currently recognized parameter key words are:
531 Name of host to connect to. If this begins with a slash, it specifies
532 Unix-domain communication rather than TCP/IP communication; the value is the
533 name of the directory in which the socket file is stored.
535 The default behaviour when `host' is not specified is to connect to a
536 Unix-domain socket in /tmp (or whatever socket directory was specified when
537 PostgreSQL was built).
539 On machines without Unix-domain sockets, the default is to connect to
545 Numeric IP address of host to connect to. This should be in the standard
546 IPv4 address format, e.g., 172.28.40.9.
548 If your machine supports IPv6, you can also use those addresses.
550 TCP/IP communication is always used when a nonempty string is specified for
553 Using `hostaddr' instead of `host' allows the application to avoid a host
554 name look-up, which may be important in applications with time constraints.
555 However, Kerberos authentication requires the host name.
557 The following therefore applies:
558 - If `host' is specified without `hostaddr' a host name lookup occurs.
559 - If `hostaddr' is specified without `host' the value for `hostaddr' gives
561 - When Kerberos is used, a reverse name query occurs to obtain the host
563 - If both `host' and `hostaddr' are specified, the value for `hostaddr'
564 gives the remote address; the value for `host' is ignored, unless
565 Kerberos is used, in which case that value is used for Kerberos
568 Note: Authentication is likely to fail if libpq is passed a host name that
569 is not the name of the machine at `hostaddr'.
570 Also, `host' rather than `hostaddr' is used to identify the connection in
574 Without either a host name or host address, libpq will connect using a local
575 Unix-domain socket; or on machines without Unix-domain sockets, it will
576 attempt to connect to localhost.
581 Port number to connect to at the server host, or socket file name extension
582 for Unix-domain connections.
588 Defaults to be the same as the user name.
593 PostgreSQL user name to connect as.
594 Defaults to be the same as the operating system name of the user running the
600 Password to be used if the server demands password authentication.
605 Maximum wait for connection, in seconds (write as a decimal integer string).
606 Zero or not specified means wait indefinitely.
607 It is not recommended to use a timeout of less than 2 seconds.
612 Command-line options to be sent to the server.
617 Ignored (formerly, this specified where to send server debug output).
622 This option determines whether or with what priority an SSL connection will
623 be negotiated with the server.
624 There are four modes:
625 - `disable' will attempt only an unencrypted SSL connection;
626 - `allow' will negotiate, trying first a non-SSL connection, then if that
627 fails, trying an SSL connection;
628 - `prefer' (the default) will negotiate, trying first an SSL connection,
629 then if that fails, trying a regular non-SSL connection;
630 - `require' will try only an SSL connection.
632 Note: If PostgreSQL is compiled without SSL support, using option require
633 will cause an error, while options allow and prefer will be accepted but
634 libpq will not in fact attempt an SSL connection.
638 This option is deprecated in favour of the sslmode setting.
640 If set to 1, an SSL connection to the server is required (this is equivalent
641 to sslmode require). libpq will then refuse to connect if the server does
642 not accept an SSL connection.
643 If set to 0 (default), libpq will negotiate the connection type with the
644 server (equivalent to sslmode prefer).
646 This option is only available if PostgreSQL is compiled with SSL support.
651 Service name to use for additional parameters.
652 It specifies a service name in pg_service.conf that holds additional
653 connection parameters. This allows applications to specify only a service
654 name so connection parameters can be centrally maintained.
655 See share/pg_service.conf.sample in the installation directory for
656 information on how to set up the file.
659 If any parameter is unspecified, then the corresponding environment variable
660 is checked. If the environment variable is not set either, then the
661 indicated built-in defaults are used.
666 Lisp_PGconn *lisp_pgconn;
667 char *error_message = "Out of Memory?";
672 CHECK_STRING(conninfo);
674 TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
675 C_STRING_ALLOCA, c_conninfo, Qnative);
676 P = PQconnectdb(c_conninfo);
677 if (P && (PQstatus(P) == CONNECTION_OK)) {
678 lisp_pgconn = allocate_pgconn();
679 lisp_pgconn->pgconn = P;
680 lisp_pgconn->notice_processor = Qnil;
681 conn = make_pgconn(lisp_pgconn);
684 (PQnoticeProcessor)sxemacs_notice_processor,
685 /* this is stupid, but libpq wants a void pointer */
686 (Lisp_PGconn *)lisp_pgconn);
689 /* Connection failed. Destroy the connection and signal an
692 strncpy(buf, error_message, sizeof(buf)-1);
693 buf[sizeof(buf) - 1] = '\0';
695 /* storage for the error message gets erased when
697 /* so we must temporarily stash it somewhere */
698 strncpy(buf, PQerrorMessage(P), sizeof(buf)-1);
699 buf[sizeof(buf) - 1] = '\0';
702 error("libpq: %s", buf);
706 /* PQconnectStart Makes a new asynchronous connection to a backend.
707 PGconn *PQconnectStart(const char *conninfo)
710 #ifdef HAVE_POSTGRESQLV7
711 DEFUN("pq-connect-start", Fpq_connect_start, 1, 1, 0, /*
712 Make a new asynchronous connection to a PostgreSQL backend.
714 See `pq-connectdb' for a complete description of conninfo.
719 Lisp_PGconn *lisp_pgconn;
720 char *error_message = "Out of Memory?";
725 CHECK_STRING(conninfo);
726 TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
727 C_STRING_ALLOCA, c_conninfo, Qnative);
728 P = PQconnectStart(c_conninfo);
730 if (P && (PQstatus(P) != CONNECTION_BAD)) {
731 lisp_pgconn = allocate_pgconn();
732 lisp_pgconn->pgconn = P;
733 lisp_pgconn->notice_processor = Qnil;
734 conn = make_pgconn(lisp_pgconn);
737 (PQnoticeProcessor)sxemacs_notice_processor,
741 /* capture the error message before destroying the object */
743 strncpy(buf, error_message, sizeof(buf)-1);
744 buf[sizeof(buf) - 1] = '\0';
746 strncpy(buf, PQerrorMessage(P), sizeof(buf)-1);
747 buf[sizeof(buf) - 1] = '\0';
750 error("libpq: %s", buf);
755 DEFUN("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
756 Poll an asynchronous connection for completion
761 PostgresPollingStatusType polling_status;
765 P = (XPGCONN(conn))->pgconn;
766 CHECK_CONNECTION_ELIGIBLE(P);
768 polling_status = PQconnectPoll(P);
769 switch (polling_status) {
770 case PGRES_POLLING_FAILED:
771 /* Something Bad has happened */
773 char *e = PQerrorMessage(P);
774 error("libpq: %s", e);
776 case PGRES_POLLING_OK:
777 return Q_pgres_polling_ok;
778 case PGRES_POLLING_READING:
779 return Q_pgres_polling_reading;
780 case PGRES_POLLING_WRITING:
781 return Q_pgres_polling_writing;
782 case PGRES_POLLING_ACTIVE:
783 return Q_pgres_polling_active;
785 /* they've added a new field we don't know about */
786 error("Help! Unknown status code %08x from backend!",
792 DEFUN("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /*
793 Return client coding system.
800 P = (XPGCONN(conn))->pgconn;
801 CHECK_CONNECTION_ALIVE(P);
803 return make_int(PQclientEncoding(P));
806 DEFUN("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /*
807 Set client coding system.
816 CHECK_STRING(encoding);
818 P = (XPGCONN(conn))->pgconn;
819 CHECK_CONNECTION_ALIVE(P);
821 TO_EXTERNAL_FORMAT(LISP_STRING, encoding,
822 C_STRING_ALLOCA, c_encoding, Qnative);
824 if ((rc = PQsetClientEncoding(P, c_encoding)) < 0)
825 error("bad encoding");
831 #endif /* HAVE_POSTGRESQLV7 */
833 /* PQfinish Close the connection to the backend. Also frees memory
834 used by the PGconn object.
835 void PQfinish(PGconn *conn)
837 DEFUN("pq-finish", Fpq_finish, 1, 1, 0, /*
838 Close the connection to the backend.
845 P = (XPGCONN(conn))->pgconn;
849 /* #### PQfinish deallocates the PGconn structure, so we now have a
851 /* Genocided all @'s ... */
852 (XPGCONN(conn))->pgconn = (PGconn *) NULL; /* You feel DEAD inside */
856 DEFUN("pq-clear", Fpq_clear, 1, 1, 0, /*
857 Forcibly erase a PGresult object.
864 R = (XPGRESULT(res))->pgresult;
868 /* Genocided all @'s ... */
869 (XPGRESULT(res))->pgresult = (PGresult *) NULL; /* You feel DEAD inside */
874 DEFUN("pq-is-busy", Fpq_is_busy, 1, 1, 0, /*
875 Return t if PQgetResult would block waiting for input.
882 P = (XPGCONN(conn))->pgconn;
883 CHECK_CONNECTION_ALIVE(P);
885 return PQisBusy(P) ? Qt : Qnil;
888 DEFUN("pq-consume-input", Fpq_consume_input, 1, 1, 0, /*
889 Consume any available input from the backend.
890 Returns nil if something bad happened.
897 P = (XPGCONN(conn))->pgconn;
898 CHECK_CONNECTION_ALIVE(P);
900 return PQconsumeInput(P) ? Qt : Qnil;
903 /* PQreset Reset the communication port with the backend.
904 void PQreset(PGconn *conn)
906 DEFUN("pq-reset", Fpq_reset, 1, 1, 0, /*
907 Reset the connection to the backend.
908 This function will close the connection to the backend and attempt to
909 reestablish a new connection to the same postmaster, using all the same
910 parameters previously used. This may be useful for error recovery if a
911 working connection is lost.
918 P = (XPGCONN(conn))->pgconn;
920 /* we can resurrect a BAD connection, but not a dead one. */
927 #ifdef HAVE_POSTGRESQLV7
928 DEFUN("pq-reset-start", Fpq_reset_start, 1, 1, 0, /*
929 Reset connection to the backend asynchronously.
936 P = (XPGCONN(conn))->pgconn;
937 CHECK_CONNECTION_ALIVE(P);
942 char *e = PQerrorMessage(P);
943 error("libpq: %s", e);
947 DEFUN("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
948 Poll an asynchronous reset for completion.
953 PostgresPollingStatusType polling_status;
957 P = (XPGCONN(conn))->pgconn;
958 CHECK_CONNECTION_ELIGIBLE(P);
960 polling_status = PQresetPoll(P);
961 switch (polling_status) {
962 case PGRES_POLLING_FAILED:
963 /* Something Bad has happened */
965 char *e = PQerrorMessage(P);
966 error("libpq: %s", e);
968 case PGRES_POLLING_OK:
969 return Q_pgres_polling_ok;
970 case PGRES_POLLING_READING:
971 return Q_pgres_polling_reading;
972 case PGRES_POLLING_WRITING:
973 return Q_pgres_polling_writing;
974 case PGRES_POLLING_ACTIVE:
975 return Q_pgres_polling_active;
977 /* they've added a new field we don't know about */
978 error("Help! Unknown status code %08x from backend!",
984 DEFUN("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
985 Attempt to request cancellation of the current operation.
987 The return value is t if the cancel request was successfully
988 dispatched, nil if not (in which case conn->errorMessage is set).
989 Note: successful dispatch is no guarantee that there will be any effect at
990 the backend. The application must read the operation result as usual.
997 P = (XPGCONN(conn))->pgconn;
998 CHECK_CONNECTION_ALIVE(P);
1000 return PQrequestCancel(P) ? Qt : Qnil;
1003 /* accessor function for the PGconn object */
1004 DEFUN("pq-connection-status", Fpq_connection_status, 2, 2, 0, /*
1005 Accessor function for the PGconn object.
1006 Currently recognized symbols for the field:
1007 :pq-db Database name
1008 :pq-user Database user name
1009 :pq-pass Database user's password
1010 :pq-host Hostname of PostgreSQL backend connected to
1011 :pq-port TCP port number of connection
1012 :pq-tty Debugging TTY (not used in Emacs)
1013 :pq-options Additional backend options
1014 :pq-status Connection status (either OK or BAD)
1015 :pq-transaction-status Current in-transaction status of the server
1016 :pq-parameter-status Current parameter setting of the server
1017 :pq-protocol-version Frontend/Backend protocol
1018 :pq-server-version Integer representing the backend version
1019 :pq-error-message Last error message from the backend
1020 :pq-backend-pid Process ID of backend process
1021 :pq-getssl SSL session used in the connection
1028 P = (XPGCONN(conn))->pgconn;
1029 PUKE_IF_NULL(P); /* BAD connections still have state to query */
1031 if (EQ(field, Q_pq_db)) {
1032 /* PQdb Returns the database name of the connection.
1033 char *PQdb(PGconn *conn)
1035 return build_ext_string(PQdb(P), PG_OS_CODING);
1036 } else if (EQ(field, Q_pq_user)) {
1037 /* PQuser Returns the user name of the connection.
1038 char *PQuser(PGconn *conn)
1040 return build_ext_string(PQuser(P), PG_OS_CODING);
1041 } else if (EQ(field, Q_pq_pass)) {
1042 /* PQpass Returns the password of the connection.
1043 char *PQpass(PGconn *conn)
1045 return build_ext_string(PQpass(P), PG_OS_CODING);
1046 } else if (EQ(field, Q_pq_host)) {
1047 /* PQhost Returns the server host name of the connection.
1048 char *PQhost(PGconn *conn)
1050 return build_ext_string(PQhost(P), PG_OS_CODING);
1051 } else if (EQ(field, Q_pq_port)) {
1053 /* PQport Returns the port of the connection.
1054 char *PQport(PGconn *conn)
1056 if ((p = PQport(P)))
1057 return make_int(atoi(p));
1059 return make_int(-1);
1060 } else if (EQ(field, Q_pq_tty)) {
1061 /* PQtty Returns the debug tty of the connection.
1062 char *PQtty(PGconn *conn)
1064 return build_ext_string(PQtty(P), PG_OS_CODING);
1065 } else if (EQ(field, Q_pq_options)) {
1066 /* PQoptions Returns the backend options used in the connection.
1067 char *PQoptions(PGconn *conn)
1069 return build_ext_string(PQoptions(P), PG_OS_CODING);
1070 } else if (EQ(field, Q_pq_status)) {
1072 /* PQstatus Returns the status of the connection. The status can be
1073 CONNECTION_OK or CONNECTION_BAD.
1074 ConnStatusType PQstatus(PGconn *conn)
1076 switch ((cst = PQstatus(P))) {
1078 return Q_pg_connection_ok;
1079 case CONNECTION_BAD:
1080 return Q_pg_connection_bad;
1081 #ifdef HAVE_POSTGRESQLV7
1082 case CONNECTION_STARTED:
1083 return Q_pg_connection_started;
1084 case CONNECTION_MADE:
1085 return Q_pg_connection_made;
1086 case CONNECTION_AWAITING_RESPONSE:
1087 return Q_pg_connection_awaiting_response;
1088 case CONNECTION_AUTH_OK:
1089 return Q_pg_connection_auth_ok;
1090 case CONNECTION_SETENV:
1091 return Q_pg_connection_setenv;
1092 #endif /* HAVE_POSTGRESQLV7 */
1094 /* they've added a new field we don't know about */
1095 error("Help! Unknown connection status code %08x "
1099 } else if (EQ(field, Q_pq_transaction_status)) {
1100 PGTransactionStatusType ts;
1101 switch ((ts = PQtransactionStatus(P))) {
1103 return Q_pg_trans_idle;
1104 case PQTRANS_ACTIVE:
1105 return Q_pg_trans_active;
1106 case PQTRANS_INTRANS:
1107 return Q_pg_trans_intrans;
1108 case PQTRANS_INERROR:
1109 return Q_pg_trans_inerror;
1110 case PQTRANS_UNKNOWN:
1111 return Q_pg_trans_unknown;
1113 /* they've added a new field we don't know about */
1114 error("Help! Unknown transaction status code %08x "
1118 } else if (EQ(field, Q_pq_parameter_status)) {
1120 } else if (EQ(field, Q_pq_protocol_version)) {
1121 return make_int(PQprotocolVersion(P));
1122 #if HAVE_PQSERVERVERSION
1123 } else if (EQ(field, Q_pq_server_version)) {
1124 return make_int(PQserverVersion(P));
1126 } else if (EQ(field, Q_pq_server_version)) {
1127 char *vstr = xstrdup(PQparameterStatus(P,"server_version"));
1128 char *tmp, previous;
1129 int major, minor, patch;
1133 tmp = strtok(vstr,".");
1135 tmp = strtok(NULL,".");
1137 tmp = strtok(NULL,".");
1140 return make_int(major*10000+minor*100+patch);
1142 } else if (EQ(field, Q_pq_error_message)) {
1143 /* PQerrorMessage Returns the error message most recently
1144 * generated by an operation on the connection.
1145 * char *PQerrorMessage(PGconn* conn);
1147 return build_ext_string(PQerrorMessage(P), PG_OS_CODING);
1148 } else if (EQ(field, Q_pq_backend_pid)) {
1149 /* PQbackendPID Returns the process ID of the backend server
1150 * handling this connection.
1151 * int PQbackendPID(PGconn *conn);
1153 return make_int(PQbackendPID(P));
1155 } else if (EQ(field, Q_pq_getssl)) {
1156 /* PQgetssl Returns the SSL structure used in the connection,
1157 * or NULL if SSL is not in use.
1158 * SSL *PQgetssl(PGconn *conn);
1161 ssl_conn = (SSL*)PQgetssl(P);
1162 if (ssl_conn == NULL)
1163 return Qnil; /* meaning: no SSL in use */
1165 Lisp_SSL_CONN *pqssl = allocate_ssl_conn();
1166 pqssl->ssl_conn = ssl_conn;
1167 pqssl->parent = conn;
1168 pqssl->protected_p = 1;
1169 return make_ssl_conn(pqssl);
1170 /* Should we use a copy of the SSL session here?
1171 * Otherwise it's safe to obtain a nice segfault by:
1172 * (setq m (pq-pgconn foo \'pq::getssl))
1173 * (setq m \'something-else)
1174 * M-x garbage-collect RET
1175 * (pq-send-query foo ...)
1176 * You will see SXE dump in ssl*_write or the like
1177 * since the _original_ session handle has been gc'd
1179 * Nah, _for the moment_ I assume our users to be
1180 * smart enough to rethink twice before they do
1181 * something like this.
1188 message("bad PGconn accessor");
1192 DEFUN("pq-connection-alive-p", Fpq_connection_alive_p, 1, 1, 0, /*
1193 Return non-nil when CONN is considered alive.
1195 This is roughly the same as calling (pq-connection-status CONN :status)
1203 P = (XPGCONN(conn))->pgconn;
1205 if (PQstatus(P) == CONNECTION_OK) {
1211 DEFUN("pq-connection-p", Fpq_connection_p, 1, 1, 0, /*
1212 Return non-nil if OBJECT is a pq connection object.
1216 return PGCONNP(object) ? Qt : Qnil;
1219 /* Query functions */
1220 DEFUN("pq-exec", Fpq_exec, 2, 2, 0, /*
1221 Submit a query to Postgres and wait for the result.
1226 Lisp_PGresult *lisp_pgresult;
1231 CHECK_STRING(query);
1233 P = (XPGCONN(conn))->pgconn;
1234 CHECK_CONNECTION_ALIVE(P);
1236 TO_EXTERNAL_FORMAT(LISP_STRING, query,
1237 C_STRING_ALLOCA, c_query, Qnative);
1239 R = PQexec(P, c_query);
1241 char *tag, buf[BLCKSZ];
1244 error("query: out of memory");
1246 switch (PQresultStatus(R)) {
1247 case PGRES_BAD_RESPONSE:
1248 tag = "bad response [%s]";
1250 case PGRES_NONFATAL_ERROR:
1251 tag = "non-fatal error [%s]";
1253 case PGRES_FATAL_ERROR:
1254 tag = "fatal error [%s]";
1256 strncpy(buf, PQresultErrorMessage(R),
1258 buf[sizeof(buf) - 1] = '\0';
1261 /*NOTREACHED*/ default:
1266 lisp_pgresult = allocate_pgresult();
1267 lisp_pgresult->pgresult = R;
1269 return make_pgresult(lisp_pgresult);
1272 DEFUN("pq-send-query", Fpq_send_query, 2, 2, 0, /*
1273 Submit a query to Postgres and don't wait for the result.
1274 Returns: t if successfully submitted
1275 nil if error (conn->errorMessage is set)
1283 CHECK_STRING(query);
1285 P = (XPGCONN(conn))->pgconn;
1286 CHECK_CONNECTION_ALIVE(P);
1288 TO_EXTERNAL_FORMAT(LISP_STRING, query,
1289 C_STRING_ALLOCA, c_query, Qnative);
1291 if (PQsendQuery(P, c_query))
1294 error("async query: %s", PQerrorMessage(P));
1297 DEFUN("pq-result-p", Fpq_result_p, 1, 1, 0, /*
1298 Return non-nil if OBJECT is a pq query result object.
1302 return PGRESULTP(object) ? Qt : Qnil;
1305 DEFUN("pq-get-result", Fpq_get_result, 1, 1, 0, /*
1306 Retrieve an asynchronous result from a query.
1307 NIL is returned when no more query work remains.
1312 Lisp_PGresult *lisp_pgresult;
1317 P = (XPGCONN(conn))->pgconn;
1318 CHECK_CONNECTION_ALIVE(P);
1322 return Qnil; /* not an error, there's no more data to get */
1325 char *tag, buf[BLCKSZ];
1327 switch (PQresultStatus(R)) {
1328 case PGRES_BAD_RESPONSE:
1329 tag = "bad response [%s]";
1331 case PGRES_NONFATAL_ERROR:
1332 tag = "non-fatal error [%s]";
1334 case PGRES_FATAL_ERROR:
1335 tag = "fatal error [%s]";
1337 strncpy(buf, PQresultErrorMessage(R), sizeof(buf));
1338 buf[sizeof(buf) - 1] = '\0';
1341 /*NOTREACHED*/ default:
1346 lisp_pgresult = allocate_pgresult();
1347 lisp_pgresult->pgresult = R;
1349 return make_pgresult(lisp_pgresult);
1352 DEFUN("pq-result-status", Fpq_result_status, 1, 1, 0, /*
1353 Return result status of the query.
1360 CHECK_PGRESULT(result);
1361 R = (XPGRESULT(result))->pgresult;
1364 switch ((est = PQresultStatus(R))) {
1365 case PGRES_EMPTY_QUERY:
1366 return Q_pgres_empty_query;
1367 case PGRES_COMMAND_OK:
1368 return Q_pgres_command_ok;
1369 case PGRES_TUPLES_OK:
1370 return Q_pgres_tuples_ok;
1371 case PGRES_COPY_OUT:
1372 return Q_pgres_copy_out;
1374 return Q_pgres_copy_in;
1375 case PGRES_BAD_RESPONSE:
1376 return Q_pgres_bad_response;
1377 case PGRES_NONFATAL_ERROR:
1378 return Q_pgres_nonfatal_error;
1379 case PGRES_FATAL_ERROR:
1380 return Q_pgres_fatal_error;
1382 /* they've added a new field we don't know about */
1383 error("Help! Unknown exec status code %08x from backend!",
1388 DEFUN("pq-result-status-string", Fpq_result_status_string, 1, 1, 0, /*
1389 Return stringified result status of the query.
1395 CHECK_PGRESULT(result);
1396 R = (XPGRESULT(result))->pgresult;
1399 return build_ext_string(PQresStatus(PQresultStatus(R)), PG_OS_CODING);
1402 /* Sundry PGresult accessor functions */
1403 DEFUN("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /*
1404 Return last message associated with the query.
1410 CHECK_PGRESULT(result);
1411 R = (XPGRESULT(result))->pgresult;
1414 return build_ext_string(PQresultErrorMessage(R), PG_OS_CODING);
1417 DEFUN("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
1418 Return the number of tuples (instances) in the query result.
1424 CHECK_PGRESULT(result);
1425 R = (XPGRESULT(result))->pgresult;
1428 return make_int(PQntuples(R));
1431 DEFUN("pq-nfields", Fpq_nfields, 1, 1, 0, /*
1432 Return the number of fields (attributes) in each tuple of the query result.
1438 CHECK_PGRESULT(result);
1439 R = (XPGRESULT(result))->pgresult;
1442 return make_int(PQnfields(R));
1445 DEFUN("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /*
1446 Return t if the query result contains binary data, nil otherwise.
1452 CHECK_PGRESULT(result);
1453 R = (XPGRESULT(result))->pgresult;
1456 return (PQbinaryTuples(R)) ? Qt : Qnil;
1459 DEFUN("pq-fname", Fpq_fname, 2, 2, 0, /*
1460 Return the field (attribute) name associated with the given field index.
1461 Field indices start at 0.
1463 (result, field_index))
1467 CHECK_PGRESULT(result);
1468 CHECK_INT(field_index);
1469 R = (XPGRESULT(result))->pgresult;
1472 return build_ext_string(PQfname(R, XINT(field_index)), PG_OS_CODING);
1475 DEFUN("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
1476 Return the number of fields (attributes) in each tuple of the query result.
1478 (result, field_name))
1483 CHECK_PGRESULT(result);
1484 CHECK_STRING(field_name);
1485 R = (XPGRESULT(result))->pgresult;
1488 TO_EXTERNAL_FORMAT(LISP_STRING, field_name,
1489 C_STRING_ALLOCA, c_field_name, Qnative);
1491 return make_int(PQfnumber(R, c_field_name));
1494 DEFUN("pq-ftype", Fpq_ftype, 2, 2, 0, /*
1495 Return the field type associated with the given field index.
1496 The integer returned is the internal coding of the type. Field indices
1499 (result, field_num))
1503 CHECK_PGRESULT(result);
1504 CHECK_INT(field_num);
1505 R = (XPGRESULT(result))->pgresult;
1508 return make_int(PQftype(R, XINT(field_num)));
1511 DEFUN("pq-fsize", Fpq_fsize, 2, 2, 0, /*
1512 Return the field size in bytes associated with the given field index.
1513 Field indices start at 0.
1515 (result, field_index))
1519 CHECK_PGRESULT(result);
1520 CHECK_INT(field_index);
1521 R = (XPGRESULT(result))->pgresult;
1524 return make_int(PQftype(R, XINT(field_index)));
1527 DEFUN("pq-fmod", Fpq_fmod, 2, 2, 0, /*
1528 Return the type modifier associated with a field.
1529 Field indices start at 0.
1531 (result, field_index))
1535 CHECK_PGRESULT(result);
1536 CHECK_INT(field_index);
1537 R = (XPGRESULT(result))->pgresult;
1540 return make_int(PQfmod(R, XINT(field_index)));
1543 DEFUN("pq-get-value", Fpq_get_value, 3, 3, 0, /*
1544 Return a single field (attribute) value of one tuple of a PGresult.
1545 Tuple and field indices start at 0.
1547 (result, tup_num, field_num))
1551 CHECK_PGRESULT(result);
1553 CHECK_INT(field_num);
1554 R = (XPGRESULT(result))->pgresult;
1557 return build_ext_string(PQgetvalue(R, XINT(tup_num), XINT(field_num)),
1561 DEFUN("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1562 Returns the length of a field value in bytes.
1563 If result is binary, i.e. a result of a binary portal, then the
1564 length returned does NOT include the size field of the varlena. (The
1565 data returned by PQgetvalue doesn't either.)
1567 (result, tup_num, field_num))
1571 CHECK_PGRESULT(result);
1573 CHECK_INT(field_num);
1574 R = (XPGRESULT(result))->pgresult;
1577 return make_int(PQgetlength(R, XINT(tup_num), XINT(field_num)));
1580 DEFUN("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /*
1581 Returns the null status of a field value.
1583 (result, tup_num, field_num))
1587 CHECK_PGRESULT(result);
1589 CHECK_INT(field_num);
1590 R = (XPGRESULT(result))->pgresult;
1593 return PQgetisnull(R, XINT(tup_num), XINT(field_num)) ? Qt : Qnil;
1596 DEFUN("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
1597 Returns the command status string from the SQL command that generated the result.
1603 CHECK_PGRESULT(result);
1604 R = (XPGRESULT(result))->pgresult;
1607 return build_ext_string(PQcmdStatus(R), PG_OS_CODING);
1610 DEFUN("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1611 Returns the number of rows affected by the SQL command.
1617 CHECK_PGRESULT(result);
1618 R = (XPGRESULT(result))->pgresult;
1621 return build_ext_string(PQcmdTuples(R), PG_OS_CODING);
1624 DEFUN("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
1625 Returns the object id of the tuple inserted.
1631 CHECK_PGRESULT(result);
1632 R = (XPGRESULT(result))->pgresult;
1635 #ifdef HAVE_POSTGRESQLV7
1636 return make_int(PQoidValue(R));
1638 /* Use the old interface */
1639 return make_int(atoi(PQoidStatus(R)));
1643 #ifdef HAVE_POSTGRESQLV7
1644 DEFUN("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /*
1645 Sets the PGconn's database connection non-blocking if the arg is TRUE
1646 or makes it non-blocking if the arg is FALSE, this will not protect
1647 you from PQexec(), you'll only be safe when using the non-blocking API.
1649 Needs to be called only on a connected database connection.
1656 P = (XPGCONN(conn))->pgconn;
1657 CHECK_CONNECTION_ALIVE(P);
1659 return make_int(PQsetnonblocking(P, !NILP(arg)));
1662 DEFUN("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
1663 Return the blocking status of the database connection.
1670 P = (XPGCONN(conn))->pgconn;
1671 CHECK_CONNECTION_ALIVE(P);
1673 return PQisnonblocking(P) ? Qt : Qnil;
1676 DEFUN("pq-flush", Fpq_flush, 1, 1, 0, /*
1677 Force the write buffer to be written (or at least try).
1684 P = (XPGCONN(conn))->pgconn;
1685 CHECK_CONNECTION_ALIVE(P);
1687 return make_int(PQflush(P));
1691 DEFUN("pq-notifies", Fpq_notifies, 1, 1, 0, /*
1692 Return the latest async notification that has not yet been handled.
1693 If there has been a notification, then a list of two elements will be returned.
1694 The first element contains the relation name being notified, the second
1695 element contains the backend process ID number. nil is returned if there
1696 aren't any notifications to process.
1700 /* This function cannot GC */
1705 P = (XPGCONN(conn))->pgconn;
1706 CHECK_CONNECTION_ALIVE(P);
1708 PGN = PQnotifies(P);
1714 temp = list2(build_ext_string(PGN->relname, PG_OS_CODING),
1715 make_int(PGN->be_pid));
1721 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1722 DEFUN("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
1723 Get encoding id from environment variable PGCLIENTENCODING.
1727 return make_int(PQenv2encoding());
1731 DEFUN("pq-lo-import", Fpq_lo_import, 2, 2, 0, /*
1739 CHECK_STRING(filename);
1741 P = (XPGCONN(conn))->pgconn;
1742 CHECK_CONNECTION_ALIVE(P);
1744 TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1745 C_STRING_ALLOCA, c_filename, Qfile_name);
1747 return make_int((int)lo_import(P, c_filename));
1750 DEFUN("pq-lo-export", Fpq_lo_export, 3, 3, 0, /*
1752 (conn, oid, filename))
1759 CHECK_STRING(filename);
1761 P = (XPGCONN(conn))->pgconn;
1762 CHECK_CONNECTION_ALIVE(P);
1764 TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1765 C_STRING_ALLOCA, c_filename, Qfile_name);
1767 return make_int((int)lo_export(P, XINT(oid), c_filename));
1770 DEFUN("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /*
1771 Make an empty PGresult object with the given status.
1776 Lisp_PGresult *lpgr;
1781 P = (XPGCONN(conn))->pgconn;
1782 CHECK_CONNECTION_ALIVE(P); /* needed here? */
1784 if (EQ(status, Q_pgres_empty_query))
1785 est = PGRES_EMPTY_QUERY;
1786 else if (EQ(status, Q_pgres_command_ok))
1787 est = PGRES_COMMAND_OK;
1788 else if (EQ(status, Q_pgres_tuples_ok))
1789 est = PGRES_TUPLES_OK;
1790 else if (EQ(status, Q_pgres_copy_out))
1791 est = PGRES_COPY_OUT;
1792 else if (EQ(status, Q_pgres_copy_in))
1793 est = PGRES_COPY_IN;
1794 else if (EQ(status, Q_pgres_bad_response))
1795 est = PGRES_BAD_RESPONSE;
1796 else if (EQ(status, Q_pgres_nonfatal_error))
1797 est = PGRES_NONFATAL_ERROR;
1798 else if (EQ(status, Q_pgres_fatal_error))
1799 est = PGRES_FATAL_ERROR;
1801 signal_simple_error("bad status symbol", status);
1803 R = PQmakeEmptyPGresult(P, est);
1805 error("out of memory?");
1807 lpgr = allocate_pgresult();
1810 return make_pgresult(lpgr);
1813 #ifdef HAVE_POSTGRESQLV7
1814 /* actually I don't know when this made its way to libpq
1815 * I just assume 7.4 here
1816 * Bite me, if that's wrong ;P
1818 DEFUN("pq-escape-string", Fpq_escape_string, 1, 1, 0, /*
1819 Return an SQL-suited escaped version of STRING.
1825 /* buffers for our args */
1829 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1830 C_STRING_ALLOCA, string_ext, PG_OS_CODING);
1831 string_len = (int)XSTRING_CHAR_LENGTH(string);
1833 result = (char *)xmalloc_atomic(4*XSTRING_LENGTH(string));
1835 result_len = PQescapeString(result, string_ext, string_len);
1837 return make_ext_string(result, result_len, PG_OS_CODING);
1840 DEFUN("pq-escape-bytea", Fpq_escape_bytea, 1, 1, 0, /*
1841 Return an SQL-suited escaped version of binary DATA.
1846 unsigned int result_len;
1847 /* buffers for our args */
1851 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1852 C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1853 data_len = (int)XSTRING_CHAR_LENGTH(data);
1855 result = (char*)PQescapeBytea((unsigned char*)data_ext, data_len,
1861 return make_ext_string(result,result_len-1,PG_OS_CODING);
1864 DEFUN("pq-unescape-bytea", Fpq_unescape_bytea, 1, 1, 0, /*
1865 Return the unescaped form of DATA (which may be binary).
1866 Such binary data may result from a BYTEA column.
1868 Note: Of course, escaped SQL strings are elisp-escaped again
1869 so you may have to use `pq-unescape-bytea' twice.
1874 unsigned int result_len;
1875 /* buffers for our args */
1878 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1879 C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1881 result = (char*)PQunescapeBytea((unsigned char*)data_ext,
1887 return make_ext_string(result,result_len,PG_OS_CODING);
1891 DEFUN("pq-get-line", Fpq_get_line, 1, 1, 0, /*
1892 Retrieve a line from server in copy in operation.
1893 The return value is a dotted pair where the cons cell is an integer code:
1894 -1: Copying is complete
1895 0: A record is complete
1896 1: A record is incomplete, it will be continued in the next `pq-get-line'
1898 and the cdr cell is returned string data.
1900 The copy operation is complete when the value `\.' (backslash dot) is
1905 char buffer[BLCKSZ]; /* size of a Postgres disk block */
1910 P = (XPGCONN(conn))->pgconn;
1911 CHECK_CONNECTION_ALIVE(P);
1913 ret = PQgetline(P, buffer, sizeof(buffer));
1915 return Fcons(make_int(ret), build_ext_string(buffer, PG_OS_CODING));
1918 DEFUN("pq-put-line", Fpq_put_line, 2, 2, 0, /*
1919 Send a line to the server in copy out operation.
1921 Returns t if the operation succeeded, nil otherwise.
1929 CHECK_STRING(string);
1931 P = (XPGCONN(conn))->pgconn;
1932 CHECK_CONNECTION_ALIVE(P);
1933 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1934 C_STRING_ALLOCA, c_string, Qnative);
1936 return !PQputline(P, c_string) ? Qt : Qnil;
1939 DEFUN("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
1940 Get a line from the server in copy in operation asynchronously.
1942 This routine is for applications that want to do "COPY <rel> to stdout"
1943 asynchronously, that is without blocking. Having issued the COPY command
1944 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
1945 and this routine until the end-of-data signal is detected. Unlike
1946 PQgetline, this routine takes responsibility for detecting end-of-data.
1948 On each call, PQgetlineAsync will return data if a complete newline-
1949 terminated data line is available in libpq's input buffer, or if the
1950 incoming data line is too long to fit in the buffer offered by the caller.
1951 Otherwise, no data is returned until the rest of the line arrives.
1953 If -1 is returned, the end-of-data signal has been recognized (and removed
1954 from libpq's input buffer). The caller *must* next call PQendcopy and
1955 then return to normal processing.
1958 -1 if the end-of-copy-data marker has been recognized
1959 0 if no data is available
1960 >0 the number of bytes returned.
1961 The data returned will not extend beyond a newline character. If possible
1962 a whole line will be returned at one time. But if the buffer offered by
1963 the caller is too small to hold a line sent by the backend, then a partial
1964 data line will be returned. This can be detected by testing whether the
1965 last returned byte is '\n' or not.
1966 The returned string is *not* null-terminated.
1971 char buffer[BLCKSZ];
1976 P = (XPGCONN(conn))->pgconn;
1977 CHECK_CONNECTION_ALIVE(P);
1979 ret = PQgetlineAsync(P, buffer, sizeof(buffer));
1982 return Qt; /* done! */
1984 return Qnil; /* no data yet */
1986 return Fcons(make_int(ret),
1987 make_ext_string((Extbyte *) buffer, ret,
1991 DEFUN("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1992 Asynchronous copy out.
1996 /* NULs are not allowed. I don't think this matters at this time. */
2003 P = (XPGCONN(conn))->pgconn;
2004 CHECK_CONNECTION_ALIVE(P);
2005 TO_EXTERNAL_FORMAT(LISP_STRING, data, C_STRING_ALLOCA, c_data, Qnative);
2007 return !PQputnbytes(P, c_data, strlen(c_data)) ? Qt : Qnil;
2010 DEFUN("pq-end-copy", Fpq_end_copy, 1, 1, 0, /*
2011 End a copying operation.
2018 P = (XPGCONN(conn))->pgconn;
2019 CHECK_CONNECTION_ALIVE(P);
2021 return PQendcopy(P) ? Qt : Qnil;
2026 syms_of_postgresql(void)
2028 INIT_LRECORD_IMPLEMENTATION(pgconn);
2029 INIT_LRECORD_IMPLEMENTATION(pgresult);
2031 defsymbol(&Qpostgresql, "postgresql");
2033 /* opaque exported types */
2034 defsymbol(&Qpgconnp, "pgconnp");
2035 defsymbol(&Qpgresultp, "pgresultp");
2037 /* connection status types
2038 * now implemented as keywords */
2039 DEFKEYWORD(Q_pg_connection_ok);
2040 DEFKEYWORD(Q_pg_connection_bad);
2041 DEFKEYWORD(Q_pg_connection_started);
2042 DEFKEYWORD(Q_pg_connection_made);
2043 DEFKEYWORD(Q_pg_connection_awaiting_response);
2044 DEFKEYWORD(Q_pg_connection_auth_ok);
2045 DEFKEYWORD(Q_pg_connection_setenv);
2047 /* transaction status types */
2048 DEFKEYWORD(Q_pg_trans_idle);
2049 DEFKEYWORD(Q_pg_trans_active);
2050 DEFKEYWORD(Q_pg_trans_intrans);
2051 DEFKEYWORD(Q_pg_trans_inerror);
2052 DEFKEYWORD(Q_pg_trans_unknown);
2054 /* Fields of PGconn */
2055 DEFKEYWORD(Q_pq_db);
2056 DEFKEYWORD(Q_pq_user);
2057 DEFKEYWORD(Q_pq_pass);
2058 DEFKEYWORD(Q_pq_host);
2059 DEFKEYWORD(Q_pq_port);
2060 DEFKEYWORD(Q_pq_tty);
2061 DEFKEYWORD(Q_pq_options);
2062 DEFKEYWORD(Q_pq_status);
2063 DEFKEYWORD(Q_pq_transaction_status);
2064 DEFKEYWORD(Q_pq_parameter_status);
2065 DEFKEYWORD(Q_pq_protocol_version);
2066 DEFKEYWORD(Q_pq_server_version);
2067 DEFKEYWORD(Q_pq_error_message);
2068 DEFKEYWORD(Q_pq_backend_pid);
2070 DEFKEYWORD(Q_pq_getssl);
2073 /* Query status results */
2074 DEFKEYWORD(Q_pgres_empty_query);
2075 DEFKEYWORD(Q_pgres_command_ok);
2076 DEFKEYWORD(Q_pgres_tuples_ok);
2077 DEFKEYWORD(Q_pgres_copy_out);
2078 DEFKEYWORD(Q_pgres_copy_in);
2079 DEFKEYWORD(Q_pgres_bad_response);
2080 DEFKEYWORD(Q_pgres_nonfatal_error);
2081 DEFKEYWORD(Q_pgres_fatal_error);
2083 /* Poll status results */
2084 DEFKEYWORD(Q_pgres_polling_failed);
2085 DEFKEYWORD(Q_pgres_polling_reading);
2086 DEFKEYWORD(Q_pgres_polling_writing);
2087 DEFKEYWORD(Q_pgres_polling_ok);
2088 DEFKEYWORD(Q_pgres_polling_active);
2090 #ifdef HAVE_POSTGRESQLV7
2091 DEFSUBR(Fpq_connect_start);
2092 DEFSUBR(Fpq_connect_poll);
2094 DEFSUBR(Fpq_client_encoding);
2095 DEFSUBR(Fpq_set_client_encoding);
2097 #endif /* HAVE_POSTGRESQLV7 */
2098 DEFSUBR(Fpq_set_notice_processor);
2100 DEFSUBR(Fpq_connection_p);
2101 DEFSUBR(Fpq_conn_defaults);
2102 DEFSUBR(Fpq_connectdb);
2103 DEFSUBR(Fpq_finish);
2105 DEFSUBR(Fpq_is_busy);
2106 DEFSUBR(Fpq_consume_input);
2108 #ifdef HAVE_POSTGRESQLV7
2109 DEFSUBR(Fpq_escape_string);
2110 DEFSUBR(Fpq_escape_bytea);
2111 DEFSUBR(Fpq_unescape_bytea);
2115 #ifdef HAVE_POSTGRESQLV7
2116 DEFSUBR(Fpq_reset_start);
2117 DEFSUBR(Fpq_reset_poll);
2119 DEFSUBR(Fpq_request_cancel);
2120 DEFSUBR(Fpq_connection_status);
2121 DEFSUBR(Fpq_connection_alive_p);
2124 DEFSUBR(Fpq_send_query);
2125 DEFSUBR(Fpq_result_p);
2126 DEFSUBR(Fpq_get_result);
2127 DEFSUBR(Fpq_result_status);
2128 DEFSUBR(Fpq_result_status_string);
2129 DEFSUBR(Fpq_result_error_message);
2130 DEFSUBR(Fpq_ntuples);
2131 DEFSUBR(Fpq_nfields);
2132 DEFSUBR(Fpq_binary_tuples);
2134 DEFSUBR(Fpq_fnumber);
2139 DEFSUBR(Fpq_get_value);
2140 DEFSUBR(Fpq_get_length);
2141 DEFSUBR(Fpq_get_is_null);
2142 DEFSUBR(Fpq_cmd_status);
2143 DEFSUBR(Fpq_cmd_tuples);
2144 DEFSUBR(Fpq_oid_value);
2146 #ifdef HAVE_POSTGRESQLV7
2147 DEFSUBR(Fpq_set_nonblocking);
2148 DEFSUBR(Fpq_is_nonblocking);
2151 DEFSUBR(Fpq_notifies);
2153 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
2154 DEFSUBR(Fpq_env_2_encoding);
2157 DEFSUBR(Fpq_lo_import);
2158 DEFSUBR(Fpq_lo_export);
2160 DEFSUBR(Fpq_make_empty_pgresult);
2162 /* copy in/out functions */
2163 DEFSUBR(Fpq_get_line);
2164 DEFSUBR(Fpq_put_line);
2165 DEFSUBR(Fpq_get_line_async);
2166 DEFSUBR(Fpq_put_nbytes);
2167 DEFSUBR(Fpq_end_copy);
2170 void vars_of_postgresql(void)
2172 Fprovide(Qpostgresql);
2173 #ifdef HAVE_POSTGRESQLV7
2174 Fprovide(intern("postgresqlv7"));
2176 Vpg_coding_system = Qnative;
2177 DEFVAR_LISP("pg-coding-system", &Vpg_coding_system /*
2178 Default Postgres client coding system.
2181 DEFVAR_LISP("pg:host", &VXPGHOST /*
2182 Default PostgreSQL server name.
2183 If not set, the server running on the local host is used. The
2184 initial value is set from the PGHOST environment variable.
2187 DEFVAR_LISP("pg:user", &VXPGUSER /*
2188 Default PostgreSQL user name.
2189 This value is used when connecting to a database for authentication.
2190 The initial value is set from the PGUSER environment variable.
2193 DEFVAR_LISP("pg:options", &VXPGOPTIONS /*
2194 Default PostgreSQL user name.
2195 This value is used when connecting to a database for authentication.
2196 The initial value is set from the PGUSER environment variable.
2199 DEFVAR_LISP("pg:port", &VXPGPORT /*
2200 Default port to connect to PostgreSQL backend.
2201 This value is used when connecting to a database.
2202 The initial value is set from the PGPORT environment variable.
2205 DEFVAR_LISP("pg:tty", &VXPGTTY /*
2206 Default debugging TTY.
2207 There is no useful setting of this variable in the XEmacs Lisp API.
2208 The initial value is set from the PGTTY environment variable.
2211 DEFVAR_LISP("pg:database", &VXPGDATABASE /*
2212 Default database to connect to.
2213 The initial value is set from the PGDATABASE environment variable.
2216 DEFVAR_LISP("pg:realm", &VXPGREALM /*
2217 Default kerberos realm to use for authentication.
2218 The initial value is set from the PGREALM environment variable.
2222 /* It's not clear whether this is any use. My intent is to
2223 autodetect the coding system from the database. */
2224 DEFVAR_LISP("pg:client-encoding", &VXPGCLIENTENCODING /*
2225 Default client encoding to use.
2226 The initial value is set from the PGCLIENTENCODING environment variable.
2230 #if !defined(HAVE_POSTGRESQLV7)
2231 DEFVAR_LISP("pg:authtype", &VXPGAUTHTYPE /*
2232 Default authentication to use.
2233 The initial value is set from the PGAUTHTYPE environment variable.
2235 WARNING: This variable has gone away in versions of PostgreSQL newer
2240 DEFVAR_LISP("pg:geqo", &VXPGGEQO /*
2241 Genetic Query Optimizer options.
2242 The initial value is set from the PGGEQO environment variable.
2245 DEFVAR_LISP("pg:cost-index", &VXPGCOSTINDEX /*
2246 Default cost index options.
2247 The initial value is set from the PGCOSTINDEX environment variable.
2250 DEFVAR_LISP("pg:cost-heap", &VXPGCOSTHEAP /*
2251 Default cost heap options.
2252 The initial value is set from the PGCOSTHEAP environment variable.
2255 DEFVAR_LISP("pg:tz", &VXPGTZ /*
2256 Default timezone to use.
2257 The initial value is set from the PGTZ environment variable.
2260 DEFVAR_LISP("pg:date-style", &VXPGDATESTYLE /*
2261 Default date style to use.
2262 The initial value is set from the PGDATESTYLE environment variable.
2266 /* These initializations should not be done at dump-time. */
2268 init_postgresql_from_environment(void)
2272 if ((p = getenv("PGHOST"))) {
2273 VXPGHOST = build_ext_string(p, PG_OS_CODING);
2278 if ((p = getenv("PGUSER"))) {
2279 VXPGUSER = build_ext_string(p, PG_OS_CODING);
2284 if ((p = getenv("PGOPTIONS"))) {
2285 VXPGOPTIONS = build_ext_string(p, PG_OS_CODING);
2290 if ((p = getenv("PGPORT"))) {
2291 VXPGPORT = make_int(atoi(p));
2296 if ((p = getenv("PGTTY"))) {
2297 VXPGTTY = build_ext_string(p, PG_OS_CODING);
2302 if ((p = getenv("PGDATABASE"))) {
2303 VXPGDATABASE = build_ext_string(p, PG_OS_CODING);
2305 VXPGDATABASE = Qnil;
2308 if ((p = getenv("PGREALM"))) {
2309 VXPGREALM = build_ext_string(p, PG_OS_CODING);
2315 /* It's not clear whether this is any use. My intent is to
2316 autodetect the coding system from the database. */
2317 if ((p = getenv("PGCLIENTENCODING"))) {
2318 VXPGCLIENTENCODING = build_ext_string(p, PG_OS_CODING);
2320 VXPGCLIENTENCODING = Qnil;
2324 #if !defined(HAVE_POSTGRESQLV7)
2325 if ((p = getenv("PGAUTHTYPE"))) {
2326 VXPGAUTHTYPE = build_ext_string(p, PG_OS_CODING);
2328 VXPGAUTHTYPE = Qnil;
2332 if ((p = getenv("PGGEQO"))) {
2333 VXPGGEQO = build_ext_string(p, PG_OS_CODING);
2338 if ((p = getenv("PGCOSTINDEX"))) {
2339 VXPGCOSTINDEX = build_ext_string(p, PG_OS_CODING);
2341 VXPGCOSTINDEX = Qnil;
2344 if ((p = getenv("PGCOSTHEAP"))) {
2345 VXPGCOSTHEAP = build_ext_string(p, PG_OS_CODING);
2347 VXPGCOSTHEAP = Qnil;
2350 if ((p = getenv("PGTZ"))) {
2351 VXPGTZ = build_ext_string(p, PG_OS_CODING);
2356 if ((p = getenv("PGDATESTYLE"))) {
2357 VXPGDATESTYLE = build_ext_string(p, PG_OS_CODING);
2359 VXPGDATESTYLE = Qnil;
2363 /* postgresql.c ends here */