Mercurial > hg > xemacs-beta

comparison src/postgresql.c @ 404:2f8bb876ab1d r21-2-32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-32
author cvs
date Mon, 13 Aug 2007 11:16:07 +0200
parents
children b8cc9ab3f761
comparison
equal deleted inserted replaced
403:9f011ab08d48 404:2f8bb876ab1d
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 }