File: postgres.lsp

package info (click to toggle)
newlisp 10.7.1-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 8,460 kB
  • ctags: 4,357
  • sloc: ansic: 33,202; lisp: 7,369; java: 7,012; sh: 647; makefile: 273
file content (805 lines) | stat: -rw-r--r-- 28,300 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
;; @module postgres.lsp 
;; @description PostgreSQL interface (tested on PostgreSQL 9.4, should work on all supported versions)
;; @version 1.02  - feature complete
;; @version 1.03  - doc formatting
;; @version 2.00  - replaced <tt>inc</tt> with <tt>++</tt>
;; @version 2.10  - new <tt>fnumber</tt> and <tt>fetch-value</tt>
;; @version 2.11  - new <tt>query</tt> with optional parameters
;; @version 2.12  - add MacPorts path, Fix bugs (error), (affected-rows), (fields ...), test against PostgreSQL 9.4
;; @version 3.00  - add new postgreSQL imports, use pg_config to find libpq header, improve test coverage
;; @author Jeremy Cowgar 2006, Ted Walther 2009, Lutz Mueller 2010, Unya 2012, Neil Tiffin 2015
;;
;; <h3>Requirements</h3>
;; At the beginning of the program file include a 'load' statement for the module:
;; <pre>
;; (load "/usr/share/newlisp/modules/postgres.lsp")
;; ; or
;; (module "postgres.lsp") ; loads from (env "NEWLISPDIR") / modules
;; </pre>
;;
;; A version of 'libpq' for a specific platform is required:
;;  
;; on LINUX/UNIX: 'libpq.so' <br>
;; on Mac OS X:   'libpq.dylib' <br>
;; on Windows:    'libpq.dll'
;;
;; This library is installed when using the install
;; package @link http://www.postgresql.org/download/ .
;; Unix, Linux, and Mac each have package installers that can be used
;; to install the PostgreSQL client (libpq) & server.
;;
;; Libpq might be in a different location on a particular
;; installation of PostgreSQL or have a different extension.
;; This module attempts to find libpq using pg_config.  If you can execute
;; pg_config at the command line and see its results then everything should just
;; work.  If not, then
;; you may have to edit the manual search code below to find your specific libpq.
;;
;; If you are using PostgreSQL from a Linux distribution you will need to install the
;; development headers for libpq, usually called libpq-dev.
;;
;; The PostgreSQL server itself may reside on a different machine
;; on the network. The library 'libpq' will communicate
;; with that server. The correct connection is created using
;; the 'PgSQL:connect' call.
;;
;; At the bottom of the module file 'postgres.lsp' a test routine 'test-pgsql'
;; is included to test for correct installation of PostgreSQL.  You call it
;; with the same arguments you would pass to ':connect'
;;
;; <h3>Functions available</h3>
;; <pre>
;;   Connect
;;     PgSQL:connect ............. connect to a database
;;     PgSQL:close-db ............ close database connection
;;     PgSQL:error-conn .......... get connection error message *
;;
;;   Query
;;     PgSQL:query ............... execute a SQL statement
;;
;;   Query Results
;;     PgSQL:affected-rows ....... number of affected rows from operation
;;     PgSQL:data-seek ........... position in result for fetching
;;     PgSQL:error ............... get query error message
;;     PgSQL:fetch-all ........... get all rows from the last query
;;     PgSQL:fetch-row ........... get row from the query result
;;     PgSQL:fetch-value ......... get value from the query result
;;     PgSQL:fnumber ............. column number of query
;;     PgSQL:num-fields .......... columns in result of query
;;     PgSQL:num-rows ............ rows in result of query
;;
;;   Info
;;     PgSQL:database ............ return all database names
;;     PgSQL:fields .............. return all fields in a table
;;     PgSQL:tables .............. return all tables names
;;
;;   Misc
;;     PgSQL:escape .............. escapes single quote in input string 
;;     PgSQL:escape-literal ...... escapes literal for PostgreSQL *
;;     PgSQL:escape-identifier ... escapes identifier for PostgreSQL *
;;
;; * API may be specific to PostgreSQL
;; </pre>
;;
;; <h3>Differences from the MySQL module</h3>
;;
;; The function ':inserted-id' isn&#039;t supported because PostgreSQL
;; doesn&#039;t support it.  Instead, use the 'RETURNING' clause in your 'INSERT'
;; statement, then use ':fetch-row' or ':fetch-all' to
;; find the value.  'INSERT&nbsp;RETURNING' is a PostreSQL idiom
;; documented @link http://www.postgresql.org/docs/9.4/static/sql-insert.html here.
;;
;; There is no ':init' function because it isn't needed by the underlying
;; library.  Just call ':connect'.
;;
;; <h3>A typical PgSQL session</h3>
;; The following code piece outlines a typical PgSQL session:
;;
;; @example
;; (module "postgres.lsp") ; load the module file
;;
;; (PgSQL:connect "192.168.1.10" "auser" "secret" "mydb") ; logon
;; (PgSQL:query "select ...;") ; SQL query
;; (PgSQL:query "insert ...;") ; SQL query
;;        ...
;; (PgSQL:close-db)

