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