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  */
43 int psqlLoadModule(void);
44 
45 LispObj *Lisp_PQbackendPID(LispBuiltin*);
46 LispObj *Lisp_PQclear(LispBuiltin*);
47 LispObj *Lisp_PQconsumeInput(LispBuiltin*);
48 LispObj *Lisp_PQdb(LispBuiltin*);
49 LispObj *Lisp_PQerrorMessage(LispBuiltin*);
50 LispObj *Lisp_PQexec(LispBuiltin*);
51 LispObj *Lisp_PQfinish(LispBuiltin*);
52 LispObj *Lisp_PQfname(LispBuiltin*);
53 LispObj *Lisp_PQfnumber(LispBuiltin*);
54 LispObj *Lisp_PQfsize(LispBuiltin*);
55 LispObj *Lisp_PQftype(LispBuiltin*);
56 LispObj *Lisp_PQgetlength(LispBuiltin*);
57 LispObj *Lisp_PQgetvalue(LispBuiltin*);
58 LispObj *Lisp_PQhost(LispBuiltin*);
59 LispObj *Lisp_PQnfields(LispBuiltin*);
60 LispObj *Lisp_PQnotifies(LispBuiltin*);
61 LispObj *Lisp_PQntuples(LispBuiltin*);
62 LispObj *Lisp_PQoptions(LispBuiltin*);
63 LispObj *Lisp_PQpass(LispBuiltin*);
64 LispObj *Lisp_PQport(LispBuiltin*);
65 LispObj *Lisp_PQresultStatus(LispBuiltin*);
66 LispObj *Lisp_PQsetdb(LispBuiltin*);
67 LispObj *Lisp_PQsetdbLogin(LispBuiltin*);
68 LispObj *Lisp_PQsocket(LispBuiltin*);
69 LispObj *Lisp_PQstatus(LispBuiltin*);
70 LispObj *Lisp_PQtty(LispBuiltin*);
71 LispObj *Lisp_PQuser(LispBuiltin*);
72 
73 /*
74  * Initialization
75  */
76 static 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 
106 LispModuleData psqlLispModuleData = {
107     LISP_MODULE_VERSION,
108     psqlLoadModule
109 };
110 
111 static int PGconn_t, PGresult_t;
112 
113 /*
114  * Implementation
115  */
116 int
psqlLoadModule(void)117 psqlLoadModule(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 
178 LispObj *
Lisp_PQbackendPID(LispBuiltin * builtin)179 Lisp_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 
201 LispObj *
Lisp_PQclear(LispBuiltin * builtin)202 Lisp_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 
223 LispObj *
Lisp_PQconsumeInput(LispBuiltin * builtin)224 Lisp_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 
246 LispObj *
Lisp_PQdb(LispBuiltin * builtin)247 Lisp_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 
269 LispObj *
Lisp_PQerrorMessage(LispBuiltin * builtin)270 Lisp_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 
289 LispObj *
Lisp_PQexec(LispBuiltin * builtin)290 Lisp_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 
314 LispObj *
Lisp_PQfinish(LispBuiltin * builtin)315 Lisp_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 
336 LispObj *
Lisp_PQfname(LispBuiltin * builtin)337 Lisp_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 
364 LispObj *
Lisp_PQfnumber(LispBuiltin * builtin)365 Lisp_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 
390 LispObj *
Lisp_PQfsize(LispBuiltin * builtin)391 Lisp_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 
417 LispObj *
Lisp_PQftype(LispBuiltin * builtin)418 Lisp_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 
442 LispObj *
Lisp_PQgetlength(LispBuiltin * builtin)443 Lisp_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 
473 LispObj *
Lisp_PQgetvalue(LispBuiltin * builtin)474 Lisp_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 
537 simple_type:
538     return (isint ? INTEGER(integer) : isreal ? DFLOAT(real) :
539 	    (string ? STRING(string) : NIL));
540 
541 polygon_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 
598 LispObj *
Lisp_PQhost(LispBuiltin * builtin)599 Lisp_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 
621 LispObj *
Lisp_PQnfields(LispBuiltin * builtin)622 Lisp_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 
644 LispObj *
Lisp_PQnotifies(LispBuiltin * builtin)645 Lisp_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 
682 LispObj *
Lisp_PQntuples(LispBuiltin * builtin)683 Lisp_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 
705 LispObj *
Lisp_PQoptions(LispBuiltin * builtin)706 Lisp_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 
728 LispObj *
Lisp_PQpass(LispBuiltin * builtin)729 Lisp_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 
751 LispObj *
Lisp_PQport(LispBuiltin * builtin)752 Lisp_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 
774 LispObj *
Lisp_PQresultStatus(LispBuiltin * builtin)775 Lisp_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 
797 LispObj *
LispPQsetdb(LispBuiltin * builtin,int loginp)798 LispPQsetdb(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 
875 LispObj *
Lisp_PQsetdb(LispBuiltin * builtin)876 Lisp_PQsetdb(LispBuiltin *builtin)
877 /*
878  pq-setdb host port options tty dbname
879  */
880 {
881     return (LispPQsetdb(builtin, 0));
882 }
883 
884 LispObj *
Lisp_PQsetdbLogin(LispBuiltin * builtin)885 Lisp_PQsetdbLogin(LispBuiltin *builtin)
886 /*
887  pq-setdb-login host port options tty dbname login password
888  */
889 {
890     return (LispPQsetdb(builtin, 1));
891 }
892 
893 LispObj *
Lisp_PQsocket(LispBuiltin * builtin)894 Lisp_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 
916 LispObj *
Lisp_PQstatus(LispBuiltin * builtin)917 Lisp_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 
939 LispObj *
Lisp_PQtty(LispBuiltin * builtin)940 Lisp_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 
962 LispObj *
Lisp_PQuser(LispBuiltin * builtin)963 Lisp_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