1/*
2 * Copyright (c) 2001 by The XFree86 Project, Inc.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a
5 * copy of this software and associated documentation files (the "Software"),
6 * to deal in the Software without restriction, including without limitation
7 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
8 * and/or sell copies of the Software, and to permit persons to whom the
9 * Software is furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
21 *
22 * Except as contained in this notice, the name of the XFree86 Project shall
23 * not be used in advertising or otherwise to promote the sale, use or other
24 * dealings in this Software without prior written authorization from the
25 * XFree86 Project.
26 *
27 * Author: Paulo César Pereira de Andrade
28 */
29
30/* $XFree86: xc/programs/xedit/lisp/modules/psql.c,v 1.12tsi Exp $ */
31
32#include <stdlib.h>
33#include <libpq-fe.h>
34#undef USE_SSL		/* cannot get it to compile... */
35#include <postgres.h>
36#include <utils/geo_decls.h>
37#include "lisp/internal.h"
38#include "lisp/private.h"
39
40/*
41 * Prototypes
42 */
43int psqlLoadModule(void);
44
45LispObj *Lisp_PQbackendPID(LispBuiltin*);
46LispObj *Lisp_PQclear(LispBuiltin*);
47LispObj *Lisp_PQconsumeInput(LispBuiltin*);
48LispObj *Lisp_PQdb(LispBuiltin*);
49LispObj *Lisp_PQerrorMessage(LispBuiltin*);
50LispObj *Lisp_PQexec(LispBuiltin*);
51LispObj *Lisp_PQfinish(LispBuiltin*);
52LispObj *Lisp_PQfname(LispBuiltin*);
53LispObj *Lisp_PQfnumber(LispBuiltin*);
54LispObj *Lisp_PQfsize(LispBuiltin*);
55LispObj *Lisp_PQftype(LispBuiltin*);
56LispObj *Lisp_PQgetlength(LispBuiltin*);
57LispObj *Lisp_PQgetvalue(LispBuiltin*);
58LispObj *Lisp_PQhost(LispBuiltin*);
59LispObj *Lisp_PQnfields(LispBuiltin*);
60LispObj *Lisp_PQnotifies(LispBuiltin*);
61LispObj *Lisp_PQntuples(LispBuiltin*);
62LispObj *Lisp_PQoptions(LispBuiltin*);
63LispObj *Lisp_PQpass(LispBuiltin*);
64LispObj *Lisp_PQport(LispBuiltin*);
65LispObj *Lisp_PQresultStatus(LispBuiltin*);
66LispObj *Lisp_PQsetdb(LispBuiltin*);
67LispObj *Lisp_PQsetdbLogin(LispBuiltin*);
68LispObj *Lisp_PQsocket(LispBuiltin*);
69LispObj *Lisp_PQstatus(LispBuiltin*);
70LispObj *Lisp_PQtty(LispBuiltin*);
71LispObj *Lisp_PQuser(LispBuiltin*);
72
73/*
74 * Initialization
75 */
76static LispBuiltin lispbuiltins[] = {
77    {LispFunction, Lisp_PQbackendPID, "pq-backend-pid connection"},
78    {LispFunction, Lisp_PQclear, "pq-clear result"},
79    {LispFunction, Lisp_PQconsumeInput, "pq-consume-input connection"},
80    {LispFunction, Lisp_PQdb, "pq-db connection"},
81    {LispFunction, Lisp_PQerrorMessage, "pq-error-message connection"},
82    {LispFunction, Lisp_PQexec, "pq-exec connection query"},
83    {LispFunction, Lisp_PQfinish, "pq-finish connection"},
84    {LispFunction, Lisp_PQfname, "pq-fname result field-number"},
85    {LispFunction, Lisp_PQfnumber, "pq-fnumber result field-name"},
86    {LispFunction, Lisp_PQfsize, "pq-fsize result field-number"},
87    {LispFunction, Lisp_PQftype, "pq-ftype result field-number"},
88    {LispFunction, Lisp_PQgetlength, "pq-getlength result tupple field-number"},
89    {LispFunction, Lisp_PQgetvalue, "pq-getvalue result tupple field-number &optional type"},
90    {LispFunction, Lisp_PQhost, "pq-host connection"},
91    {LispFunction, Lisp_PQnfields, "pq-nfields result"},
92    {LispFunction, Lisp_PQnotifies, "pq-notifies connection"},
93    {LispFunction, Lisp_PQntuples, "pq-ntuples result"},
94    {LispFunction, Lisp_PQoptions, "pq-options connection"},
95    {LispFunction, Lisp_PQpass, "pq-pass connection"},
96    {LispFunction, Lisp_PQport, "pq-port connection"},
97    {LispFunction, Lisp_PQresultStatus, "pq-result-status result"},
98    {LispFunction, Lisp_PQsetdb, "pq-setdb host port options tty dbname"},
99    {LispFunction, Lisp_PQsetdbLogin, "pq-setdb-login host port options tty dbname login password"},
100    {LispFunction, Lisp_PQsocket, "pq-socket connection"},
101    {LispFunction, Lisp_PQstatus, "pq-status connection"},
102    {LispFunction, Lisp_PQtty, "pq-tty connection"},
103    {LispFunction, Lisp_PQuser, "pq-user connection"},
104};
105
106LispModuleData psqlLispModuleData = {
107    LISP_MODULE_VERSION,
108    psqlLoadModule
109};
110
111static int PGconn_t, PGresult_t;
112
113/*
114 * Implementation
115 */
116int
117psqlLoadModule(void)
118{
119    int i;
120    char *fname = "PSQL-LOAD-MODULE";
121
122    PGconn_t = LispRegisterOpaqueType("PGconn*");
123    PGresult_t = LispRegisterOpaqueType("PGresult*");
124
125    GCDisable();
126    /* NOTE: Implemented just enough to make programming examples
127     * (and my needs) work.
128     * Completing this is an exercise to the reader, or may be implemented
129     * when/if required.
130     */
131    LispExecute("(DEFSTRUCT PG-NOTIFY RELNAME BE-PID)\n"
132		"(DEFSTRUCT PG-POINT X Y)\n"
133		"(DEFSTRUCT PG-BOX HIGH LOW)\n"
134		"(DEFSTRUCT PG-POLYGON SIZE NUM-POINTS BOUNDBOX POINTS)\n");
135
136    /* enum ConnStatusType */
137    (void)LispSetVariable(ATOM2("PG-CONNECTION-OK"),
138			  REAL(CONNECTION_OK), fname, 0);
139    (void)LispSetVariable(ATOM2("PG-CONNECTION-BAD"),
140			  REAL(CONNECTION_BAD), fname, 0);
141    (void)LispSetVariable(ATOM2("PG-CONNECTION-STARTED"),
142			  REAL(CONNECTION_STARTED), fname, 0);
143    (void)LispSetVariable(ATOM2("PG-CONNECTION-MADE"),
144			  REAL(CONNECTION_MADE), fname, 0);
145    (void)LispSetVariable(ATOM2("PG-CONNECTION-AWAITING-RESPONSE"),
146			  REAL(CONNECTION_AWAITING_RESPONSE), fname, 0);
147    (void)LispSetVariable(ATOM2("PG-CONNECTION-AUTH-OK"),
148			  REAL(CONNECTION_AUTH_OK), fname, 0);
149    (void)LispSetVariable(ATOM2("PG-CONNECTION-SETENV"),
150			  REAL(CONNECTION_SETENV), fname, 0);
151
152
153    /* enum ExecStatusType */
154    (void)LispSetVariable(ATOM2("PGRES-EMPTY-QUERY"),
155			  REAL(PGRES_EMPTY_QUERY), fname, 0);
156    (void)LispSetVariable(ATOM2("PGRES-COMMAND-OK"),
157			  REAL(PGRES_COMMAND_OK), fname, 0);
158    (void)LispSetVariable(ATOM2("PGRES-TUPLES-OK"),
159			  REAL(PGRES_TUPLES_OK), fname, 0);
160    (void)LispSetVariable(ATOM2("PGRES-COPY-OUT"),
161			  REAL(PGRES_COPY_OUT), fname, 0);
162    (void)LispSetVariable(ATOM2("PGRES-COPY-IN"),
163			  REAL(PGRES_COPY_IN), fname, 0);
164    (void)LispSetVariable(ATOM2("PGRES-BAD-RESPONSE"),
165			  REAL(PGRES_BAD_RESPONSE), fname, 0);
166    (void)LispSetVariable(ATOM2("PGRES-NONFATAL-ERROR"),
167			  REAL(PGRES_NONFATAL_ERROR), fname, 0);
168    (void)LispSetVariable(ATOM2("PGRES-FATAL-ERROR"),
169			  REAL(PGRES_FATAL_ERROR), fname, 0);
170    GCEnable();
171
172    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
173	LispAddBuiltinFunction(&lispbuiltins[i]);
174
175    return (1);
176}
177
178LispObj *
179Lisp_PQbackendPID(LispBuiltin *builtin)
180/*
181 pq-backend-pid connection
182 */
183{
184    int pid;
185    PGconn *conn;
186
187    LispObj *connection;
188
189    connection = ARGUMENT(0);
190
191    if (!CHECKO(connection, PGconn_t))
192	LispDestroy("%s: cannot convert %s to PGconn*",
193		    STRFUN(builtin), STROBJ(connection));
194    conn = (PGconn*)(connection->data.opaque.data);
195
196    pid = PQbackendPID(conn);
197
198    return (INTEGER(pid));
199}
200
201LispObj *
202Lisp_PQclear(LispBuiltin *builtin)
203/*
204 pq-clear result
205 */
206{
207    PGresult *res;
208
209    LispObj *result;
210
211    result = ARGUMENT(0);
212
213    if (!CHECKO(result, PGresult_t))
214	LispDestroy("%s: cannot convert %s to PGresult*",
215		    STRFUN(builtin), STROBJ(result));
216    res = (PGresult*)(result->data.opaque.data);
217
218    PQclear(res);
219
220    return (NIL);
221}
222
223LispObj *
224Lisp_PQconsumeInput(LispBuiltin *builtin)
225/*
226 pq-consume-input connection
227 */
228{
229    int result;
230    PGconn *conn;
231
232    LispObj *connection;
233
234    connection = ARGUMENT(0);
235
236    if (!CHECKO(connection, PGconn_t))
237	LispDestroy("%s: cannot convert %s to PGconn*",
238		    STRFUN(builtin), STROBJ(connection));
239    conn = (PGconn*)(connection->data.opaque.data);
240
241    result = PQconsumeInput(conn);
242
243    return (INTEGER(result));
244}
245
246LispObj *
247Lisp_PQdb(LispBuiltin *builtin)
248/*
249 pq-db connection
250 */
251{
252    char *string;
253    PGconn *conn;
254
255    LispObj *connection;
256
257    connection = ARGUMENT(0);
258
259    if (!CHECKO(connection, PGconn_t))
260	LispDestroy("%s: cannot convert %s to PGconn*",
261		    STRFUN(builtin), STROBJ(connection));
262    conn = (PGconn*)(connection->data.opaque.data);
263
264    string = PQdb(conn);
265
266    return (string ? STRING(string) : NIL);
267}
268
269LispObj *
270Lisp_PQerrorMessage(LispBuiltin *builtin)
271{
272    char *string;
273    PGconn *conn;
274
275    LispObj *connection;
276
277    connection = ARGUMENT(0);
278
279    if (!CHECKO(connection, PGconn_t))
280	LispDestroy("%s: cannot convert %s to PGconn*",
281		    STRFUN(builtin), STROBJ(connection));
282    conn = (PGconn*)(connection->data.opaque.data);
283
284    string = PQerrorMessage(conn);
285
286    return (string ? STRING(string) : NIL);
287}
288
289LispObj *
290Lisp_PQexec(LispBuiltin *builtin)
291/*
292 pq-exec connection query
293 */
294{
295    PGconn *conn;
296    PGresult *res;
297
298    LispObj *connection, *query;
299
300    query = ARGUMENT(1);
301    connection = ARGUMENT(0);
302
303    if (!CHECKO(connection, PGconn_t))
304	LispDestroy("%s: cannot convert %s to PGconn*",
305		    STRFUN(builtin), STROBJ(connection));
306    conn = (PGconn*)(connection->data.opaque.data);
307
308    CHECK_STRING(query);
309    res = PQexec(conn, THESTR(query));
310
311    return (res ? OPAQUE(res, PGresult_t) : NIL);
312}
313
314LispObj *
315Lisp_PQfinish(LispBuiltin *builtin)
316/*
317 pq-finish connection
318 */
319{
320    PGconn *conn;
321
322    LispObj *connection;
323
324    connection = ARGUMENT(0);
325
326    if (!CHECKO(connection, PGconn_t))
327	LispDestroy("%s: cannot convert %s to PGconn*",
328		    STRFUN(builtin), STROBJ(connection));
329    conn = (PGconn*)(connection->data.opaque.data);
330
331    PQfinish(conn);
332
333    return (NIL);
334}
335
336LispObj *
337Lisp_PQfname(LispBuiltin *builtin)
338/*
339 pq-fname result field-number
340 */
341{
342    char *string;
343    int field;
344    PGresult *res;
345
346    LispObj *result, *field_number;
347
348    field_number = ARGUMENT(1);
349    result = ARGUMENT(0);
350
351    if (!CHECKO(result, PGresult_t))
352	LispDestroy("%s: cannot convert %s to PGresult*",
353		    STRFUN(builtin), STROBJ(result));
354    res = (PGresult*)(result->data.opaque.data);
355
356    CHECK_INDEX(field_number);
357    field = FIXNUM_VALUE(field_number);
358
359    string = PQfname(res, field);
360
361    return (string ? STRING(string) : NIL);
362}
363
364LispObj *
365Lisp_PQfnumber(LispBuiltin *builtin)
366/*
367 pq-fnumber result field-name
368 */
369{
370    int number;
371    int field;
372    PGresult *res;
373
374    LispObj *result, *field_name;
375
376    field_name = ARGUMENT(1);
377    result = ARGUMENT(0);
378
379    if (!CHECKO(result, PGresult_t))
380	LispDestroy("%s: cannot convert %s to PGresult*",
381		    STRFUN(builtin), STROBJ(result));
382    res = (PGresult*)(result->data.opaque.data);
383
384    CHECK_STRING(field_name);
385    number = PQfnumber(res, THESTR(field_name));
386
387    return (INTEGER(number));
388}
389
390LispObj *
391Lisp_PQfsize(LispBuiltin *builtin)
392/*
393 pq-fsize result field-number
394 */
395{
396    int size, field;
397    PGresult *res;
398
399    LispObj *result, *field_number;
400
401    field_number = ARGUMENT(1);
402    result = ARGUMENT(0);
403
404    if (!CHECKO(result, PGresult_t))
405	LispDestroy("%s: cannot convert %s to PGresult*",
406		    STRFUN(builtin), STROBJ(result));
407    res = (PGresult*)(result->data.opaque.data);
408
409    CHECK_INDEX(field_number);
410    field = FIXNUM_VALUE(field_number);
411
412    size = PQfsize(res, field);
413
414    return (INTEGER(size));
415}
416
417LispObj *
418Lisp_PQftype(LispBuiltin *builtin)
419{
420    Oid oid;
421    int field;
422    PGresult *res;
423
424    LispObj *result, *field_number;
425
426    field_number = ARGUMENT(1);
427    result = ARGUMENT(0);
428
429    if (!CHECKO(result, PGresult_t))
430	LispDestroy("%s: cannot convert %s to PGresult*",
431		    STRFUN(builtin), STROBJ(result));
432    res = (PGresult*)(result->data.opaque.data);
433
434    CHECK_INDEX(field_number);
435    field = FIXNUM_VALUE(field_number);
436
437    oid = PQftype(res, field);
438
439    return (INTEGER(oid));
440}
441
442LispObj *
443Lisp_PQgetlength(LispBuiltin *builtin)
444/*
445 pq-getlength result tupple field-number
446 */
447{
448    PGresult *res;
449    int tuple, field, length;
450
451    LispObj *result, *otupple, *field_number;
452
453    field_number = ARGUMENT(2);
454    otupple = ARGUMENT(1);
455    result = ARGUMENT(0);
456
457    if (!CHECKO(result, PGresult_t))
458	LispDestroy("%s: cannot convert %s to PGresult*",
459		    STRFUN(builtin), STROBJ(result));
460    res = (PGresult*)(result->data.opaque.data);
461
462    CHECK_INDEX(otupple);
463    tuple = FIXNUM_VALUE(otupple);
464
465    CHECK_INDEX(field_number);
466    field = FIXNUM_VALUE(field_number);
467
468    length = PQgetlength(res, tuple, field);
469
470    return (INTEGER(length));
471}
472
473LispObj *
474Lisp_PQgetvalue(LispBuiltin *builtin)
475/*
476 pq-getvalue result tuple field &optional type-specifier
477 */
478{
479    char *string;
480    double real = 0.0;
481    PGresult *res;
482    int tuple, field, isint = 0, isreal = 0, integer;
483
484    LispObj *result, *otupple, *field_number, *type;
485
486    type = ARGUMENT(3);
487    field_number = ARGUMENT(2);
488    otupple = ARGUMENT(1);
489    result = ARGUMENT(0);
490
491    if (!CHECKO(result, PGresult_t))
492	LispDestroy("%s: cannot convert %s to PGresult*",
493		    STRFUN(builtin), STROBJ(result));
494    res = (PGresult*)(result->data.opaque.data);
495
496    CHECK_INDEX(otupple);
497    tuple = FIXNUM_VALUE(otupple);
498
499    CHECK_INDEX(field_number);
500    field = FIXNUM_VALUE(field_number);
501
502    string = PQgetvalue(res, tuple, field);
503
504    if (type != UNSPEC) {
505	char *typestring;
506
507	CHECK_SYMBOL(type);
508	typestring = ATOMID(type);
509
510	if (strcmp(typestring, "INT16") == 0) {
511	    integer = *(short*)string;
512	    isint = 1;
513	    goto simple_type;
514	}
515	else if (strcmp(typestring, "INT32") == 0) {
516	    integer = *(int*)string;
517	    isint = 1;
518	    goto simple_type;
519	}
520	else if (strcmp(typestring, "FLOAT") == 0) {
521	    real = *(float*)string;
522	    isreal = 1;
523	    goto simple_type;
524	}
525	else if (strcmp(typestring, "REAL") == 0) {
526	    real = *(double*)string;
527	    isreal = 1;
528	    goto simple_type;
529	}
530	else if (strcmp(typestring, "PG-POLYGON") == 0)
531	    goto polygon_type;
532	else if (strcmp(typestring, "STRING") != 0)
533	    LispDestroy("%s: unknown type %s",
534			STRFUN(builtin), typestring);
535    }
536
537simple_type:
538    return (isint ? INTEGER(integer) : isreal ? DFLOAT(real) :
539	    (string ? STRING(string) : NIL));
540
541polygon_type:
542  {
543    LispObj *poly, *box, *p = NIL, *cdr, *obj;
544    POLYGON *polygon;
545    int i, size;
546
547    size = PQgetlength(res, tuple, field);
548    polygon = (POLYGON*)(string - sizeof(int));
549
550    GCDisable();
551    /* get polygon->boundbox */
552    cdr = EVAL(CONS(ATOM("MAKE-PG-POINT"),
553		    CONS(KEYWORD("X"),
554			 CONS(REAL(polygon->boundbox.high.x),
555			      CONS(KEYWORD("Y"),
556				   CONS(REAL(polygon->boundbox.high.y), NIL))))));
557    obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
558		    CONS(KEYWORD("X"),
559			 CONS(REAL(polygon->boundbox.low.x),
560			      CONS(KEYWORD("Y"),
561				   CONS(REAL(polygon->boundbox.low.y), NIL))))));
562    box = EVAL(CONS(ATOM("MAKE-PG-BOX"),
563		    CONS(KEYWORD("HIGH"),
564			 CONS(cdr,
565			      CONS(KEYWORD("LOW"),
566				   CONS(obj, NIL))))));
567    /* get polygon->p values */
568    for (i = 0; i < polygon->npts; i++) {
569	obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
570			CONS(KEYWORD("X"),
571			     CONS(REAL(polygon->p[i].x),
572			      CONS(KEYWORD("Y"),
573				   CONS(REAL(polygon->p[i].y), NIL))))));
574	if (i == 0)
575	    p = cdr = CONS(obj, NIL);
576	else {
577	    RPLACD(cdr, CONS(obj, NIL));
578	    cdr = CDR(cdr);
579	}
580    }
581
582    /* make result */
583    poly = EVAL(CONS(ATOM("MAKE-PG-POLYGON"),
584		     CONS(KEYWORD("SIZE"),
585			  CONS(REAL(size),
586			       CONS(KEYWORD("NUM-POINTS"),
587				    CONS(REAL(polygon->npts),
588					 CONS(KEYWORD("BOUNDBOX"),
589					      CONS(box,
590						   CONS(KEYWORD("POINTS"),
591							CONS(QUOTE(p), NIL))))))))));
592    GCEnable();
593
594    return (poly);
595  }
596}
597
598LispObj *
599Lisp_PQhost(LispBuiltin *builtin)
600/*
601 pq-host connection
602 */
603{
604    char *string;
605    PGconn *conn;
606
607    LispObj *connection;
608
609    connection = ARGUMENT(0);
610
611    if (!CHECKO(connection, PGconn_t))
612	LispDestroy("%s: cannot convert %s to PGconn*",
613		    STRFUN(builtin), STROBJ(connection));
614    conn = (PGconn*)(connection->data.opaque.data);
615
616    string = PQhost(conn);
617
618    return (string ? STRING(string) : NIL);
619}
620
621LispObj *
622Lisp_PQnfields(LispBuiltin *builtin)
623/*
624 pq-nfields result
625 */
626{
627    int nfields;
628    PGresult *res;
629
630    LispObj *result;
631
632    result = ARGUMENT(0);
633
634    if (!CHECKO(result, PGresult_t))
635	LispDestroy("%s: cannot convert %s to PGresult*",
636		    STRFUN(builtin), STROBJ(result));
637    res = (PGresult*)(result->data.opaque.data);
638
639    nfields = PQnfields(res);
640
641    return (INTEGER(nfields));
642}
643
644LispObj *
645Lisp_PQnotifies(LispBuiltin *builtin)
646/*
647 pq-notifies connection
648 */
649{
650    LispObj *result, *code, *cod = COD;
651    PGconn *conn;
652    PGnotify *notifies;
653
654    LispObj *connection;
655
656    connection = ARGUMENT(0);
657
658    if (!CHECKO(connection, PGconn_t))
659	LispDestroy("%s: cannot convert %s to PGconn*",
660		    STRFUN(builtin), STROBJ(connection));
661    conn = (PGconn*)(connection->data.opaque.data);
662
663    if ((notifies = PQnotifies(conn)) == NULL)
664	return (NIL);
665
666    GCDisable();
667    code = CONS(ATOM("MAKE-PG-NOTIFY"),
668		  CONS(KEYWORD("RELNAME"),
669		       CONS(STRING(notifies->relname),
670			    CONS(KEYWORD("BE-PID"),
671				 CONS(REAL(notifies->be_pid), NIL)))));
672    COD = CONS(code, COD);
673    GCEnable();
674    result = EVAL(code);
675    COD = cod;
676
677    free(notifies);
678
679    return (result);
680}
681
682LispObj *
683Lisp_PQntuples(LispBuiltin *builtin)
684/*
685 pq-ntuples result
686 */
687{
688    int ntuples;
689    PGresult *res;
690
691    LispObj *result;
692
693    result = ARGUMENT(0);
694
695    if (!CHECKO(result, PGresult_t))
696	LispDestroy("%s: cannot convert %s to PGresult*",
697		    STRFUN(builtin), STROBJ(result));
698    res = (PGresult*)(result->data.opaque.data);
699
700    ntuples = PQntuples(res);
701
702    return (INTEGER(ntuples));
703}
704
705LispObj *
706Lisp_PQoptions(LispBuiltin *builtin)
707/*
708 pq-options connection
709 */
710{
711    char *string;
712    PGconn *conn;
713
714    LispObj *connection;
715
716    connection = ARGUMENT(0);
717
718    if (!CHECKO(connection, PGconn_t))
719	LispDestroy("%s: cannot convert %s to PGconn*",
720		    STRFUN(builtin), STROBJ(connection));
721    conn = (PGconn*)(connection->data.opaque.data);
722
723    string = PQoptions(conn);
724
725    return (string ? STRING(string) : NIL);
726}
727
728LispObj *
729Lisp_PQpass(LispBuiltin *builtin)
730/*
731 pq-pass connection
732 */
733{
734    char *string;
735    PGconn *conn;
736
737    LispObj *connection;
738
739    connection = ARGUMENT(0);
740
741    if (!CHECKO(connection, PGconn_t))
742	LispDestroy("%s: cannot convert %s to PGconn*",
743		    STRFUN(builtin), STROBJ(connection));
744    conn = (PGconn*)(connection->data.opaque.data);
745
746    string = PQpass(conn);
747
748    return (string ? STRING(string) : NIL);
749}
750
751LispObj *
752Lisp_PQport(LispBuiltin *builtin)
753/*
754 pq-port connection
755 */
756{
757    char *string;
758    PGconn *conn;
759
760    LispObj *connection;
761
762    connection = ARGUMENT(0);
763
764    if (!CHECKO(connection, PGconn_t))
765	LispDestroy("%s: cannot convert %s to PGconn*",
766		    STRFUN(builtin), STROBJ(connection));
767    conn = (PGconn*)(connection->data.opaque.data);
768
769    string = PQport(conn);
770
771    return (string ? STRING(string) : NIL);
772}
773
774LispObj *
775Lisp_PQresultStatus(LispBuiltin *builtin)
776/*
777 pq-result-status result
778 */
779{
780    int status;
781    PGresult *res;
782
783    LispObj *result;
784
785    result = ARGUMENT(0);
786
787    if (!CHECKO(result, PGresult_t))
788	LispDestroy("%s: cannot convert %s to PGresult*",
789		    STRFUN(builtin), STROBJ(result));
790    res = (PGresult*)(result->data.opaque.data);
791
792    status = PQresultStatus(res);
793
794    return (INTEGER(status));
795}
796
797LispObj *
798LispPQsetdb(LispBuiltin *builtin, int loginp)
799/*
800 pq-setdb host port options tty dbname
801 pq-setdb-login host port options tty dbname login password
802 */
803{
804    PGconn *conn;
805    char *host, *port, *options, *tty, *dbname, *login, *password;
806
807    LispObj *ohost, *oport, *ooptions, *otty, *odbname, *ologin, *opassword;
808
809    if (loginp) {
810	opassword = ARGUMENT(6);
811	ologin = ARGUMENT(5);
812    }
813    else
814	opassword = ologin = NIL;
815    odbname = ARGUMENT(4);
816    otty = ARGUMENT(3);
817    ooptions = ARGUMENT(2);
818    oport = ARGUMENT(1);
819    ohost = ARGUMENT(0);
820
821    if (ohost != NIL) {
822	CHECK_STRING(ohost);
823	host = THESTR(ohost);
824    }
825    else
826	host = NULL;
827
828    if (oport != NIL) {
829	CHECK_STRING(oport);
830	port = THESTR(oport);
831    }
832    else
833	port = NULL;
834
835    if (ooptions != NIL) {
836	CHECK_STRING(ooptions);
837	options = THESTR(ooptions);
838    }
839    else
840	options = NULL;
841
842    if (otty != NIL) {
843	CHECK_STRING(otty);
844	tty = THESTR(otty);
845    }
846    else
847	tty = NULL;
848
849    if (odbname != NIL) {
850	CHECK_STRING(odbname);
851	dbname = THESTR(odbname);
852    }
853    else
854	dbname = NULL;
855
856    if (ologin != NIL) {
857	CHECK_STRING(ologin);
858	login = THESTR(ologin);
859    }
860    else
861	login = NULL;
862
863    if (opassword != NIL) {
864	CHECK_STRING(opassword);
865	password = THESTR(opassword);
866    }
867    else
868	password = NULL;
869
870    conn = PQsetdbLogin(host, port, options, tty, dbname, login, password);
871
872    return (conn ? OPAQUE(conn, PGconn_t) : NIL);
873}
874
875LispObj *
876Lisp_PQsetdb(LispBuiltin *builtin)
877/*
878 pq-setdb host port options tty dbname
879 */
880{
881    return (LispPQsetdb(builtin, 0));
882}
883
884LispObj *
885Lisp_PQsetdbLogin(LispBuiltin *builtin)
886/*
887 pq-setdb-login host port options tty dbname login password
888 */
889{
890    return (LispPQsetdb(builtin, 1));
891}
892
893LispObj *
894Lisp_PQsocket(LispBuiltin *builtin)
895/*
896 pq-socket connection
897 */
898{
899    int sock;
900    PGconn *conn;
901
902    LispObj *connection;
903
904    connection = ARGUMENT(0);
905
906    if (!CHECKO(connection, PGconn_t))
907	LispDestroy("%s: cannot convert %s to PGconn*",
908		    STRFUN(builtin), STROBJ(connection));
909    conn = (PGconn*)(connection->data.opaque.data);
910
911    sock = PQsocket(conn);
912
913    return (INTEGER(sock));
914}
915
916LispObj *
917Lisp_PQstatus(LispBuiltin *builtin)
918/*
919 pq-status connection
920 */
921{
922    int status;
923    PGconn *conn;
924
925    LispObj *connection;
926
927    connection = ARGUMENT(0);
928
929    if (!CHECKO(connection, PGconn_t))
930	LispDestroy("%s: cannot convert %s to PGconn*",
931		    STRFUN(builtin), STROBJ(connection));
932    conn = (PGconn*)(connection->data.opaque.data);
933
934    status = PQstatus(conn);
935
936    return (INTEGER(status));
937}
938
939LispObj *
940Lisp_PQtty(LispBuiltin *builtin)
941/*
942 pq-tty connection
943 */
944{
945    char *string;
946    PGconn *conn;
947
948    LispObj *connection;
949
950    connection = ARGUMENT(0);
951
952    if (!CHECKO(connection, PGconn_t))
953	LispDestroy("%s: cannot convert %s to PGconn*",
954		    STRFUN(builtin), STROBJ(connection));
955    conn = (PGconn*)(connection->data.opaque.data);
956
957    string = PQtty(conn);
958
959    return (string ? STRING(string) : NIL);
960}
961
962LispObj *
963Lisp_PQuser(LispBuiltin *builtin)
964/*
965 pq-user connection
966 */
967{
968    char *string;
969    PGconn *conn;
970
971    LispObj *connection;
972
973    connection = ARGUMENT(0);
974
975    if (!CHECKO(connection, PGconn_t))
976	LispDestroy("%s: cannot convert %s to PGconn*",
977		    STRFUN(builtin), STROBJ(connection));
978    conn = (PGconn*)(connection->data.opaque.data);
979
980    string = PQuser(conn);
981
982    return (string ? STRING(string) : NIL);
983}
984