;; The database server is listening on IP 192.168.1.10. The program
;; connects with username '"auser"' password '"secret"' to a database with 
;; the name '"mydb"'. After connecting SQL statements are performed and
;; finally the program disconnects from the server.
;; 
;; If the database server is running locally then "localhost" may be used for
;; the host name.
;;
;; <h3>Bugs</h3>
;;
;; This module doesn't support connections through a Unix socket.
;;
;; <h3>Implementation Notes</h3>
;; As of 19 March 2015.
;; On Windows only works with x86 (32bit) PostgreSQL install.
;; pg_config must be in the path.
;; Tested on OSX 10.10.2, Linux SMP Debian 3.16.7-ckt7-1, Windows 8.1 [version 6.3.9600]

; make this module compatible with version less than 10.1.11
(when (< (sys-info -2) 10110)
	(constant (global '++) inc))

(context 'PgSQL)

(set 'library "libpq.so.5")

; import functions and throw error if not found
(define (pg_import fun_name)
  (import library fun_name "cdecl"))

; import functions and print warning if not found
(define (pg_import_warn fun_name)
  (unless (catch (import library fun_name "cdecl") 'pg_load_error)
    (println "libpq import WARNING: " pg_load_error)))

; import functions available in libpq for 8.4 or earlier
; These are core functions and will throw an error if not found.
(map pg_import (list 
	"PQcancel"
	"PQclear"
	"PQcmdStatus"
	"PQcmdTuples"
	"PQconnectdb"
	;"PQconnectionNeedsPassword"	; PostgreSQL 8.3
	;"PQconnectionUsedPassword"		; PostgreSQL 8.3
	"PQconsumeInput"
	"PQdb"
	"PQdescribePortal"				; PostgreSQL 8.2
	"PQdescribePrepared"			; PostgreSQL 8.2
	;"PQencryptPassword"				; PostgreSQL 8.2
	"PQerrorMessage"
	"PQexec"
	"PQexecParams"
	"PQexecPrepared"					; PostgreSQL 7.4
	"PQfinish"
	"PQflush"
	"PQfname"
	"PQfnumber"
	"PQfreeCancel"
	"PQfreemem"								; PostgreSQL 7.4
	"PQgetCancel"
	"PQgetisnull"
	"PQgetvalue"
	"PQhost"
	"PQinstanceData"					; PostgreSQL 8.4
	"PQisBusy"
	"PQisnonblocking"
	"PQisthreadsafe"					; PostgreSQL 8.2
	"PQnfields"
	"PQnotifies"
	"PQntuples"
	"PQoptions"
	"PQpass"
	"PQport"
	"PQprepare"								; PostgreSQL 8.0
	"PQprotocolVersion"
	"PQregisterEventProc"			; PostgreSQL 8.4
	"PQresultErrorMessage"
	"PQresultInstanceData"		; PostgreSQL 8.4
	"PQresultSetInstanceData"	; PostgreSQL 8.4
	"PQresultStatus"
	"PQresStatus"
	"PQsendQueryPrepared"			; PostgreSQL 7.4
	"PQserverVersion"					; PostgreSQL 8.0
	"PQsetInstanceData"				; PostgreSQL 8.4
	"PQsetnonblocking"
	"PQsetNoticeProcessor"
	"PQsetNoticeReceiver"
	"PQstatus"
	"PQuser"
))

; Try to import new libpq functions and print warning (do not throw error) if not found.
; if any of these functions are used then the code in this module should verify
; that the respective function was actually loaded before use.
(map pg_import_warn (list 
	"PQconninfo"					; PostgreSQL 9.3
	"PQescapeIdentifier"	; PostgreSQL 9.1
	"PQescapeLiteral"			; PostgreSQL 9.1
	"PQlibVersion"				; PostgreSQL 9.0
	"PQping"							; PostgreSQL 9.0
	"PQpingParams"				; PostgreSQL 9.0
	"PQsetSingleRowMode"	; PostgreSQL 9.2
))

(delete 'pg_import_warn)
(delete 'pg_import)


; On some wierd platforms NULL may equal something else, we'll worry about that when we bump into it.
(define NULL 0)
(define (NULL? n) (= 0 n))

(setq
  CONNECTION_OK 0
  PGRES_FATAL_ERROR 7)

(set 'PQPING_STATUS '(
	"PQPING_OK"
	"PQPING_REJECT"
	"PQPING_NO_RESPONSE"
	"PQPING_NO_ATTEMPT"))

; module variables
(setq PG_CONN nil)			; pg connection structure
(setq PG_RESULT nil)		; pg query result structure
(setq PG_ROWX 0)				; current row
(setq PG_COLX 0)				; current column

;; @syntax (PgSQL:connect <str-server> <str-userID> <str-password> <str-db>)
;; @param <str-server> The host name or IP address or <tt>0</tt> for localhost.
;; @param <str-userID> The user ID for authentication.
;; @param <str-password> The password for authentication.
;; @param <str-db> The name of the database to connect to.
;; @return 'true' for success or 'nil' for failure.
;; Connects to a database on server and authenticates a user ID.

(define (connect host user passw dbname)
  (connectdb (string
	(if (> (length host) 0) (string "host=" host) "")
	(if (> (length user) 0) (string " user=" user) "")
	(if (> (length passw) 0) (string " password=" passw) "")
	(if (> (length dbname) 0) (string " dbname=" dbname) "")
	)) )

;; @syntax (PgSQL:connectdb <str-conninfo>)
;; @param <str-conninfo> PostgreSQL Connection Parameters, To write an empty value or a value containing spaces, surround it with single quotes, e.g., keyword = 'a value'. keyword is 'host', 'hostaddr, 'port', 'dbname', 'user', 'password', 'connect_timeout', 'client_encoding', 'options', 'application_name', 'fallback_application_name', 'keepalives', 'keepalives_idle', 'keepalives_interval', 'keepalives_count', 'tty', 'sslmode', 'sslcompression', 'sslcert', 'sslkey', 'sslrootcert', 'sslcrl', 'requirepeer', 'krbsrvname', 'gsslib', 'service' in PostgreSQL 9.4.
;; @return 'true' for success or nil on failure.
;; Connects to a database on server.

(define (connectdb conninfo)
  (close-db)
  (setq PG_CONN (PQconnectdb conninfo))
  (if (NULL? PG_CONN)
    nil
    (if (= (PQstatus PG_CONN) CONNECTION_OK)
      true
      (PQfinish PG_CONN)
      (setq PG_CONN nil))))


;; @syntax (PgSQL:query <str-sql> [<param> ...])
;; @param <str-sql> A valid SQL query string. If parameters are used, they are referred to in the command string as $1, $2, etc.
;; @param <param> Specifies the actual values of the parameters.
;; @return Returns a numeric status code
;; Sends a SQL query string to the database server for evaluation.
;; The return value will be an integer representing one of the following enumerated types: PGRES_EMPTY_QUERY,
;; PGRES_COMMAND_OK, PGRES_TUPLES_OK, PGRES_COPY_OUT, PGRES_COPY_IN,
;; PGRES_BAD_RESPONSE, PGRES_FATAL_ERROR.
;;
;; The numeric status code can be converted to a string using (PgSQL:result-str <status-code>).  
;; The numeric status code should not be used directly.
;;
;; From the libpq documentation:
;; <blockquote>
;;     If the result status is PGRES_TUPLES_OK, then the functions described
;;     below can be used to retrieve the rows returned by the query. Note that
;;     a SELECT command that happens to retrieve zero rows still shows
;;     PGRES_TUPLES_OK. PGRES_COMMAND_OK is for commands that can never return
;;     rows (INSERT, UPDATE, etc.). A response of PGRES_EMPTY_QUERY might
;;     indicate a bug in the client software. 
;; </blockquote>
;;

;; @example
;;
;; (PgSQL:query "select $1||$2" "abc" "def")
;; (PgSQL:fetch-all) ; -> (("abcdef"))
;;
;; (PgSQL:query "select $1 + $2" 10 20)
;; (PgSQL:fetch-all) ; -> (("30"))
;;
;; (PgSQL:query "select $1::timestamp + $2::interval" "2012-10-01 00:00:00" "123456 seconds")
;; (PgSQL:fetch-all) ; -> (("2012-10-02 10:17:36"))
;;
;; (PgSQL:query "create table tbl (a integer, b integer)")
;; (dotimes (i 10) (PgSQL:query "insert into tbl values ($1, $2)" i (* i 2)))
;; ;    a | b
;; ;   ---+----
;; ;    0 |  0
;; ;    1 |  2
;; ;    2 |  4
;; ;    ...
;; ;    9 | 18
;;
;; (PgSQL:query "select * from tbl where a=$1 or a=$2" 2 9)
;; (PgSQL:fetch-all) ; -> (("2" "4") ("9" "18"))

(define (query sql)
  (clear-result)
  (letn ((nParams (length (args)))
	 (params (map (lambda (argv) (string argv)) (args)))
	 (ptr-fmt (if (= (& (sys-info 9) 256) 0)
		      "lu" "Lu"))
	 (paramValues (if params
			 (pack (dup ptr-fmt nParams) params)
			 0)))
    (setq PG_RESULT
	  (PQexecParams PG_CONN sql nParams 0 paramValues 0 0 0))
    (if (not (NULL? PG_RESULT))
       (PQresultStatus PG_RESULT)
       PGRES_FATAL_ERROR)) )

;; @syntax (PgSQL:num-rows)
;; @return Number of rows from last query.

(define (num-rows)
  (PQntuples PG_RESULT))

;; @syntax (PgSQL:num-fields)
;; @return Number of columns from last query.

(define (num-fields)
  (PQnfields PG_RESULT))

;; @syntax (PgSQL:fnumber <str-column>)
;; @param <str-column> The column name.
;; @return the column number associated with the given column name. return nil when not found column name.

(define (fnumber name)
  (let (n (PQfnumber PG_RESULT name))
    (if (< n 0)
			nil
			n)))

;; @syntax (PgSQL:fname <int-column>)
;; @param <int-column> The integer column number.
;; @return the column name associated with the given column number. return nil when not found column name.

(define (fname column)
	(let (s1 (PQfname PG_RESULT (int column)))
		(if (= s1 0)
			nil
			(let (s2 (get-string s1))
				(if (= s2 "")
					nil
					s2)))))

;; @syntax (PgSQL:fetch-value <num-row> <col>)
;; @param <num-row> row number
;; @param <col> column number or column name string.
;; @return A single value
;; Fetches the single value in the row and column specified.  Used by the
;; ':fetch-row' and ':fetch-all' functions.  A field containing the 'NULL'
;; value will return the symbol 'NULL'

(define (fetch-value row column)
  (if (string? column)
      (setq column (fnumber column)))
  (when column
    (let (s1 (PQgetvalue PG_RESULT row column))
      (if (NULL? s1)
	  nil
	  (let (s2 (get-string s1))
	    (if (= 1 (PQgetisnull PG_RESULT row column))
		'NULL s2))))) )

;; @syntax (PgSQL:fetch-row)
;; @return A list of field elements.
;; Fetches a row from a previous SQL 'PgSQL:query'  'select' statement.
;; Subsequent calls fetch row by row from the result table until the
;; end of the table is reached.

(define (fetch-row)
  (when (and (> (num-rows) 0) (> (num-rows) PG_ROWX))
    (let (row (map (fn (x) (fetch-value PG_ROWX x)) (sequence 0 (- (num-fields) 1))))
      (++ PG_ROWX)
      row)))

;; @syntax (PgSQL:fetch-all)
;; @return All rows/fields from the last query, or 'nil'
;; The whole result set from the query is returned at once as a list of row lists.

(define (fetch-all)
  (when (> (num-rows) 0)
    (data-seek 0)
    (map fetch-row (sequence 0 (- (num-rows) 1)))))

;; @syntax (PgSQL:databases)
;; @return A list of databases.
;; Performs the query 'SELECT datname FROM pg_database' which shows all the
;; database schemas hosted by the connected server.

(define (databases)
  (when (= "PGRES_TUPLES_OK" (result-status-str (query {SELECT datname FROM pg_database})))
    (map (fn (x) (x 0)) (fetch-all))))

;; @syntax (PgSQL:tables)
;; @return A list of tables in the database, or 'nil'
;; Performs the query 'SELECT table_name FROM information_schema.tables WHERE table_schema = &#039;public&#039;'

(define (tables)
  (when (= "PGRES_TUPLES_OK" (result-status-str (query {SELECT table_name FROM information_schema.tables WHERE table_schema = 'public'})))
    (map (fn (x) (x 0)) (fetch-all))))

;; @syntax (PgSQL:fields <str-table>)
;; @param <str-table> The name of the table.
;; @return A list of fields in the table, or 'nil'
;; Unlike the equivalent function in the MySQL module, this function only shows
;; the names of all the fields in the given table.  It does not show the field
;; specification, which you would need to recreate the table.

(define (fields str-table)
  (let (sql (format {SELECT column_name FROM information_schema.columns WHERE table_name = %s} (escape-literal str-table)))
    (when (= "PGRES_TUPLES_OK" (result-status-str (query sql)))
      (map (fn (x) (x 0)) (fetch-all)))))

;; @syntax (PgSQL:data-seek <num-offset>)
;; @param <num-offset> The '0' based offset to position inside the data set.
;; @return Always 'true'. 
;; Sets a position in the result set which will be used by the next
;; 'PgSQL:fetch-row' call. If the offset is out of the allowed range for the
;; result set a subsequent fetch-row will return 'nil'.

(define (data-seek n) (setq PG_ROWX n) true)

;; @syntax (PgSQL:error)
;; @return A string containing the query result error message.
;; If there was no error, this function returns 'nil'.

(define (error)
  (if (= PG_RESULT nil)
    (throw-error "Results are not available.")
    (let (s1 (PQresultErrorMessage PG_RESULT))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2))))))

;; @syntax (PgSQL:affected-rows)
;; @return Number of rows affected by the last 'PgSQL:query' operation, or 'nil'
;; This function will only return a value following the execution of an INSERT,
;; UPDATE, DELETE, MOVE, FETCH, or COPY statement, or an EXECUTE of a prepared
;; query that contains an INSERT, UPDATE, or DELETE statement. It will return
;; 'nil' after all other queries.

(define (affected-rows)
  (if (= PG_RESULT nil)
    nil
		(let (s1 (PQcmdTuples PG_RESULT))
			(if (NULL? s1)
				nil
				(let (s2 (get-string s1))
					(if (= s2 "")
						nil
						(int s2)))))))

;; @syntax (PgSQL:error-conn)
;; @return error message string
;; Returns the error message most recently generated by an operation on the connection.

(define (error-conn)
  (if (= PG_CONN nil)
    (throw-error "Connection is not available.")
    (let (s1 (PQerrorMessage PG_CONN))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2))))))

;; @syntax (PgSQL:escape <str-sql>)
;; @return escaped string
;; This function only escapes the ' character in <str-sql>, as per the SQL standard.
;; Depending on whether you
;; are using binary data or have configured Postgres to allow C escapes
;; you may need more advanced escaping than this function provides.

(define (escape)
  (replace {'} (apply string (args)) {''}))

;; @syntax (PgSQL:escape-literal <str>)
;; @param <str> string to be escaped
;; @return escaped string
;; This function escapes a string for use within an SQL command. This is
;; useful when inserting data values as literal constants in SQL commands. Certain
;; characters (such as quotes and backslashes) must be escaped to prevent them from
;; being interpreted specially by the SQL parser. escape-literal performs this
;; operation.  This function was added in PostgreSQL 9.1 and will throw an error if
;; you are using an older libpq.

(define (escape-literal x)
  (if (primitive? PQescapeLiteral)
		(if (= PG_CONN nil)
			(throw-error "Must be connected to a database.")
			(let (pg_raw_result (PQescapeLiteral PG_CONN x (length (get-string x))))
			(if (= pg_raw_result nil)
				(throw-error (error-conn))
				(let (pg_result (get-string pg_raw_result))
					(PQfreemem pg_raw_result)
					pg_result))))
  	(throw-error "PQescapeLiteral not available.")))

;; @syntax (PgSQL:escape-identifier <str>)
;; @param <str> string to be escaped
;; @return escaped string
;; This function escapes a string for use as an SQL identifier, such as a
;; table, column, or function name. This is useful when a user-supplied identifier
;; might contain special characters that would otherwise not be interpreted as part
;; of the identifier by the SQL parser, or when the identifier might contain upper
;; case characters whose case should be preserved. This function was added in 
;; PostgreSQL 9.1 and will throw an error if you are using an older libpq.

(define (escape-identifier x)
  (if (primitive? PQescapeIdentifier)
		(if (= PG_CONN nil)
			(throw-error "Must be connected to a database.")
			(let (pg_raw_result (PQescapeIdentifier PG_CONN x (length (get-string x))))
			(if (= pg_raw_result nil)
				(throw-error (error-conn))
				(let (pg_result (get-string pg_raw_result))
					(PQfreemem pg_raw_result)
					pg_result))))
  	(throw-error "PQescapeIdentifier not available.")))

(define (clear-result)
  (when (and PG_RESULT (not (NULL? PG_RESULT)))
    (PQclear PG_RESULT))
  (setq PG_RESULT nil PG_ROWX 0 PG_COLX 0))

;; @syntax (PgSQL:close-db)
;; @return Always 'true'.
;; Closes the database connection and frees associated resources.

(define (close-db)
  (clear-result)
  (when (and PG_CONN (not (NULL? PG_CONN)))
    (PQfinish PG_CONN))
  (setq PG_CONN nil)
  true)

;; @syntax (PgSQL:host)
;; @return connected host name string
(define (host)
  (if (= PG_CONN nil)
    (throw-error "Connection is not established.")
    (let (s1 (PQhost PG_CONN))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2))))))

;; @syntax (PgSQL:port)
;; @return connected port name string
(define (port)
  (if (= PG_CONN nil)
    (throw-error "Connection is not established.")
    (let (s1 (PQport PG_CONN))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2))))))

;; @syntax (PgSQL:db)
;; @return connected database name string
(define (db)
  (if (= PG_CONN nil)
    (throw-error "Connection is not established.")
    (let (s1 (PQdb PG_CONN))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2))))))

;; @syntax (PgSQL:options)
;; @return connected options string
(define (options)
  (if (= PG_CONN nil)
    (throw-error "Connection is not established.")
    (let (s1 (PQoptions PG_CONN))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2))))))

