Mercurial > hg > xemacs-beta

comparison modules/postgresql/postgresql.c @ 5125:b5df3737028a ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents d1247f3cc363 4aebb0131297
children a9c41067dd88
comparison
equal deleted inserted replaced
5124:623d57b7fbe8 5125:b5df3737028a
97 #endif 97 #endif
98 98
99 /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */ 99 /* #define POSTGRES_LO_IMPORT_IS_VOID 1 */
100 100
101 #include "lisp.h" 101 #include "lisp.h"
102 #include "sysdep.h"
103 102
104 #include "buffer.h" 103 #include "buffer.h"
105 #include "postgresql.h" 104 #include "postgresql.h"
106 #include "process.h" 105 #include "process.h"
107 #ifdef HAVE_SHLIB 106 #ifdef HAVE_SHLIB
108 # include "emodules.h" 107 # include "emodules.h"
109 #endif 108 #endif
109 #include "sysdep.h"
110 #include "sysfile.h"
110 111
111 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */ 112 #ifdef RUNNING_XEMACS_21_1 /* handle interface changes */
112 #define PG_OS_CODING FORMAT_FILENAME 113 #define PG_OS_CODING FORMAT_FILENAME
113 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to) 114 #define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to)
114 #else 115 #else
118 #define PG_OS_CODING Qnative 119 #define PG_OS_CODING Qnative
119 #endif 120 #endif
120 Lisp_Object Vpg_coding_system; 121 Lisp_Object Vpg_coding_system;
121 #endif 122 #endif
122 123
123 #define CHECK_LIVE_CONNECTION(P) do { \ 124 #define CHECK_LIVE_CONNECTION(P) \
124 if (!P || (PQstatus (P) != CONNECTION_OK)) { \ 125 do \
125 char *e = "bad value"; \ 126 { \
126 if (P) e = PQerrorMessage (P); \ 127 if (!P || (PQstatus (P) != CONNECTION_OK)) \
127 signal_ferror (Qprocess_error, "dead connection [%s]", e); \ 128 { \
128 } } while (0) 129 Lisp_Object err; \
129 #define PUKE_IF_NULL(p) do { \ 130 \
130 if (!p) signal_error (Qinvalid_argument, "bad value", Qunbound); \ 131 if (P) \
131 } while (0) 132 err = build_extstring (PQerrorMessage (P), PG_OS_CODING); \
133 else \
134 err = build_msg_string ("Bad value"); \
135 signal_error (Qprocess_error, "Dead connection", err); \
136 } \
137 } \
138 while (0)
139
140 #define PUKE_IF_NULL(p) \
141 do \
142 { \
143 if (!p) signal_error (Qinvalid_argument, "Bad value", Qunbound); \
144 } \
145 while (0)
146
147 #define SIGNAL_ERROR(p, reason) \
148 do \
149 { \
150 signal_error (Qprocess_error, reason, \
151 build_extstring (PQerrorMessage (p), PG_OS_CODING)); \
152 } \
153 while (0)
132 154
133 static Lisp_Object VXPGHOST; 155 static Lisp_Object VXPGHOST;
134 static Lisp_Object VXPGUSER; 156 static Lisp_Object VXPGUSER;
135 static Lisp_Object VXPGOPTIONS; 157 static Lisp_Object VXPGOPTIONS;
136 static Lisp_Object VXPGPORT; 158 static Lisp_Object VXPGPORT;
203 int UNUSED (escapeflag)) 225 int UNUSED (escapeflag))
204 { 226 {
205 char buf[256]; 227 char buf[256];
206 PGconn *P; 228 PGconn *P;
207 ConnStatusType cst; 229 ConnStatusType cst;
208 char *host="", *db="", *user="", *port=""; 230 const char *host="", *db="", *user="", *port="";
209 231
210 P = (XPGCONN (obj))->pgconn; 232 P = (XPGCONN (obj))->pgconn;
211 233
212 if (!P) /* this may happen since we allow PQfinish() to be called */ 234 if (!P) /* this may happen since we allow PQfinish() to be called */
213 strcpy (buf, "#<PGconn DEAD>"); /* evil! */ 235 strcpy (buf, "#<PGconn DEAD>"); /* evil! */
231 strcpy (buf, "#<PGconn connecting>"); /* evil! */ 253 strcpy (buf, "#<PGconn connecting>"); /* evil! */
232 254
233 if (print_readably) 255 if (print_readably)
234 printing_unreadable_object ("%s", buf); 256 printing_unreadable_object ("%s", buf);
235 else 257 else
236 write_c_string (printcharfun, buf); 258 write_cistring (printcharfun, buf);
237 } 259 }
238 260
239 static Lisp_PGconn * 261 static Lisp_PGconn *
240 allocate_pgconn (void) 262 allocate_pgconn (void)
241 { 263 {
250 #endif 272 #endif
251 pgconn->pgconn = (PGconn *)NULL; 273 pgconn->pgconn = (PGconn *)NULL;
252 return pgconn; 274 return pgconn;
253 } 275 }
254 276
277 #ifdef RUNNING_XEMACS_21_4
278
255 static void 279 static void
256 finalize_pgconn (void *header, int for_disksave) 280 finalize_pgconn (void *header, int for_disksave)
257 { 281 {
258 Lisp_PGconn *pgconn = (Lisp_PGconn *)header; 282 Lisp_PGconn *pgconn = (Lisp_PGconn *)header;
259 283
265 { 289 {
266 PQfinish (pgconn->pgconn); 290 PQfinish (pgconn->pgconn);
267 pgconn->pgconn = (PGconn *)NULL; 291 pgconn->pgconn = (PGconn *)NULL;
268 } 292 }
269 } 293 }
294
295 #else /* not RUNNING_XEMACS_21_4 */
296
297 static void
298 finalize_pgconn (void *header)
299 {
300 Lisp_PGconn *pgconn = (Lisp_PGconn *)header;
301
302 if (pgconn->pgconn)
303 {
304 PQfinish (pgconn->pgconn);
305 pgconn->pgconn = (PGconn *)NULL;
306 }
307 }
308
309 #endif /* (not) RUNNING_XEMACS_21_4 */
270 310
271 #ifdef RUNNING_XEMACS_21_1 311 #ifdef RUNNING_XEMACS_21_1
272 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn, 312 DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
273 mark_pgconn, print_pgconn, finalize_pgconn, 313 mark_pgconn, print_pgconn, finalize_pgconn,
274 NULL, NULL, 314 NULL, NULL,
347 PQresStatus (PQresultStatus (res)), 387 PQresStatus (PQresultStatus (res)),
348 PQcmdTuples (res), 388 PQcmdTuples (res),
349 PQcmdStatus (res)); 389 PQcmdStatus (res));
350 break; 390 break;
351 default: 391 default:
352 notuples: 392 notuples:
353 /* No counts to print */ 393 /* No counts to print */
354 sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */ 394 sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */
355 PQresStatus (PQresultStatus (res)), 395 PQresStatus (PQresultStatus (res)),
356 PQcmdStatus (res)); 396 PQcmdStatus (res));
357 break; 397 break;
361 strcpy (buf, "#<PGresult DEAD>"); /* evil! */ 401 strcpy (buf, "#<PGresult DEAD>"); /* evil! */
362 402
363 if (print_readably) 403 if (print_readably)
364 printing_unreadable_object ("%s", buf); 404 printing_unreadable_object ("%s", buf);
365 else 405 else
366 write_c_string (printcharfun, buf); 406 write_cistring (printcharfun, buf);
367 } 407 }
368 408
369 #undef RESULT_TUPLES_FMT 409 #undef RESULT_TUPLES_FMT
370 #undef RESULT_CMD_TUPLES_FMT 410 #undef RESULT_CMD_TUPLES_FMT
371 #undef RESULT_DEFAULT_FMT 411 #undef RESULT_DEFAULT_FMT
384 #endif 424 #endif
385 pgresult->pgresult = (PGresult *)NULL; 425 pgresult->pgresult = (PGresult *)NULL;
386 return pgresult; 426 return pgresult;
387 } 427 }
388 428
429 #ifdef RUNNING_XEMACS_21_4
430
389 static void 431 static void
390 finalize_pgresult (void *header, int for_disksave) 432 finalize_pgresult (void *header, int for_disksave)
391 { 433 {
392 Lisp_PGresult *pgresult = (Lisp_PGresult *)header; 434 Lisp_PGresult *pgresult = (Lisp_PGresult *)header;
393 435
399 { 441 {
400 PQclear (pgresult->pgresult); 442 PQclear (pgresult->pgresult);
401 pgresult->pgresult = (PGresult *)NULL; 443 pgresult->pgresult = (PGresult *)NULL;
402 } 444 }
403 } 445 }
446
447 #else /* not RUNNING_XEMACS_21_4 */
448
449 static void
450 finalize_pgresult (void *header)
451 {
452 Lisp_PGresult *pgresult = (Lisp_PGresult *)header;
453
454 if (pgresult->pgresult)
455 {
456 PQclear (pgresult->pgresult);
457 pgresult->pgresult = (PGresult *)NULL;
458 }
459 }
460
461 #endif /* (not) RUNNING_XEMACS_21_4 */
404 462
405 #ifdef RUNNING_XEMACS_21_1 463 #ifdef RUNNING_XEMACS_21_1
406 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult, 464 DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
407 mark_pgresult, print_pgresult, finalize_pgresult, 465 mark_pgresult, print_pgresult, finalize_pgresult,
408 NULL, NULL, 466 NULL, NULL,
448 Lisp_Object temp, temp1; 506 Lisp_Object temp, temp1;
449 int i; 507 int i;
450 508
451 pcio = PQconndefaults(); 509 pcio = PQconndefaults();
452 if (!pcio) return Qnil; /* can never happen in libpq-7.0 */ 510 if (!pcio) return Qnil; /* can never happen in libpq-7.0 */
453 temp = list1 (Fcons (build_ext_string (pcio[0].keyword, PG_OS_CODING), 511 temp =
454 Fcons (build_ext_string (pcio[0].envvar, PG_OS_CODING), 512 list1 (nconc2 (list4 (build_extstring (pcio[0].keyword, PG_OS_CODING),
455 Fcons (build_ext_string (pcio[0].compiled, PG_OS_CODING), 513 build_extstring (pcio[0].envvar, PG_OS_CODING),
456 Fcons (build_ext_string (pcio[0].val, PG_OS_CODING), 514 build_extstring (pcio[0].compiled, PG_OS_CODING),
457 Fcons (build_ext_string (pcio[0].label, PG_OS_CODING), 515 build_extstring (pcio[0].val, PG_OS_CODING)),
458 Fcons (build_ext_string (pcio[0].dispchar, PG_OS_CODING), 516 list3 (build_extstring (pcio[0].label, PG_OS_CODING),
459 Fcons (make_int (pcio[0].dispsize), Qnil)))))))); 517 build_extstring (pcio[0].dispchar, PG_OS_CODING),
518 make_int (pcio[0].dispsize))));
460 519
461 for (i = 1; pcio[i].keyword; i++) 520 for (i = 1; pcio[i].keyword; i++)
462 { 521 {
463 temp1 = list1 (Fcons (build_ext_string (pcio[i].keyword, PG_OS_CODING), 522 temp1 =
464 Fcons (build_ext_string (pcio[i].envvar, PG_OS_CODING), 523 list1 (nconc2 (list4 (build_extstring (pcio[i].keyword, PG_OS_CODING),
465 Fcons (build_ext_string (pcio[i].compiled, PG_OS_CODING), 524 build_extstring (pcio[i].envvar, PG_OS_CODING),
466 Fcons (build_ext_string (pcio[i].val, PG_OS_CODING), 525 build_extstring (pcio[i].compiled, PG_OS_CODING),
467 Fcons (build_ext_string (pcio[i].label, PG_OS_CODING), 526 build_extstring (pcio[i].val, PG_OS_CODING)),
468 Fcons (build_ext_string (pcio[i].dispchar, PG_OS_CODING), 527 list3 (build_extstring (pcio[i].label, PG_OS_CODING),
469 Fcons (make_int (pcio[i].dispsize), Qnil)))))))); 528 build_extstring (pcio[i].dispchar, PG_OS_CODING),
529 make_int (pcio[i].dispsize))));
470 { 530 {
471 Lisp_Object args[2]; 531 Lisp_Object args[2];
472 args[0] = temp; 532 args[0] = temp;
473 args[1] = temp1; 533 args[1] = temp1;
474 /* Fappend GCPROs its arguments */ 534 /* Fappend GCPROs its arguments */
481 541
482 /* PQconnectdb Makes a new connection to a backend. 542 /* PQconnectdb Makes a new connection to a backend.
483 PGconn *PQconnectdb(const char *conninfo) 543 PGconn *PQconnectdb(const char *conninfo)
484 */ 544 */
485 545
486 /* ###autoload */ 546 #ifdef HAVE_POSTGRESQLV7
487 DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /* 547 #define USED_IF_V7(x) x
488 Make a new connection to a PostgreSQL backend. 548 #else
489 */ 549 #define USED_IF_V7(x) UNUSED (x)
490 (conninfo)) 550 #endif
551
552 static Lisp_Object
553 postgresql_connect (Lisp_Object conninfo, int USED_IF_V7 (async))
491 { 554 {
492 PGconn *P; 555 PGconn *P;
493 Lisp_PGconn *lisp_pgconn; 556 Lisp_PGconn *lisp_pgconn;
494 char *error_message = "Out of Memory?";
495 char *c_conninfo;
496 557
497 CHECK_STRING (conninfo); 558 CHECK_STRING (conninfo);
498 559
499 TO_EXTERNAL_FORMAT(LISP_STRING, conninfo, 560 P = (
500 C_STRING_ALLOCA, c_conninfo, Qnative); 561 #ifdef HAVE_POSTGRESQLV7
501 P = PQconnectdb (c_conninfo); 562 async ? PQconnectStart :
563 #endif
564 PQconnectdb)
565 (LISP_STRING_TO_EXTERNAL (conninfo, PG_OS_CODING));
502 if (P && (PQstatus (P) == CONNECTION_OK)) 566 if (P && (PQstatus (P) == CONNECTION_OK))
503 { 567 {
504 (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL); 568 (void) PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
505 lisp_pgconn = allocate_pgconn(); 569 lisp_pgconn = allocate_pgconn ();
506 lisp_pgconn->pgconn = P; 570 lisp_pgconn->pgconn = P;
507 return make_pgconn (lisp_pgconn); 571 return make_pgconn (lisp_pgconn);
508 } 572 }
509 else 573 else
510 { 574 {
511 /* Connection failed. Destroy the connection and signal an error. */ 575 /* Connection failed. Destroy the connection and signal an error. */
512 char buf[BLCKSZ]; 576
513 strcpy (buf, error_message); 577 Lisp_Object errmsg;
514 if (P) 578 if (P)
515 { 579 {
516 /* storage for the error message gets erased when call PQfinish */ 580 errmsg = build_extstring (PQerrorMessage (P), PG_OS_CODING);
517 /* so we must temporarily stash it somewhere */
518 strncpy (buf, PQerrorMessage (P), sizeof (buf));
519 buf[sizeof (buf) - 1] = '\0';
520 PQfinish (P); 581 PQfinish (P);
521 } 582 }
522 signal_ferror (Qprocess_error, "libpq: %s", buf); 583 else
584 errmsg = build_msg_string ("Out of Memory?");
585 signal_error (Qprocess_error, "Connecting to PostGreSQL backend",
586 errmsg);
523 } 587 }
588 }
589
590 /* ###autoload */
591 DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /*
592 Make a new connection to a PostgreSQL backend.
593 */
594 (conninfo))
595 {
596 return postgresql_connect (conninfo, 0);
524 } 597 }
525 598
526 /* PQconnectStart Makes a new asynchronous connection to a backend. 599 /* PQconnectStart Makes a new asynchronous connection to a backend.
527 PGconn *PQconnectStart(const char *conninfo) 600 PGconn *PQconnectStart(const char *conninfo)
528 */ 601 */
532 DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /* 605 DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /*
533 Make a new asynchronous connection to a PostgreSQL backend. 606 Make a new asynchronous connection to a PostgreSQL backend.
534 */ 607 */
535 (conninfo)) 608 (conninfo))
536 { 609 {
537 PGconn *P; 610 return postgresql_connect (conninfo, 1);
538 Lisp_PGconn *lisp_pgconn;
539 char *error_message = "Out of Memory?";
540 char *c_conninfo;
541
542 CHECK_STRING (conninfo);
543 TO_EXTERNAL_FORMAT (LISP_STRING, conninfo,
544 C_STRING_ALLOCA, c_conninfo, Qnative);
545 P = PQconnectStart (c_conninfo);
546
547 if (P && (PQstatus (P) != CONNECTION_BAD))
548 {
549 (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
550 lisp_pgconn = allocate_pgconn();
551 lisp_pgconn->pgconn = P;
552
553 return make_pgconn (lisp_pgconn);
554 }
555 else
556 {
557 /* capture the error message before destroying the object */
558 char buf[BLCKSZ];
559 strcpy (buf, error_message);
560 if (P)
561 {
562 strncpy (buf, PQerrorMessage (P), sizeof (buf));
563 buf[sizeof (buf) - 1] = '\0';
564 PQfinish (P);
565 }
566 signal_ferror (Qprocess_error, "libpq: %s", buf);
567 }
568 } 611 }
569 612
570 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /* 613 DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
571 Poll an asynchronous connection for completion 614 Poll an asynchronous connection for completion
572 */ 615 */
583 polling_status = PQconnectPoll (P); 626 polling_status = PQconnectPoll (P);
584 switch (polling_status) 627 switch (polling_status)
585 { 628 {
586 case PGRES_POLLING_FAILED: 629 case PGRES_POLLING_FAILED:
587 /* Something Bad has happened */ 630 /* Something Bad has happened */
588 { 631 SIGNAL_ERROR (P, "Polling asynchronous connection");
589 char *e = PQerrorMessage (P);
590 signal_ferror (Qprocess_error, "libpq: %s", e);
591 }
592 case PGRES_POLLING_OK: 632 case PGRES_POLLING_OK:
593 return Qpgres_polling_ok; 633 return Qpgres_polling_ok;
594 case PGRES_POLLING_READING: 634 case PGRES_POLLING_READING:
595 return Qpgres_polling_reading; 635 return Qpgres_polling_reading;
596 case PGRES_POLLING_WRITING: 636 case PGRES_POLLING_WRITING:
749 CHECK_PGCONN (conn); 789 CHECK_PGCONN (conn);
750 P = (XPGCONN (conn))->pgconn; 790 P = (XPGCONN (conn))->pgconn;
751 CHECK_LIVE_CONNECTION (P); 791 CHECK_LIVE_CONNECTION (P);
752 792
753 if (PQresetStart (P)) return Qt; 793 if (PQresetStart (P)) return Qt;
754 { 794 SIGNAL_ERROR (P, "Resetting connection");
755 char *e = PQerrorMessage (P);
756 signal_ferror (Qprocess_error, "libpq: %s", e);
757 }
758 } 795 }
759 796
760 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /* 797 DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
761 Poll an asynchronous reset for completion. 798 Poll an asynchronous reset for completion.
762 */ 799 */
772 809
773 polling_status = PQresetPoll (P); 810 polling_status = PQresetPoll (P);
774 switch (polling_status) 811 switch (polling_status)
775 { 812 {
776 case PGRES_POLLING_FAILED: 813 case PGRES_POLLING_FAILED:
777 /* Something Bad has happened */ 814 SIGNAL_ERROR (P, "Polling asynchronous reset");
778 {
779 char *e = PQerrorMessage (P);
780 signal_ferror (Qprocess_error, "libpq: %s", e);
781 }
782 case PGRES_POLLING_OK: 815 case PGRES_POLLING_OK:
783 return Qpgres_polling_ok; 816 return Qpgres_polling_ok;
784 case PGRES_POLLING_READING: 817 case PGRES_POLLING_READING:
785 return Qpgres_polling_reading; 818 return Qpgres_polling_reading;
786 case PGRES_POLLING_WRITING: 819 case PGRES_POLLING_WRITING:
838 871
839 if (EQ(field, Qpqdb)) 872 if (EQ(field, Qpqdb))
840 /* PQdb Returns the database name of the connection. 873 /* PQdb Returns the database name of the connection.
841 char *PQdb(PGconn *conn) 874 char *PQdb(PGconn *conn)
842 */ 875 */
843 return build_ext_string (PQdb(P), PG_OS_CODING); 876 return build_extstring (PQdb(P), PG_OS_CODING);
844 else if (EQ (field, Qpquser)) 877 else if (EQ (field, Qpquser))
845 /* PQuser Returns the user name of the connection. 878 /* PQuser Returns the user name of the connection.
846 char *PQuser(PGconn *conn) 879 char *PQuser(PGconn *conn)
847 */ 880 */
848 return build_ext_string (PQuser(P), PG_OS_CODING); 881 return build_extstring (PQuser(P), PG_OS_CODING);
849 else if (EQ (field, Qpqpass)) 882 else if (EQ (field, Qpqpass))
850 /* PQpass Returns the password of the connection. 883 /* PQpass Returns the password of the connection.
851 char *PQpass(PGconn *conn) 884 char *PQpass(PGconn *conn)
852 */ 885 */
853 return build_ext_string (PQpass(P), PG_OS_CODING); 886 return build_extstring (PQpass(P), PG_OS_CODING);
854 else if (EQ (field, Qpqhost)) 887 else if (EQ (field, Qpqhost))
855 /* PQhost Returns the server host name of the connection. 888 /* PQhost Returns the server host name of the connection.
856 char *PQhost(PGconn *conn) 889 char *PQhost(PGconn *conn)
857 */ 890 */
858 return build_ext_string (PQhost(P), PG_OS_CODING); 891 return build_extstring (PQhost(P), PG_OS_CODING);
859 else if (EQ (field, Qpqport)) 892 else if (EQ (field, Qpqport))
860 { 893 {
861 char *p; 894 char *p;
862 /* PQport Returns the port of the connection. 895 /* PQport Returns the port of the connection.
863 char *PQport(PGconn *conn) 896 char *PQport(PGconn *conn)
869 } 902 }
870 else if (EQ (field, Qpqtty)) 903 else if (EQ (field, Qpqtty))
871 /* PQtty Returns the debug tty of the connection. 904 /* PQtty Returns the debug tty of the connection.
872 char *PQtty(PGconn *conn) 905 char *PQtty(PGconn *conn)
873 */ 906 */
874 return build_ext_string (PQtty(P), PG_OS_CODING); 907 return build_extstring (PQtty(P), PG_OS_CODING);
875 else if (EQ (field, Qpqoptions)) 908 else if (EQ (field, Qpqoptions))
876 /* PQoptions Returns the backend options used in the connection. 909 /* PQoptions Returns the backend options used in the connection.
877 char *PQoptions(PGconn *conn) 910 char *PQoptions(PGconn *conn)
878 */ 911 */
879 return build_ext_string (PQoptions(P), PG_OS_CODING); 912 return build_extstring (PQoptions(P), PG_OS_CODING);
880 else if (EQ (field, Qpqstatus)) 913 else if (EQ (field, Qpqstatus))
881 { 914 {
882 ConnStatusType cst; 915 ConnStatusType cst;
883 /* PQstatus Returns the status of the connection. The status can be 916 /* PQstatus Returns the status of the connection. The status can be
884 CONNECTION_OK or CONNECTION_BAD. 917 CONNECTION_OK or CONNECTION_BAD.
903 else if (EQ (field, Qpqerrormessage)) 936 else if (EQ (field, Qpqerrormessage))
904 /* PQerrorMessage Returns the error message most recently generated 937 /* PQerrorMessage Returns the error message most recently generated
905 by an operation on the connection. 938 by an operation on the connection.
906 char *PQerrorMessage(PGconn* conn); 939 char *PQerrorMessage(PGconn* conn);
907 */ 940 */
908 return build_ext_string (PQerrorMessage(P), PG_OS_CODING); 941 return build_extstring (PQerrorMessage(P), PG_OS_CODING);
909 else if (EQ (field, Qpqbackendpid)) 942 else if (EQ (field, Qpqbackendpid))
910 /* PQbackendPID Returns the process ID of the backend server handling 943 /* PQbackendPID Returns the process ID of the backend server handling
911 this connection. 944 this connection.
912 int PQbackendPID(PGconn *conn); 945 int PQbackendPID(PGconn *conn);
913 */ 946 */
936 TO_EXTERNAL_FORMAT (LISP_STRING, query, 969 TO_EXTERNAL_FORMAT (LISP_STRING, query,
937 C_STRING_ALLOCA, c_query, Qnative); 970 C_STRING_ALLOCA, c_query, Qnative);
938 971
939 R = PQexec (P, c_query); 972 R = PQexec (P, c_query);
940 { 973 {
941 char *tag, buf[BLCKSZ]; 974 const Ascbyte *tag;
975 char buf[BLCKSZ];
942 976
943 if (!R) out_of_memory ("query: out of memory", Qunbound); 977 if (!R) out_of_memory ("query: out of memory", Qunbound);
944 else 978 else
945 switch (PQresultStatus (R)) 979 switch (PQresultStatus (R))
946 { 980 {
987 1021
988 TO_EXTERNAL_FORMAT (LISP_STRING, query, 1022 TO_EXTERNAL_FORMAT (LISP_STRING, query,
989 C_STRING_ALLOCA, c_query, Qnative); 1023 C_STRING_ALLOCA, c_query, Qnative);
990 1024
991 if (PQsendQuery (P, c_query)) return Qt; 1025 if (PQsendQuery (P, c_query)) return Qt;
992 else signal_ferror (Qprocess_error, "async query: %s", PQerrorMessage (P)); 1026 else SIGNAL_ERROR (P, "Sending asynchronous query");
993 } 1027 }
994 1028
995 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /* 1029 DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /*
996 Retrieve an asynchronous result from a query. 1030 Retrieve an asynchronous result from a query.
997 NIL is returned when no more query work remains. 1031 NIL is returned when no more query work remains.
1009 1043
1010 R = PQgetResult (P); 1044 R = PQgetResult (P);
1011 if (!R) return Qnil; /* not an error, there's no more data to get */ 1045 if (!R) return Qnil; /* not an error, there's no more data to get */
1012 1046
1013 { 1047 {
1014 char *tag, buf[BLCKSZ]; 1048 const Ascbyte *tag;
1049 char buf[BLCKSZ];
1015 1050
1016 switch (PQresultStatus (R)) 1051 switch (PQresultStatus (R))
1017 { 1052 {
1018 case PGRES_BAD_RESPONSE: 1053 case PGRES_BAD_RESPONSE:
1019 tag = "bad response [%s]"; 1054 tag = "bad response [%s]";
1061 case PGRES_BAD_RESPONSE: return Qpgres_bad_response; 1096 case PGRES_BAD_RESPONSE: return Qpgres_bad_response;
1062 case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error; 1097 case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error;
1063 case PGRES_FATAL_ERROR: return Qpgres_fatal_error; 1098 case PGRES_FATAL_ERROR: return Qpgres_fatal_error;
1064 default: 1099 default:
1065 /* they've added a new field we don't know about */ 1100 /* they've added a new field we don't know about */
1066 signal_ferror (Qprocess_error, "Help! Unknown exec status code %08x from backend!", est); 1101 signal_ferror (Qprocess_error,
1102 "Help! Unknown exec status code %08x from backend!",
1103 est);
1067 } 1104 }
1068 } 1105 }
1069 1106
1070 DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /* 1107 DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /*
1071 Return stringified result status of the query. 1108 Return stringified result status of the query.
1076 1113
1077 CHECK_PGRESULT (result); 1114 CHECK_PGRESULT (result);
1078 R = (XPGRESULT (result))->pgresult; 1115 R = (XPGRESULT (result))->pgresult;
1079 PUKE_IF_NULL (R); 1116 PUKE_IF_NULL (R);
1080 1117
1081 return build_ext_string (PQresStatus (PQresultStatus (R)), PG_OS_CODING); 1118 return build_extstring (PQresStatus (PQresultStatus (R)), PG_OS_CODING);
1082 } 1119 }
1083 1120
1084 /* Sundry PGresult accessor functions */ 1121 /* Sundry PGresult accessor functions */
1085 DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /* 1122 DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /*
1086 Return last message associated with the query. 1123 Return last message associated with the query.
1091 1128
1092 CHECK_PGRESULT (result); 1129 CHECK_PGRESULT (result);
1093 R = (XPGRESULT (result))->pgresult; 1130 R = (XPGRESULT (result))->pgresult;
1094 PUKE_IF_NULL (R); 1131 PUKE_IF_NULL (R);
1095 1132
1096 return build_ext_string (PQresultErrorMessage (R), PG_OS_CODING); 1133 return build_extstring (PQresultErrorMessage (R), PG_OS_CODING);
1097 } 1134 }
1098 1135
1099 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /* 1136 DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
1100 Return the number of tuples (instances) in the query result. 1137 Return the number of tuples (instances) in the query result.
1101 */ 1138 */
1149 CHECK_PGRESULT (result); 1186 CHECK_PGRESULT (result);
1150 CHECK_INT (field_index); 1187 CHECK_INT (field_index);
1151 R = (XPGRESULT (result))->pgresult; 1188 R = (XPGRESULT (result))->pgresult;
1152 PUKE_IF_NULL (R); 1189 PUKE_IF_NULL (R);
1153 1190
1154 return build_ext_string (PQfname (R, XINT (field_index)), PG_OS_CODING); 1191 return build_extstring (PQfname (R, XINT (field_index)), PG_OS_CODING);
1155 } 1192 }
1156 1193
1157 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /* 1194 DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
1158 Return the number of fields (attributes) in each tuple of the query result. 1195 Return the number of fields (attributes) in each tuple of the query result.
1159 */ 1196 */
1234 CHECK_INT (tup_num); 1271 CHECK_INT (tup_num);
1235 CHECK_INT (field_num); 1272 CHECK_INT (field_num);
1236 R = (XPGRESULT (result))->pgresult; 1273 R = (XPGRESULT (result))->pgresult;
1237 PUKE_IF_NULL (R); 1274 PUKE_IF_NULL (R);
1238 1275
1239 return build_ext_string (PQgetvalue (R, XINT (tup_num), XINT (field_num)), 1276 return build_extstring (PQgetvalue (R, XINT (tup_num), XINT (field_num)),
1240 PG_OS_CODING); 1277 PG_OS_CODING);
1241 } 1278 }
1242 1279
1243 DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /* 1280 DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1244 Returns the length of a field value in bytes. 1281 Returns the length of a field value in bytes.
1284 1321
1285 CHECK_PGRESULT (result); 1322 CHECK_PGRESULT (result);
1286 R = (XPGRESULT (result))->pgresult; 1323 R = (XPGRESULT (result))->pgresult;
1287 PUKE_IF_NULL (R); 1324 PUKE_IF_NULL (R);
1288 1325
1289 return build_ext_string (PQcmdStatus (R), PG_OS_CODING); 1326 return build_extstring (PQcmdStatus (R), PG_OS_CODING);
1290 } 1327 }
1291 1328
1292 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /* 1329 DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1293 Returns the number of rows affected by the SQL command. 1330 Returns the number of rows affected by the SQL command.
1294 */ 1331 */
1298 1335
1299 CHECK_PGRESULT (result); 1336 CHECK_PGRESULT (result);
1300 R = (XPGRESULT (result))->pgresult; 1337 R = (XPGRESULT (result))->pgresult;
1301 PUKE_IF_NULL (R); 1338 PUKE_IF_NULL (R);
1302 1339
1303 return build_ext_string (PQcmdTuples (R), PG_OS_CODING); 1340 return build_extstring (PQcmdTuples (R), PG_OS_CODING);
1304 } 1341 }
1305 1342
1306 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /* 1343 DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
1307 Returns the object id of the tuple inserted. 1344 Returns the object id of the tuple inserted.
1308 */ 1345 */
1392 return Qnil; 1429 return Qnil;
1393 else 1430 else
1394 { 1431 {
1395 Lisp_Object temp; 1432 Lisp_Object temp;
1396 1433
1397 temp = list2 (build_ext_string (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid)); 1434 temp = list2 (build_extstring (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid));
1398 free ((void *)PGN); 1435 free ((void *)PGN);
1399 return temp; 1436 return temp;
1400 } 1437 }
1401 } 1438 }
1402 1439
1422 CHECK_STRING (filename); 1459 CHECK_STRING (filename);
1423 1460
1424 P = (XPGCONN (conn))->pgconn; 1461 P = (XPGCONN (conn))->pgconn;
1425 CHECK_LIVE_CONNECTION (P); 1462 CHECK_LIVE_CONNECTION (P);
1426 1463
1427 TO_EXTERNAL_FORMAT (LISP_STRING, filename, 1464 LISP_PATHNAME_CONVERT_OUT (filename, c_filename);
1428 C_STRING_ALLOCA, c_filename,
1429 Qfile_name);
1430 1465
1431 return make_int ((int)lo_import (P, c_filename)); 1466 return make_int ((int)lo_import (P, c_filename));
1432 } 1467 }
1433 1468
1434 DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /* 1469 DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /*
1443 CHECK_STRING (filename); 1478 CHECK_STRING (filename);
1444 1479
1445 P = (XPGCONN (conn))->pgconn; 1480 P = (XPGCONN (conn))->pgconn;
1446 CHECK_LIVE_CONNECTION (P); 1481 CHECK_LIVE_CONNECTION (P);
1447 1482
1448 TO_EXTERNAL_FORMAT (LISP_STRING, filename, 1483 LISP_PATHNAME_CONVERT_OUT (filename, c_filename);
1449 C_STRING_ALLOCA, c_filename, Qfile_name);
1450 1484
1451 return make_int ((int)lo_export (P, XINT (oid), c_filename)); 1485 return make_int ((int)lo_export (P, XINT (oid), c_filename));
1452 } 1486 }
1453 1487
1454 DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /* 1488 DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /*
1506 P = (XPGCONN (conn))->pgconn; 1540 P = (XPGCONN (conn))->pgconn;
1507 CHECK_LIVE_CONNECTION (P); 1541 CHECK_LIVE_CONNECTION (P);
1508 1542
1509 ret = PQgetline (P, buffer, sizeof (buffer)); 1543 ret = PQgetline (P, buffer, sizeof (buffer));
1510 1544
1511 return Fcons (make_int (ret), build_ext_string (buffer, PG_OS_CODING)); 1545 return Fcons (make_int (ret), build_extstring (buffer, PG_OS_CODING));
1512 } 1546 }
1513 1547
1514 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /* 1548 DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /*
1515 Send a line to the server in copy out operation. 1549 Send a line to the server in copy out operation.
1516 1550
1575 ret = PQgetlineAsync (P, buffer, sizeof (buffer)); 1609 ret = PQgetlineAsync (P, buffer, sizeof (buffer));
1576 1610
1577 if (ret == -1) return Qt; /* done! */ 1611 if (ret == -1) return Qt; /* done! */
1578 else if (!ret) return Qnil; /* no data yet */ 1612 else if (!ret) return Qnil; /* no data yet */
1579 else return Fcons (make_int (ret), 1613 else return Fcons (make_int (ret),
1580 make_ext_string ((Extbyte *) buffer, ret, PG_OS_CODING)); 1614 make_extstring ((Extbyte *) buffer, ret, PG_OS_CODING));
1581 } 1615 }
1582 1616
1583 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /* 1617 DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1584 Asynchronous copy out. 1618 Asynchronous copy out.
1585 */ 1619 */
1845 { 1879 {
1846 Ibyte *p; 1880 Ibyte *p;
1847 1881
1848 #define FROB(envvar, var) \ 1882 #define FROB(envvar, var) \
1849 if ((p = egetenv (envvar))) \ 1883 if ((p = egetenv (envvar))) \
1850 var = build_intstring (p); \ 1884 var = build_istring (p); \
1851 else \ 1885 else \
1852 var = Qnil 1886 var = Qnil
1853 1887
1854 if (initialized) 1888 if (initialized)
1855 { 1889 {