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 xstrncpy(buf, error_message, sizeof(buf));
694 /* storage for the error message gets erased when
696 /* so we must temporarily stash it somewhere */
697 xstrncpy(buf, PQerrorMessage(P), sizeof(buf));
700 error("libpq: %s", buf);
704 /* PQconnectStart Makes a new asynchronous connection to a backend.
705 PGconn *PQconnectStart(const char *conninfo)
708 #ifdef HAVE_POSTGRESQLV7
709 DEFUN("pq-connect-start", Fpq_connect_start, 1, 1, 0, /*
710 Make a new asynchronous connection to a PostgreSQL backend.
712 See `pq-connectdb' for a complete description of conninfo.
717 Lisp_PGconn *lisp_pgconn;
718 char *error_message = "Out of Memory?";
723 CHECK_STRING(conninfo);
724 TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
725 C_STRING_ALLOCA, c_conninfo, Qnative);
726 P = PQconnectStart(c_conninfo);
728 if (P && (PQstatus(P) != CONNECTION_BAD)) {
729 lisp_pgconn = allocate_pgconn();
730 lisp_pgconn->pgconn = P;
731 lisp_pgconn->notice_processor = Qnil;
732 conn = make_pgconn(lisp_pgconn);
735 (PQnoticeProcessor)sxemacs_notice_processor,
739 /* capture the error message before destroying the object */
741 xstrncpy(buf, error_message, sizeof(buf));
743 xstrncpy(buf, PQerrorMessage(P), sizeof(buf));
746 error("libpq: %s", buf);
751 DEFUN("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
752 Poll an asynchronous connection for completion
757 PostgresPollingStatusType polling_status;
761 P = (XPGCONN(conn))->pgconn;
762 CHECK_CONNECTION_ELIGIBLE(P);
764 polling_status = PQconnectPoll(P);
765 switch (polling_status) {
766 case PGRES_POLLING_FAILED:
767 /* Something Bad has happened */
769 char *e = PQerrorMessage(P);
770 error("libpq: %s", e);
772 case PGRES_POLLING_OK:
773 return Q_pgres_polling_ok;
774 case PGRES_POLLING_READING:
775 return Q_pgres_polling_reading;
776 case PGRES_POLLING_WRITING:
777 return Q_pgres_polling_writing;
778 case PGRES_POLLING_ACTIVE:
779 return Q_pgres_polling_active;
781 /* they've added a new field we don't know about */
782 error("Help! Unknown status code %08x from backend!",
788 DEFUN("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /*
789 Return client coding system.
796 P = (XPGCONN(conn))->pgconn;
797 CHECK_CONNECTION_ALIVE(P);
799 return make_int(PQclientEncoding(P));
802 DEFUN("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /*
803 Set client coding system.
812 CHECK_STRING(encoding);
814 P = (XPGCONN(conn))->pgconn;
815 CHECK_CONNECTION_ALIVE(P);
817 TO_EXTERNAL_FORMAT(LISP_STRING, encoding,
818 C_STRING_ALLOCA, c_encoding, Qnative);
820 if ((rc = PQsetClientEncoding(P, c_encoding)) < 0)
821 error("bad encoding");
827 #endif /* HAVE_POSTGRESQLV7 */
829 /* PQfinish Close the connection to the backend. Also frees memory
830 used by the PGconn object.
831 void PQfinish(PGconn *conn)
833 DEFUN("pq-finish", Fpq_finish, 1, 1, 0, /*
834 Close the connection to the backend.
841 P = (XPGCONN(conn))->pgconn;
845 /* #### PQfinish deallocates the PGconn structure, so we now have a
847 /* Genocided all @'s ... */
848 (XPGCONN(conn))->pgconn = (PGconn *) NULL; /* You feel DEAD inside */
852 DEFUN("pq-clear", Fpq_clear, 1, 1, 0, /*
853 Forcibly erase a PGresult object.
860 R = (XPGRESULT(res))->pgresult;
864 /* Genocided all @'s ... */
865 (XPGRESULT(res))->pgresult = (PGresult *) NULL; /* You feel DEAD inside */
870 DEFUN("pq-is-busy", Fpq_is_busy, 1, 1, 0, /*
871 Return t if PQgetResult would block waiting for input.
878 P = (XPGCONN(conn))->pgconn;
879 CHECK_CONNECTION_ALIVE(P);
881 return PQisBusy(P) ? Qt : Qnil;
884 DEFUN("pq-consume-input", Fpq_consume_input, 1, 1, 0, /*
885 Consume any available input from the backend.
886 Returns nil if something bad happened.
893 P = (XPGCONN(conn))->pgconn;
894 CHECK_CONNECTION_ALIVE(P);
896 return PQconsumeInput(P) ? Qt : Qnil;
899 /* PQreset Reset the communication port with the backend.
900 void PQreset(PGconn *conn)
902 DEFUN("pq-reset", Fpq_reset, 1, 1, 0, /*
903 Reset the connection to the backend.
904 This function will close the connection to the backend and attempt to
905 reestablish a new connection to the same postmaster, using all the same
906 parameters previously used. This may be useful for error recovery if a
907 working connection is lost.
914 P = (XPGCONN(conn))->pgconn;
916 /* we can resurrect a BAD connection, but not a dead one. */
923 #ifdef HAVE_POSTGRESQLV7
924 DEFUN("pq-reset-start", Fpq_reset_start, 1, 1, 0, /*
925 Reset connection to the backend asynchronously.
932 P = (XPGCONN(conn))->pgconn;
933 CHECK_CONNECTION_ALIVE(P);
938 char *e = PQerrorMessage(P);
939 error("libpq: %s", e);
943 DEFUN("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
944 Poll an asynchronous reset for completion.
949 PostgresPollingStatusType polling_status;
953 P = (XPGCONN(conn))->pgconn;
954 CHECK_CONNECTION_ELIGIBLE(P);
956 polling_status = PQresetPoll(P);
957 switch (polling_status) {
958 case PGRES_POLLING_FAILED:
959 /* Something Bad has happened */
961 char *e = PQerrorMessage(P);
962 error("libpq: %s", e);
964 case PGRES_POLLING_OK:
965 return Q_pgres_polling_ok;
966 case PGRES_POLLING_READING:
967 return Q_pgres_polling_reading;
968 case PGRES_POLLING_WRITING:
969 return Q_pgres_polling_writing;
970 case PGRES_POLLING_ACTIVE:
971 return Q_pgres_polling_active;
973 /* they've added a new field we don't know about */
974 error("Help! Unknown status code %08x from backend!",
980 DEFUN("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
981 Attempt to request cancellation of the current operation.
983 The return value is t if the cancel request was successfully
984 dispatched, nil if not (in which case conn->errorMessage is set).
985 Note: successful dispatch is no guarantee that there will be any effect at
986 the backend. The application must read the operation result as usual.
993 P = (XPGCONN(conn))->pgconn;
994 CHECK_CONNECTION_ALIVE(P);
996 return PQrequestCancel(P) ? Qt : Qnil;
999 /* accessor function for the PGconn object */
1000 DEFUN("pq-connection-status", Fpq_connection_status, 2, 2, 0, /*
1001 Accessor function for the PGconn object.
1002 Currently recognized symbols for the field:
1003 :pq-db Database name
1004 :pq-user Database user name
1005 :pq-pass Database user's password
1006 :pq-host Hostname of PostgreSQL backend connected to
1007 :pq-port TCP port number of connection
1008 :pq-tty Debugging TTY (not used in Emacs)
1009 :pq-options Additional backend options
1010 :pq-status Connection status (either OK or BAD)
1011 :pq-transaction-status Current in-transaction status of the server
1012 :pq-parameter-status Current parameter setting of the server
1013 :pq-protocol-version Frontend/Backend protocol
1014 :pq-server-version Integer representing the backend version
1015 :pq-error-message Last error message from the backend
1016 :pq-backend-pid Process ID of backend process
1017 :pq-getssl SSL session used in the connection
1024 P = (XPGCONN(conn))->pgconn;
1025 PUKE_IF_NULL(P); /* BAD connections still have state to query */
1027 if (EQ(field, Q_pq_db)) {
1028 /* PQdb Returns the database name of the connection.
1029 char *PQdb(PGconn *conn)
1031 return build_ext_string(PQdb(P), PG_OS_CODING);
1032 } else if (EQ(field, Q_pq_user)) {
1033 /* PQuser Returns the user name of the connection.
1034 char *PQuser(PGconn *conn)
1036 return build_ext_string(PQuser(P), PG_OS_CODING);
1037 } else if (EQ(field, Q_pq_pass)) {
1038 /* PQpass Returns the password of the connection.
1039 char *PQpass(PGconn *conn)
1041 return build_ext_string(PQpass(P), PG_OS_CODING);
1042 } else if (EQ(field, Q_pq_host)) {
1043 /* PQhost Returns the server host name of the connection.
1044 char *PQhost(PGconn *conn)
1046 return build_ext_string(PQhost(P), PG_OS_CODING);
1047 } else if (EQ(field, Q_pq_port)) {
1049 /* PQport Returns the port of the connection.
1050 char *PQport(PGconn *conn)
1052 if ((p = PQport(P)))
1053 return make_int(atoi(p));
1055 return make_int(-1);
1056 } else if (EQ(field, Q_pq_tty)) {
1057 /* PQtty Returns the debug tty of the connection.
1058 char *PQtty(PGconn *conn)
1060 return build_ext_string(PQtty(P), PG_OS_CODING);
1061 } else if (EQ(field, Q_pq_options)) {
1062 /* PQoptions Returns the backend options used in the connection.
1063 char *PQoptions(PGconn *conn)
1065 return build_ext_string(PQoptions(P), PG_OS_CODING);
1066 } else if (EQ(field, Q_pq_status)) {
1068 /* PQstatus Returns the status of the connection. The status can be
1069 CONNECTION_OK or CONNECTION_BAD.
1070 ConnStatusType PQstatus(PGconn *conn)
1072 switch ((cst = PQstatus(P))) {
1074 return Q_pg_connection_ok;
1075 case CONNECTION_BAD:
1076 return Q_pg_connection_bad;
1077 #ifdef HAVE_POSTGRESQLV7
1078 case CONNECTION_STARTED:
1079 return Q_pg_connection_started;
1080 case CONNECTION_MADE:
1081 return Q_pg_connection_made;
1082 case CONNECTION_AWAITING_RESPONSE:
1083 return Q_pg_connection_awaiting_response;
1084 case CONNECTION_AUTH_OK:
1085 return Q_pg_connection_auth_ok;
1086 case CONNECTION_SETENV:
1087 return Q_pg_connection_setenv;
1088 #endif /* HAVE_POSTGRESQLV7 */
1090 /* they've added a new field we don't know about */
1091 error("Help! Unknown connection status code %08x "
1095 } else if (EQ(field, Q_pq_transaction_status)) {
1096 PGTransactionStatusType ts;
1097 switch ((ts = PQtransactionStatus(P))) {
1099 return Q_pg_trans_idle;
1100 case PQTRANS_ACTIVE:
1101 return Q_pg_trans_active;
1102 case PQTRANS_INTRANS:
1103 return Q_pg_trans_intrans;
1104 case PQTRANS_INERROR:
1105 return Q_pg_trans_inerror;
1106 case PQTRANS_UNKNOWN:
1107 return Q_pg_trans_unknown;
1109 /* they've added a new field we don't know about */
1110 error("Help! Unknown transaction status code %08x "
1114 } else if (EQ(field, Q_pq_parameter_status)) {
1116 } else if (EQ(field, Q_pq_protocol_version)) {
1117 return make_int(PQprotocolVersion(P));
1118 #if HAVE_PQSERVERVERSION
1119 } else if (EQ(field, Q_pq_server_version)) {
1120 return make_int(PQserverVersion(P));
1122 } else if (EQ(field, Q_pq_server_version)) {
1123 char *vstr = xstrdup(PQparameterStatus(P,"server_version"));
1124 char *tmp, previous;
1125 int major, minor, patch;
1129 tmp = strtok(vstr,".");
1131 tmp = strtok(NULL,".");
1133 tmp = strtok(NULL,".");
1136 return make_int(major*10000+minor*100+patch);
1138 } else if (EQ(field, Q_pq_error_message)) {
1139 /* PQerrorMessage Returns the error message most recently
1140 * generated by an operation on the connection.
1141 * char *PQerrorMessage(PGconn* conn);
1143 return build_ext_string(PQerrorMessage(P), PG_OS_CODING);
1144 } else if (EQ(field, Q_pq_backend_pid)) {
1145 /* PQbackendPID Returns the process ID of the backend server
1146 * handling this connection.
1147 * int PQbackendPID(PGconn *conn);
1149 return make_int(PQbackendPID(P));
1151 } else if (EQ(field, Q_pq_getssl)) {
1152 /* PQgetssl Returns the SSL structure used in the connection,
1153 * or NULL if SSL is not in use.
1154 * SSL *PQgetssl(PGconn *conn);
1157 ssl_conn = (SSL*)PQgetssl(P);
1158 if (ssl_conn == NULL)
1159 return Qnil; /* meaning: no SSL in use */
1161 Lisp_SSL_CONN *pqssl = allocate_ssl_conn();
1162 pqssl->ssl_conn = ssl_conn;
1163 pqssl->parent = conn;
1164 pqssl->protected_p = 1;
1165 return make_ssl_conn(pqssl);
1166 /* Should we use a copy of the SSL session here?
1167 * Otherwise it's safe to obtain a nice segfault by:
1168 * (setq m (pq-pgconn foo \'pq::getssl))
1169 * (setq m \'something-else)
1170 * M-x garbage-collect RET
1171 * (pq-send-query foo ...)
1172 * You will see SXE dump in ssl*_write or the like
1173 * since the _original_ session handle has been gc'd
1175 * Nah, _for the moment_ I assume our users to be
1176 * smart enough to rethink twice before they do
1177 * something like this.
1184 message("bad PGconn accessor");
1188 DEFUN("pq-connection-alive-p", Fpq_connection_alive_p, 1, 1, 0, /*
1189 Return non-nil when CONN is considered alive.
1191 This is roughly the same as calling (pq-connection-status CONN :status)
1199 P = (XPGCONN(conn))->pgconn;
1201 if (PQstatus(P) == CONNECTION_OK) {
1207 DEFUN("pq-connection-p", Fpq_connection_p, 1, 1, 0, /*
1208 Return non-nil if OBJECT is a pq connection object.
1212 return PGCONNP(object) ? Qt : Qnil;
1215 /* Query functions */
1216 DEFUN("pq-exec", Fpq_exec, 2, 2, 0, /*
1217 Submit a query to Postgres and wait for the result.
1222 Lisp_PGresult *lisp_pgresult;
1227 CHECK_STRING(query);
1229 P = (XPGCONN(conn))->pgconn;
1230 CHECK_CONNECTION_ALIVE(P);
1232 TO_EXTERNAL_FORMAT(LISP_STRING, query,
1233 C_STRING_ALLOCA, c_query, Qnative);
1235 R = PQexec(P, c_query);
1237 char *tag, buf[BLCKSZ];
1240 error("query: out of memory");
1242 switch (PQresultStatus(R)) {
1243 case PGRES_BAD_RESPONSE:
1244 tag = "bad response [%s]";
1246 case PGRES_NONFATAL_ERROR:
1247 tag = "non-fatal error [%s]";
1249 case PGRES_FATAL_ERROR:
1250 tag = "fatal error [%s]";
1252 xstrncpy(buf, PQresultErrorMessage(R),
1256 /*NOTREACHED*/ default:
1261 lisp_pgresult = allocate_pgresult();
1262 lisp_pgresult->pgresult = R;
1264 return make_pgresult(lisp_pgresult);
1267 DEFUN("pq-send-query", Fpq_send_query, 2, 2, 0, /*
1268 Submit a query to Postgres and don't wait for the result.
1269 Returns: t if successfully submitted
1270 nil if error (conn->errorMessage is set)
1278 CHECK_STRING(query);
1280 P = (XPGCONN(conn))->pgconn;
1281 CHECK_CONNECTION_ALIVE(P);
1283 TO_EXTERNAL_FORMAT(LISP_STRING, query,
1284 C_STRING_ALLOCA, c_query, Qnative);
1286 if (PQsendQuery(P, c_query))
1289 error("async query: %s", PQerrorMessage(P));
1292 DEFUN("pq-result-p", Fpq_result_p, 1, 1, 0, /*
1293 Return non-nil if OBJECT is a pq query result object.
1297 return PGRESULTP(object) ? Qt : Qnil;
1300 DEFUN("pq-get-result", Fpq_get_result, 1, 1, 0, /*
1301 Retrieve an asynchronous result from a query.
1302 NIL is returned when no more query work remains.
1307 Lisp_PGresult *lisp_pgresult;
1312 P = (XPGCONN(conn))->pgconn;
1313 CHECK_CONNECTION_ALIVE(P);
1317 return Qnil; /* not an error, there's no more data to get */
1320 char *tag, buf[BLCKSZ];
1322 switch (PQresultStatus(R)) {
1323 case PGRES_BAD_RESPONSE:
1324 tag = "bad response [%s]";
1326 case PGRES_NONFATAL_ERROR:
1327 tag = "non-fatal error [%s]";
1329 case PGRES_FATAL_ERROR:
1330 tag = "fatal error [%s]";
1332 xstrncpy(buf, PQresultErrorMessage(R), sizeof(buf));
1335 /*NOTREACHED*/ default:
1340 lisp_pgresult = allocate_pgresult();
1341 lisp_pgresult->pgresult = R;
1343 return make_pgresult(lisp_pgresult);
1346 DEFUN("pq-result-status", Fpq_result_status, 1, 1, 0, /*
1347 Return result status of the query.
1354 CHECK_PGRESULT(result);
1355 R = (XPGRESULT(result))->pgresult;
1358 switch ((est = PQresultStatus(R))) {
1359 case PGRES_EMPTY_QUERY:
1360 return Q_pgres_empty_query;
1361 case PGRES_COMMAND_OK:
1362 return Q_pgres_command_ok;
1363 case PGRES_TUPLES_OK:
1364 return Q_pgres_tuples_ok;
1365 case PGRES_COPY_OUT:
1366 return Q_pgres_copy_out;
1368 return Q_pgres_copy_in;
1369 case PGRES_BAD_RESPONSE:
1370 return Q_pgres_bad_response;
1371 case PGRES_NONFATAL_ERROR:
1372 return Q_pgres_nonfatal_error;
1373 case PGRES_FATAL_ERROR:
1374 return Q_pgres_fatal_error;
1376 /* they've added a new field we don't know about */
1377 error("Help! Unknown exec status code %08x from backend!",
1382 DEFUN("pq-result-status-string", Fpq_result_status_string, 1, 1, 0, /*
1383 Return stringified result status of the query.
1389 CHECK_PGRESULT(result);
1390 R = (XPGRESULT(result))->pgresult;
1393 return build_ext_string(PQresStatus(PQresultStatus(R)), PG_OS_CODING);
1396 /* Sundry PGresult accessor functions */
1397 DEFUN("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /*
1398 Return last message associated with the query.
1404 CHECK_PGRESULT(result);
1405 R = (XPGRESULT(result))->pgresult;
1408 return build_ext_string(PQresultErrorMessage(R), PG_OS_CODING);
1411 DEFUN("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
1412 Return the number of tuples (instances) in the query result.
1418 CHECK_PGRESULT(result);
1419 R = (XPGRESULT(result))->pgresult;
1422 return make_int(PQntuples(R));
1425 DEFUN("pq-nfields", Fpq_nfields, 1, 1, 0, /*
1426 Return the number of fields (attributes) in each tuple of the query result.
1432 CHECK_PGRESULT(result);
1433 R = (XPGRESULT(result))->pgresult;
1436 return make_int(PQnfields(R));
1439 DEFUN("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /*
1440 Return t if the query result contains binary data, nil otherwise.
1446 CHECK_PGRESULT(result);
1447 R = (XPGRESULT(result))->pgresult;
1450 return (PQbinaryTuples(R)) ? Qt : Qnil;
1453 DEFUN("pq-fname", Fpq_fname, 2, 2, 0, /*
1454 Return the field (attribute) name associated with the given field index.
1455 Field indices start at 0.
1457 (result, field_index))
1461 CHECK_PGRESULT(result);
1462 CHECK_INT(field_index);
1463 R = (XPGRESULT(result))->pgresult;
1466 return build_ext_string(PQfname(R, XINT(field_index)), PG_OS_CODING);
1469 DEFUN("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
1470 Return the number of fields (attributes) in each tuple of the query result.
1472 (result, field_name))
1477 CHECK_PGRESULT(result);
1478 CHECK_STRING(field_name);
1479 R = (XPGRESULT(result))->pgresult;
1482 TO_EXTERNAL_FORMAT(LISP_STRING, field_name,
1483 C_STRING_ALLOCA, c_field_name, Qnative);
1485 return make_int(PQfnumber(R, c_field_name));
1488 DEFUN("pq-ftype", Fpq_ftype, 2, 2, 0, /*
1489 Return the field type associated with the given field index.
1490 The integer returned is the internal coding of the type. Field indices
1493 (result, field_num))
1497 CHECK_PGRESULT(result);
1498 CHECK_INT(field_num);
1499 R = (XPGRESULT(result))->pgresult;
1502 return make_int(PQftype(R, XINT(field_num)));
1505 DEFUN("pq-fsize", Fpq_fsize, 2, 2, 0, /*
1506 Return the field size in bytes associated with the given field index.
1507 Field indices start at 0.
1509 (result, field_index))
1513 CHECK_PGRESULT(result);
1514 CHECK_INT(field_index);
1515 R = (XPGRESULT(result))->pgresult;
1518 return make_int(PQftype(R, XINT(field_index)));
1521 DEFUN("pq-fmod", Fpq_fmod, 2, 2, 0, /*
1522 Return the type modifier associated with a field.
1523 Field indices start at 0.
1525 (result, field_index))
1529 CHECK_PGRESULT(result);
1530 CHECK_INT(field_index);
1531 R = (XPGRESULT(result))->pgresult;
1534 return make_int(PQfmod(R, XINT(field_index)));
1537 DEFUN("pq-get-value", Fpq_get_value, 3, 3, 0, /*
1538 Return a single field (attribute) value of one tuple of a PGresult.
1539 Tuple and field indices start at 0.
1541 (result, tup_num, field_num))
1545 CHECK_PGRESULT(result);
1547 CHECK_INT(field_num);
1548 R = (XPGRESULT(result))->pgresult;
1551 return build_ext_string(PQgetvalue(R, XINT(tup_num), XINT(field_num)),
1555 DEFUN("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1556 Returns the length of a field value in bytes.
1557 If result is binary, i.e. a result of a binary portal, then the
1558 length returned does NOT include the size field of the varlena. (The
1559 data returned by PQgetvalue doesn't either.)
1561 (result, tup_num, field_num))
1565 CHECK_PGRESULT(result);
1567 CHECK_INT(field_num);
1568 R = (XPGRESULT(result))->pgresult;
1571 return make_int(PQgetlength(R, XINT(tup_num), XINT(field_num)));
1574 DEFUN("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /*
1575 Returns the null status of a field value.
1577 (result, tup_num, field_num))
1581 CHECK_PGRESULT(result);
1583 CHECK_INT(field_num);
1584 R = (XPGRESULT(result))->pgresult;
1587 return PQgetisnull(R, XINT(tup_num), XINT(field_num)) ? Qt : Qnil;
1590 DEFUN("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
1591 Returns the command status string from the SQL command that generated the result.
1597 CHECK_PGRESULT(result);
1598 R = (XPGRESULT(result))->pgresult;
1601 return build_ext_string(PQcmdStatus(R), PG_OS_CODING);
1604 DEFUN("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1605 Returns the number of rows affected by the SQL command.
1611 CHECK_PGRESULT(result);
1612 R = (XPGRESULT(result))->pgresult;
1615 return build_ext_string(PQcmdTuples(R), PG_OS_CODING);
1618 DEFUN("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
1619 Returns the object id of the tuple inserted.
1625 CHECK_PGRESULT(result);
1626 R = (XPGRESULT(result))->pgresult;
1629 #ifdef HAVE_POSTGRESQLV7
1630 return make_int(PQoidValue(R));
1632 /* Use the old interface */
1633 return make_int(atoi(PQoidStatus(R)));
1637 #ifdef HAVE_POSTGRESQLV7
1638 DEFUN("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /*
1639 Sets the PGconn's database connection non-blocking if the arg is TRUE
1640 or makes it non-blocking if the arg is FALSE, this will not protect
1641 you from PQexec(), you'll only be safe when using the non-blocking API.
1643 Needs to be called only on a connected database connection.
1650 P = (XPGCONN(conn))->pgconn;
1651 CHECK_CONNECTION_ALIVE(P);
1653 return make_int(PQsetnonblocking(P, !NILP(arg)));
1656 DEFUN("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
1657 Return the blocking status of the database connection.
1664 P = (XPGCONN(conn))->pgconn;
1665 CHECK_CONNECTION_ALIVE(P);
1667 return PQisnonblocking(P) ? Qt : Qnil;
1670 DEFUN("pq-flush", Fpq_flush, 1, 1, 0, /*
1671 Force the write buffer to be written (or at least try).
1678 P = (XPGCONN(conn))->pgconn;
1679 CHECK_CONNECTION_ALIVE(P);
1681 return make_int(PQflush(P));
1685 DEFUN("pq-notifies", Fpq_notifies, 1, 1, 0, /*
1686 Return the latest async notification that has not yet been handled.
1687 If there has been a notification, then a list of two elements will be returned.
1688 The first element contains the relation name being notified, the second
1689 element contains the backend process ID number. nil is returned if there
1690 aren't any notifications to process.
1694 /* This function cannot GC */
1699 P = (XPGCONN(conn))->pgconn;
1700 CHECK_CONNECTION_ALIVE(P);
1702 PGN = PQnotifies(P);
1708 temp = list2(build_ext_string(PGN->relname, PG_OS_CODING),
1709 make_int(PGN->be_pid));
1715 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1716 DEFUN("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
1717 Get encoding id from environment variable PGCLIENTENCODING.
1721 return make_int(PQenv2encoding());
1725 DEFUN("pq-lo-import", Fpq_lo_import, 2, 2, 0, /*
1733 CHECK_STRING(filename);
1735 P = (XPGCONN(conn))->pgconn;
1736 CHECK_CONNECTION_ALIVE(P);
1738 TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1739 C_STRING_ALLOCA, c_filename, Qfile_name);
1741 return make_int((int)lo_import(P, c_filename));
1744 DEFUN("pq-lo-export", Fpq_lo_export, 3, 3, 0, /*
1746 (conn, oid, filename))
1753 CHECK_STRING(filename);
1755 P = (XPGCONN(conn))->pgconn;
1756 CHECK_CONNECTION_ALIVE(P);
1758 TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1759 C_STRING_ALLOCA, c_filename, Qfile_name);
1761 return make_int((int)lo_export(P, XINT(oid), c_filename));
1764 DEFUN("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /*
1765 Make an empty PGresult object with the given status.
1770 Lisp_PGresult *lpgr;
1775 P = (XPGCONN(conn))->pgconn;
1776 CHECK_CONNECTION_ALIVE(P); /* needed here? */
1778 if (EQ(status, Q_pgres_empty_query))
1779 est = PGRES_EMPTY_QUERY;
1780 else if (EQ(status, Q_pgres_command_ok))
1781 est = PGRES_COMMAND_OK;
1782 else if (EQ(status, Q_pgres_tuples_ok))
1783 est = PGRES_TUPLES_OK;
1784 else if (EQ(status, Q_pgres_copy_out))
1785 est = PGRES_COPY_OUT;
1786 else if (EQ(status, Q_pgres_copy_in))
1787 est = PGRES_COPY_IN;
1788 else if (EQ(status, Q_pgres_bad_response))
1789 est = PGRES_BAD_RESPONSE;
1790 else if (EQ(status, Q_pgres_nonfatal_error))
1791 est = PGRES_NONFATAL_ERROR;
1792 else if (EQ(status, Q_pgres_fatal_error))
1793 est = PGRES_FATAL_ERROR;
1795 signal_simple_error("bad status symbol", status);
1797 R = PQmakeEmptyPGresult(P, est);
1799 error("out of memory?");
1801 lpgr = allocate_pgresult();
1804 return make_pgresult(lpgr);
1807 #ifdef HAVE_POSTGRESQLV7
1808 /* actually I don't know when this made its way to libpq
1809 * I just assume 7.4 here
1810 * Bite me, if that's wrong ;P
1812 DEFUN("pq-escape-string", Fpq_escape_string, 1, 1, 0, /*
1813 Return an SQL-suited escaped version of STRING.
1819 /* buffers for our args */
1823 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1824 C_STRING_ALLOCA, string_ext, PG_OS_CODING);
1825 string_len = (int)XSTRING_CHAR_LENGTH(string);
1827 result = (char *)xmalloc_atomic(4*XSTRING_LENGTH(string));
1829 result_len = PQescapeString(result, string_ext, string_len);
1831 return make_ext_string(result, result_len, PG_OS_CODING);
1834 DEFUN("pq-escape-bytea", Fpq_escape_bytea, 1, 1, 0, /*
1835 Return an SQL-suited escaped version of binary DATA.
1841 /* buffers for our args */
1845 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1846 C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1847 data_len = (int)XSTRING_CHAR_LENGTH(data);
1849 result = (char*)PQescapeBytea(
1850 (unsigned char*)data_ext, data_len, &result_len);
1855 return make_ext_string(result,result_len-1,PG_OS_CODING);
1858 DEFUN("pq-unescape-bytea", Fpq_unescape_bytea, 1, 1, 0, /*
1859 Return the unescaped form of DATA (which may be binary).
1860 Such binary data may result from a BYTEA column.
1862 Note: Of course, escaped SQL strings are elisp-escaped again
1863 so you may have to use `pq-unescape-bytea' twice.
1869 /* buffers for our args */
1872 TO_EXTERNAL_FORMAT(LISP_STRING, data,
1873 C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1875 result = (char*)PQunescapeBytea(
1876 (unsigned char*)data_ext, &result_len);
1881 return make_ext_string(result,result_len,PG_OS_CODING);
1885 DEFUN("pq-get-line", Fpq_get_line, 1, 1, 0, /*
1886 Retrieve a line from server in copy in operation.
1887 The return value is a dotted pair where the cons cell is an integer code:
1888 -1: Copying is complete
1889 0: A record is complete
1890 1: A record is incomplete, it will be continued in the next `pq-get-line'
1892 and the cdr cell is returned string data.
1894 The copy operation is complete when the value `\.' (backslash dot) is
1899 char buffer[BLCKSZ]; /* size of a Postgres disk block */
1904 P = (XPGCONN(conn))->pgconn;
1905 CHECK_CONNECTION_ALIVE(P);
1907 ret = PQgetline(P, buffer, sizeof(buffer));
1909 return Fcons(make_int(ret), build_ext_string(buffer, PG_OS_CODING));
1912 DEFUN("pq-put-line", Fpq_put_line, 2, 2, 0, /*
1913 Send a line to the server in copy out operation.
1915 Returns t if the operation succeeded, nil otherwise.
1923 CHECK_STRING(string);
1925 P = (XPGCONN(conn))->pgconn;
1926 CHECK_CONNECTION_ALIVE(P);
1927 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1928 C_STRING_ALLOCA, c_string, Qnative);
1930 return !PQputline(P, c_string) ? Qt : Qnil;
1933 DEFUN("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
1934 Get a line from the server in copy in operation asynchronously.
1936 This routine is for applications that want to do "COPY <rel> to stdout"
1937 asynchronously, that is without blocking. Having issued the COPY command
1938 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
1939 and this routine until the end-of-data signal is detected. Unlike
1940 PQgetline, this routine takes responsibility for detecting end-of-data.
1942 On each call, PQgetlineAsync will return data if a complete newline-
1943 terminated data line is available in libpq's input buffer, or if the
1944 incoming data line is too long to fit in the buffer offered by the caller.
1945 Otherwise, no data is returned until the rest of the line arrives.
1947 If -1 is returned, the end-of-data signal has been recognized (and removed
1948 from libpq's input buffer). The caller *must* next call PQendcopy and
1949 then return to normal processing.
1952 -1 if the end-of-copy-data marker has been recognized
1953 0 if no data is available
1954 >0 the number of bytes returned.
1955 The data returned will not extend beyond a newline character. If possible
1956 a whole line will be returned at one time. But if the buffer offered by
1957 the caller is too small to hold a line sent by the backend, then a partial
1958 data line will be returned. This can be detected by testing whether the
1959 last returned byte is '\n' or not.
1960 The returned string is *not* null-terminated.
1965 char buffer[BLCKSZ];
1970 P = (XPGCONN(conn))->pgconn;
1971 CHECK_CONNECTION_ALIVE(P);
1973 ret = PQgetlineAsync(P, buffer, sizeof(buffer));
1976 return Qt; /* done! */
1978 return Qnil; /* no data yet */
1980 return Fcons(make_int(ret),
1981 make_ext_string((Extbyte *) buffer, ret,
1985 DEFUN("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1986 Asynchronous copy out.
1990 /* NULs are not allowed. I don't think this matters at this time. */
1997 P = (XPGCONN(conn))->pgconn;
1998 CHECK_CONNECTION_ALIVE(P);
1999 TO_EXTERNAL_FORMAT(LISP_STRING, data, C_STRING_ALLOCA, c_data, Qnative);
2001 return !PQputnbytes(P, c_data, strlen(c_data)) ? Qt : Qnil;
2004 DEFUN("pq-end-copy", Fpq_end_copy, 1, 1, 0, /*
2005 End a copying operation.
2012 P = (XPGCONN(conn))->pgconn;
2013 CHECK_CONNECTION_ALIVE(P);
2015 return PQendcopy(P) ? Qt : Qnil;
2020 syms_of_postgresql(void)
2022 INIT_LRECORD_IMPLEMENTATION(pgconn);
2023 INIT_LRECORD_IMPLEMENTATION(pgresult);
2025 defsymbol(&Qpostgresql, "postgresql");
2027 /* opaque exported types */
2028 defsymbol(&Qpgconnp, "pgconnp");
2029 defsymbol(&Qpgresultp, "pgresultp");
2031 /* connection status types
2032 * now implemented as keywords */
2033 DEFKEYWORD(Q_pg_connection_ok);
2034 DEFKEYWORD(Q_pg_connection_bad);
2035 DEFKEYWORD(Q_pg_connection_started);
2036 DEFKEYWORD(Q_pg_connection_made);
2037 DEFKEYWORD(Q_pg_connection_awaiting_response);
2038 DEFKEYWORD(Q_pg_connection_auth_ok);
2039 DEFKEYWORD(Q_pg_connection_setenv);
2041 /* transaction status types */
2042 DEFKEYWORD(Q_pg_trans_idle);
2043 DEFKEYWORD(Q_pg_trans_active);
2044 DEFKEYWORD(Q_pg_trans_intrans);
2045 DEFKEYWORD(Q_pg_trans_inerror);
2046 DEFKEYWORD(Q_pg_trans_unknown);
2048 /* Fields of PGconn */
2049 DEFKEYWORD(Q_pq_db);
2050 DEFKEYWORD(Q_pq_user);
2051 DEFKEYWORD(Q_pq_pass);
2052 DEFKEYWORD(Q_pq_host);
2053 DEFKEYWORD(Q_pq_port);
2054 DEFKEYWORD(Q_pq_tty);
2055 DEFKEYWORD(Q_pq_options);
2056 DEFKEYWORD(Q_pq_status);
2057 DEFKEYWORD(Q_pq_transaction_status);
2058 DEFKEYWORD(Q_pq_parameter_status);
2059 DEFKEYWORD(Q_pq_protocol_version);
2060 DEFKEYWORD(Q_pq_server_version);
2061 DEFKEYWORD(Q_pq_error_message);
2062 DEFKEYWORD(Q_pq_backend_pid);
2064 DEFKEYWORD(Q_pq_getssl);
2067 /* Query status results */
2068 DEFKEYWORD(Q_pgres_empty_query);
2069 DEFKEYWORD(Q_pgres_command_ok);
2070 DEFKEYWORD(Q_pgres_tuples_ok);
2071 DEFKEYWORD(Q_pgres_copy_out);
2072 DEFKEYWORD(Q_pgres_copy_in);
2073 DEFKEYWORD(Q_pgres_bad_response);
2074 DEFKEYWORD(Q_pgres_nonfatal_error);
2075 DEFKEYWORD(Q_pgres_fatal_error);
2077 /* Poll status results */
2078 DEFKEYWORD(Q_pgres_polling_failed);
2079 DEFKEYWORD(Q_pgres_polling_reading);
2080 DEFKEYWORD(Q_pgres_polling_writing);
2081 DEFKEYWORD(Q_pgres_polling_ok);
2082 DEFKEYWORD(Q_pgres_polling_active);
2084 #ifdef HAVE_POSTGRESQLV7
2085 DEFSUBR(Fpq_connect_start);
2086 DEFSUBR(Fpq_connect_poll);
2088 DEFSUBR(Fpq_client_encoding);
2089 DEFSUBR(Fpq_set_client_encoding);
2091 #endif /* HAVE_POSTGRESQLV7 */
2092 DEFSUBR(Fpq_set_notice_processor);
2094 DEFSUBR(Fpq_connection_p);
2095 DEFSUBR(Fpq_conn_defaults);
2096 DEFSUBR(Fpq_connectdb);
2097 DEFSUBR(Fpq_finish);
2099 DEFSUBR(Fpq_is_busy);
2100 DEFSUBR(Fpq_consume_input);
2102 #ifdef HAVE_POSTGRESQLV7
2103 DEFSUBR(Fpq_escape_string);
2104 DEFSUBR(Fpq_escape_bytea);
2105 DEFSUBR(Fpq_unescape_bytea);
2109 #ifdef HAVE_POSTGRESQLV7
2110 DEFSUBR(Fpq_reset_start);
2111 DEFSUBR(Fpq_reset_poll);
2113 DEFSUBR(Fpq_request_cancel);
2114 DEFSUBR(Fpq_connection_status);
2115 DEFSUBR(Fpq_connection_alive_p);
2118 DEFSUBR(Fpq_send_query);
2119 DEFSUBR(Fpq_result_p);
2120 DEFSUBR(Fpq_get_result);
2121 DEFSUBR(Fpq_result_status);
2122 DEFSUBR(Fpq_result_status_string);
2123 DEFSUBR(Fpq_result_error_message);
2124 DEFSUBR(Fpq_ntuples);
2125 DEFSUBR(Fpq_nfields);
2126 DEFSUBR(Fpq_binary_tuples);
2128 DEFSUBR(Fpq_fnumber);
2133 DEFSUBR(Fpq_get_value);
2134 DEFSUBR(Fpq_get_length);
2135 DEFSUBR(Fpq_get_is_null);
2136 DEFSUBR(Fpq_cmd_status);
2137 DEFSUBR(Fpq_cmd_tuples);
2138 DEFSUBR(Fpq_oid_value);
2140 #ifdef HAVE_POSTGRESQLV7
2141 DEFSUBR(Fpq_set_nonblocking);
2142 DEFSUBR(Fpq_is_nonblocking);
2145 DEFSUBR(Fpq_notifies);
2147 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
2148 DEFSUBR(Fpq_env_2_encoding);
2151 DEFSUBR(Fpq_lo_import);
2152 DEFSUBR(Fpq_lo_export);
2154 DEFSUBR(Fpq_make_empty_pgresult);
2156 /* copy in/out functions */
2157 DEFSUBR(Fpq_get_line);
2158 DEFSUBR(Fpq_put_line);
2159 DEFSUBR(Fpq_get_line_async);
2160 DEFSUBR(Fpq_put_nbytes);
2161 DEFSUBR(Fpq_end_copy);
2164 void vars_of_postgresql(void)
2166 Fprovide(Qpostgresql);
2167 #ifdef HAVE_POSTGRESQLV7
2168 Fprovide(intern("postgresqlv7"));
2170 Vpg_coding_system = Qnative;
2171 DEFVAR_LISP("pg-coding-system", &Vpg_coding_system /*
2172 Default Postgres client coding system.
2175 DEFVAR_LISP("pg:host", &VXPGHOST /*
2176 Default PostgreSQL server name.
2177 If not set, the server running on the local host is used. The
2178 initial value is set from the PGHOST environment variable.
2181 DEFVAR_LISP("pg:user", &VXPGUSER /*
2182 Default PostgreSQL user name.
2183 This value is used when connecting to a database for authentication.
2184 The initial value is set from the PGUSER environment variable.
2187 DEFVAR_LISP("pg:options", &VXPGOPTIONS /*
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:port", &VXPGPORT /*
2194 Default port to connect to PostgreSQL backend.
2195 This value is used when connecting to a database.
2196 The initial value is set from the PGPORT environment variable.
2199 DEFVAR_LISP("pg:tty", &VXPGTTY /*
2200 Default debugging TTY.
2201 There is no useful setting of this variable in the XEmacs Lisp API.
2202 The initial value is set from the PGTTY environment variable.
2205 DEFVAR_LISP("pg:database", &VXPGDATABASE /*
2206 Default database to connect to.
2207 The initial value is set from the PGDATABASE environment variable.
2210 DEFVAR_LISP("pg:realm", &VXPGREALM /*
2211 Default kerberos realm to use for authentication.
2212 The initial value is set from the PGREALM environment variable.
2216 /* It's not clear whether this is any use. My intent is to
2217 autodetect the coding system from the database. */
2218 DEFVAR_LISP("pg:client-encoding", &VXPGCLIENTENCODING /*
2219 Default client encoding to use.
2220 The initial value is set from the PGCLIENTENCODING environment variable.
2224 #if !defined(HAVE_POSTGRESQLV7)
2225 DEFVAR_LISP("pg:authtype", &VXPGAUTHTYPE /*
2226 Default authentication to use.
2227 The initial value is set from the PGAUTHTYPE environment variable.
2229 WARNING: This variable has gone away in versions of PostgreSQL newer
2234 DEFVAR_LISP("pg:geqo", &VXPGGEQO /*
2235 Genetic Query Optimizer options.
2236 The initial value is set from the PGGEQO environment variable.
2239 DEFVAR_LISP("pg:cost-index", &VXPGCOSTINDEX /*
2240 Default cost index options.
2241 The initial value is set from the PGCOSTINDEX environment variable.
2244 DEFVAR_LISP("pg:cost-heap", &VXPGCOSTHEAP /*
2245 Default cost heap options.
2246 The initial value is set from the PGCOSTHEAP environment variable.
2249 DEFVAR_LISP("pg:tz", &VXPGTZ /*
2250 Default timezone to use.
2251 The initial value is set from the PGTZ environment variable.
2254 DEFVAR_LISP("pg:date-style", &VXPGDATESTYLE /*
2255 Default date style to use.
2256 The initial value is set from the PGDATESTYLE environment variable.
2260 /* These initializations should not be done at dump-time. */
2262 init_postgresql_from_environment(void)
2266 if ((p = getenv("PGHOST"))) {
2267 VXPGHOST = build_ext_string(p, PG_OS_CODING);
2272 if ((p = getenv("PGUSER"))) {
2273 VXPGUSER = build_ext_string(p, PG_OS_CODING);
2278 if ((p = getenv("PGOPTIONS"))) {
2279 VXPGOPTIONS = build_ext_string(p, PG_OS_CODING);
2284 if ((p = getenv("PGPORT"))) {
2285 VXPGPORT = make_int(atoi(p));
2290 if ((p = getenv("PGTTY"))) {
2291 VXPGTTY = build_ext_string(p, PG_OS_CODING);
2296 if ((p = getenv("PGDATABASE"))) {
2297 VXPGDATABASE = build_ext_string(p, PG_OS_CODING);
2299 VXPGDATABASE = Qnil;
2302 if ((p = getenv("PGREALM"))) {
2303 VXPGREALM = build_ext_string(p, PG_OS_CODING);
2309 /* It's not clear whether this is any use. My intent is to
2310 autodetect the coding system from the database. */
2311 if ((p = getenv("PGCLIENTENCODING"))) {
2312 VXPGCLIENTENCODING = build_ext_string(p, PG_OS_CODING);
2314 VXPGCLIENTENCODING = Qnil;
2318 #if !defined(HAVE_POSTGRESQLV7)
2319 if ((p = getenv("PGAUTHTYPE"))) {
2320 VXPGAUTHTYPE = build_ext_string(p, PG_OS_CODING);
2322 VXPGAUTHTYPE = Qnil;
2326 if ((p = getenv("PGGEQO"))) {
2327 VXPGGEQO = build_ext_string(p, PG_OS_CODING);
2332 if ((p = getenv("PGCOSTINDEX"))) {
2333 VXPGCOSTINDEX = build_ext_string(p, PG_OS_CODING);
2335 VXPGCOSTINDEX = Qnil;
2338 if ((p = getenv("PGCOSTHEAP"))) {
2339 VXPGCOSTHEAP = build_ext_string(p, PG_OS_CODING);
2341 VXPGCOSTHEAP = Qnil;
2344 if ((p = getenv("PGTZ"))) {
2345 VXPGTZ = build_ext_string(p, PG_OS_CODING);
2350 if ((p = getenv("PGDATESTYLE"))) {
2351 VXPGDATESTYLE = build_ext_string(p, PG_OS_CODING);
2353 VXPGDATESTYLE = Qnil;
2357 /* postgresql.c ends here */