Mercurial > hg > xemacs-beta
annotate modules/postgresql/postgresql.c @ 5444:388762703a21
Added copyright notices and GPLv3 license to PROBLEMS and Emacs.ad.
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Sun, 26 Dec 2010 01:48:40 +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 */ |