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