Mercurial > hg > xemacs-beta

comparison src/postgresql.c @ 442:abe6d1db359e r21-2-36

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