File: test.tst

package info (click to toggle)
clisp 1%3A2.49-8.1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 45,160 kB
  • sloc: lisp: 79,960; ansic: 48,257; xml: 26,814; sh: 12,846; fortran: 7,286; makefile: 1,456; perl: 164
file content (130 lines) | stat: -rw-r--r-- 4,983 bytes parent folder | download
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
;; -*- Lisp -*- vim:filetype=lisp
;; tests for PostGreSQL
;; clisp -E 1:1 -q -norc -i ../tests/tests -x '(run-test "postgresql/test")'

(list (require "postgresql")) (#-POSTGRESQL T #+POSTGRESQL NIL)
(listp (show (multiple-value-list (ext:module-info "postgresql" t)) :pretty t)) T

;;; Based on the examples distributed with PostgreSQL (man libpq)

;;; == Troubleshooting:
;;; ** if you get "could not connect to server:"
;;; # service postgresql initdb
;;; # service postgresql start
;;; ** if you get "FATAL:  Ident authentication failed for user \"postgres\""
;;; 1. edit /var/lib/pgsql/data/pg_hba.conf and make sure that METHOD for
;;;    "local" is "trust"
;;; 2. sudo -u postgres psql
;;;    # alter user postgres set password 'postgres'
;;; 3. service postgresql restart
;;; ** if you get "FATAL: database \"postgres\" does not exist":
;;; $ createdb -U postgres postgres

(defparameter *trace* (os:fopen "postgres.log" "w")) *trace*

(sql:with-sql-connection (conn :name "template1" :log *standard-output*)
  (sql:PQtrace conn *trace*)
  (sql:sql-transaction conn "BEGIN" sql:PGRES_COMMAND_OK)
  ;; fetch instances from the pg_database, the system catalog of databases
  (sql:sql-transaction
   conn "DECLARE mycursor CURSOR FOR select * from pg_database"
   sql:PGRES_COMMAND_OK)
  ;; FETCH ALL
  (sql:with-sql-transaction
      (res conn "FETCH ALL in mycursor" sql:PGRES_TUPLES_OK)
    (let* ((nfields (sql:PQnfields res)) (ntuples (sql:PQntuples res))
           (names (make-array nfields)))
      (format t " + ~D field~:P; ~D ntuple~:P~%" nfields ntuples)
      ;; first, print out the attribute names
      (dotimes (ii nfields)
        (format t "~3:D: ~S~%" ii
                (setf (aref names ii) (sql:PQfname res ii))))
      ;; next, print out the instances
      (dotimes (ii ntuples)
        (format t "~%<<~D>>~%" ii)
        (dotimes (jj nfields (terpri))
          (format t "~3:D ~15@S = ~S~%"
                  jj (aref names jj) (sql:PQgetvalue res ii jj))))))
  ;; close the cursor
  (sql:sql-transaction conn "CLOSE mycursor" sql:PGRES_COMMAND_OK)
  ;; commit the transaction
  (sql:sql-transaction conn "COMMIT" sql:PGRES_COMMAND_OK)
  (sql:PQuntrace conn)
  NIL)
NIL

(os:fclose *trace*) NIL
(integerp (show (finish-file "postgres.log"))) T

;;;
;;; asynchronous notification interface
;;;
;;; populate a database with the following:
;;; CREATE TABLE TBL1 (i int4);
;;; CREATE TABLE TBL2 (i int4);
;;; CREATE RULE r1 AS ON INSERT TO TBL1 DO INSERT INTO TBL2 values (new.i); NOTIFY TBL2;
;;;
;;;  Then start up this program
;;;  After the program has begun, do
;;; INSERT INTO TBL1 values (10);

#+(or)
(sql:with-sql-connection (conn :log *standard-output*)
  (sql:sql-transaction conn "LISTEN TBL2" sql:PGRES_COMMAND_OK)
  (loop (sql:PQconsumeInput conn)
    (loop :for notify = (sql:PQnotifies conn)
      :while notify :do (format t "ASYNC NOTIFY: ~a~%" notify)
      (break))
    (sleep 1)))

;;;
;;; test the binary cursor interface
;;;
;;; *** this is not supported by CLISP at the moment:
;;; *** need to include /usr/include/pgsql/server/utils/geo_decls.h
;;;
;;; populate a database by doing the following:
;;;
;;;       CREATE TABLE test1 (i int4, d float4, p polygon);
;;;
;;;       INSERT INTO test1 values (1, 3.567, '(3.0, 4.0, 1.0, 2.0)'::polygon);
;;;
;;;       INSERT INTO test1 values (2, 89.05, '(4.0, 3.0, 2.0, 1.0)'::polygon);
;;;
;;;        the expected output is:
;;;
;;;       tuple 0: got
;;;        i = (4 bytes) 1,
;;;        d = (4 bytes) 3.567000,
;;;        p = (4 bytes) 2 points         boundbox = (hi=3.000000/4.000000, lo = 1.000000,2.000000)
;;;       tuple 1: got
;;;        i = (4 bytes) 2,
;;;        d = (4 bytes) 89.050003,
;;;        p = (4 bytes) 2 points         boundbox = (hi=4.000000/3.000000, lo = 2.000000,1.000000)
;;;

#+(or)
(sql:with-sql-connection (conn :log *standard-output*)
  (sql:sql-transaction conn "BEGIN" sql:PGRES_COMMAND_OK)
  (sql:sql-transaction
   conn "DECLARE mycursor BINARY CURSOR FOR select * from test1"
   sql:PGRES_COMMAND_OK)
  (sql:with-sql-transaction
      (res conn "FETCH ALL in mycursor" sql:PGRES_TUPLES_OK)
    (let ((i-fnum (sql:PQfnumber res "i"))
          (d-fnum (sql:PQfnumber res "d"))
          (p-fnum (sql:PQfnumber res "p"))
          (nfields (sql:PQnfields res))
          (ntuples (sql:PQntuples res)))
      (format t " + ~d fields; ~d ntuples; i: ~d; d: ~d; p: ~d~%"
              nfields ntuples i-fnum d-fnum p-fnum)
      (dotimes (ii 3)
        (format t "type[~d] = ~d, size[~d] = ~d~%"
                ii (sql:PQftype res ii) ii (sql:PQfsize res ii)))
      (dotimes (ii ntuples)
        (let ((plen (sql:PQgetlength res ii p-fnum))
              (ival (sql:PQgetvalue res ii i-fnum))
              (dval (sql:PQgetvalue res ii d-fnum)))
          (format t " ++ plen: ~d; ival: ~d; dval: ~f~%" plen ival dval)))))
  (sql:sql-transaction conn "CLOSE mycursor" sql:PGRES_COMMAND_OK)
  (sql:sql-transaction conn "COMMIT" sql:PGRES_COMMAND_OK))