;; @syntax (PgSQL:user)
;; @return connected user name string
(define (user)
  (if (= PG_CONN nil)
    (throw-error "Connection is not established.")
    (let (s1 (PQuser PG_CONN))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2))))))

;; @syntax (PgSQL:result-str <int-status-code>)
;; @param <int-status-code> An integer query result status code
;; @return string for the given integer status code
;; The return value will be one of the following strings "PGRES_EMPTY_QUERY",
;; "PGRES_COMMAND_OK", "PGRES_TUPLES_OK", "PGRES_COPY_OUT", "PGRES_COPY_IN",
;; "PGRES_BAD_RESPONSE", "PGRES_FATAL_ERROR".

(define (result-status-str status-code)
    (let (s1 (PQresStatus status-code))
      (if (NULL? s1)
        nil
        (let (s2 (get-string s1))
          (if (= s2 "")
            nil
            s2)))))
	
; verify that the constant PGRES_FATAL_ERROR has the correct integer value
(if (!= "PGRES_FATAL_ERROR" (result-status-str PGRES_FATAL_ERROR) )
	(throw-error 
	  (append "PGRES_FATAL_ERROR defined as " 
	    (string PGRES_FATAL_ERROR) 
	    ", but PostgreSQL has that defined as "
	    (result-status-str PGRES_FATAL_ERROR) )))

