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