;; @syntax (PgSQL:lib-version)
;; @return libpq version as string (e.g. "9.1.1")
(define (lib-version)
  (if (= PQlibVersion nil)
    "Not Available - Pre 9.0"
    (begin
      (regex {(\d+?)(\d\d)(\d\d)$} (string (PQlibVersion)))
      (append $1 "." $2 "." $3))))

;; @syntax (PgSQL:protocol-version)
;; @return protocol version "2", or "3" as string, "0" bad connection.
;; Interrogates the frontend/backend protocol being used.
(define (protocol-version)
  (if (= PG_CONN nil)
    (throw-error "Connection is not established.")
    (string (PQprotocolVersion PG_CONN))))

;; @syntax (PgSQL:server-version)
;; @return backend server version as string (e.g. "9.1.1")
(define (server-version)
  (if (= PG_CONN nil)
    (throw-error "Connection is not established.")
    (begin
      (regex {(\d+?)(\d\d)(\d\d)$} (string (PQserverVersion PG_CONN)))
      (append $1 "." $2 "." $3))))
	
(context MAIN)


; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; test data base functions
;
; Check PgSQL Test Coverage 
;   Function NOT Tested: PgSQL:clear-result
;   Percent PgSQL Coverage: 96.9

(define (test-pgsql host user passw dbname)
  (unless (PgSQL:connect host user passw dbname)
    (println "PgSQL: couldn't connect 1st try.")
    (exit 0))

  ; clean up in case the previous test failed
  (PgSQL:query "DROP TABLE fruits")

  (unless (PgSQL:connectdb (format {host='%s' user='%s' password='%s' dbname='%s'} (PgSQL:escape host) (PgSQL:escape user) (PgSQL:escape passw) (PgSQL:escape dbname)))
    (println "PgSQL: couldn't connect 2nd try.")
    (exit 0))

  (if (not (PgSQL:NULL? 0))
  	(throw-error "NULL not valid."))
  (if (PgSQL:NULL? 5)
  	(throw-error "NULL not valid."))
  
  (println "\nTest Connection Info Retrieval:")
  (println "    database: " (PgSQL:db))
  (println "        user: " (PgSQL:user))
  (println "        host: " (PgSQL:host))
  (println "        port: " (PgSQL:port))
  (println "     options: " (PgSQL:options))
  (println "   libpq ver: " (PgSQL:lib-version))
  (println "  server ver: " (PgSQL:server-version))
  (println "protocol ver: " (PgSQL:protocol-version))

  (println "\nTest List Databases:")
  (println (join (PgSQL:databases) ", "))
  
  (println "\nTest Create Test Data")
  (PgSQL:query "CREATE TABLE fruits (name varchar, qty int, num serial NOT NULL)")
  
  (set 'test_data (list (list "apples" 11) (list "oranges" 22) (list "bananas" 33) (list "pears" 44)))  
  (println test_data)
  
  (dolist (x test_data)
  	(println "Insert result: " (PgSQL:result-status-str (PgSQL:query "INSERT INTO fruits VALUES ($1, $2)" (nth 0 x) (nth 1 x))) " - " (nth 0 x) ", " (nth 1 x))
  	(let (myCount (PgSQL:affected-rows))
			(if (or (nil? myCount) (zero? myCount))
				(throw-error "Insert did not work."))))
  
  (println "\nTest Inserted into fruits:")
  (setq q "SELECT * FROM fruits ORDER BY name;")
  (setq q-status (PgSQL:query q))
  (println "         select query: " q)

  (println "  select query result: " (PgSQL:result-status-str q-status))
	(if (!= "PGRES_TUPLES_OK" (PgSQL:result-status-str q-status))
		(throw-error "query result not ok."))
		
  (println "        rows returned: " (PgSQL:num-rows))
  (if (!= 4 (PgSQL:num-rows))
  	(throw-error "Wrong number of rows." ))
  	
  (println "     columns returned: " (PgSQL:num-fields))
  (if (!= 3 (PgSQL:num-fields))
  	(throw-error "Wrong number of columns." ))

  (println "  'qty' column number: " (PgSQL:fnumber "qty"))
	(if (!= 1 (PgSQL:fnumber "qty"))
		(throw-error "column number not correct."))
	
  ; gather column names from result
  (set 'column_names (let (x -1)
  										(collect (PgSQL:fname (inc x)) (PgSQL:num-fields))))							
  (println "column names returned: " (join column_names ", "))

  (dotimes (x (PgSQL:num-rows)) (println "                  row: " (PgSQL:fetch-row)))
  (println "   table column names: " (join (PgSQL:fields "fruits") ", "))


  (println "\nTest List Tables:")
  (println (join (PgSQL:tables) ", "))

  (println "\nTest fetch-row and data-seek to offset 2:")
  (PgSQL:query "SELECT * FROM fruits")
  (PgSQL:data-seek 2)
  (println (PgSQL:fetch-row))
  
  (println "\nTest fetch-all:")
  (PgSQL:query "SELECT * FROM fruits")
  (println (PgSQL:fetch-all))

  (println "\nTest Fetching Out of Range Values:")
  (println "invalid data access (row 5, column 5): " (PgSQL:fetch-value 5 5))
  
  ; clean up after DB tests
  (PgSQL:query "DROP TABLE fruits")
  
  (println "\nTest PG Error Retrieval:")
  (PgSQL:query "SELECT * FROM fruittyyyy")
  (println "Should show result error on next line.\n" (PgSQL:error))
  (println "Should show connection error (same as above) on next line.\n" (PgSQL:error-conn))
  
  (println "\nTest Text Escaping:")
  (println "   Check escape literal: " (PgSQL:escape-literal "group's"))
  (println "Check escape identifier: " (PgSQL:escape-identifier "group's"))

  (println "\nTest Query PG Result Conversion to String:")
  (println "result 0: " (PgSQL:result-status-str 0))
  (println "result 1: " (PgSQL:result-status-str 1))
  (println "result 2: " (PgSQL:result-status-str 2))
  (println "result 3: " (PgSQL:result-status-str 3))
  (println "result 4: " (PgSQL:result-status-str 4))
  (println "result 5: " (PgSQL:result-status-str 5))
  (println "result 6: " (PgSQL:result-status-str 6))
  (println "result 7: " (PgSQL:result-status-str 7))
  (println "result 8: " (PgSQL:result-status-str 8))
  (println "result 9: " (PgSQL:result-status-str 9))

  (PgSQL:close-db)
  
	(println)
  (println "Tests Completed.")
	(println)
)

; eof