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
|
;;; utility.lisp -- wrapper functions and macros
;;;
;;; Author: Eric Marsden <emarsden@laas.fr>
;;; Time-stamp: <2006-09-30 emarsden>
(in-package :postgresql)
(defun pg-date-style (conn)
(let ((res (pg-exec conn "SHOW datestyle")))
(first (pg-result res :tuple 0))))
(defun set-pg-date-style (conn new-date-style)
(declare (type simple-string new-date-style))
(pg-exec conn "SET datestyle TO " new-date-style))
(defsetf pg-date-style set-pg-date-style)
;; see http://www.postgresql.org/docs/7.3/static/multibyte.html
(defun pg-client-encoding (conn)
"Return a string identifying the client encoding."
(let ((res (pg-exec conn "SHOW client_encoding")))
(first (pg-result res :tuple 0))))
(defun set-pg-client-encoding (conn new-encoding)
"Set the client_encoding."
(declare (type simple-string new-encoding))
(pg-exec conn "SET client_encoding TO " new-encoding))
(defsetf pg-client-encoding set-pg-client-encoding)
(defmacro with-pg-connection ((con &rest open-args) &body body)
"Bindspec is of the form (connection open-args), where OPEN-ARGS are
as for PG-CONNECT. The database connection is bound to the variable
CONNECTION. If the connection is unsuccessful, the forms are not
evaluated. Otherwise, the BODY forms are executed, and upon
termination, normal or otherwise, the database connection is closed."
(let ((ok (gensym)))
`(let ((,con (pg-connect ,@open-args))
(,ok nil))
(unwind-protect
(multiple-value-prog1
(progn ,@body)
(setf ,ok t))
(when ,con (pg-disconnect ,con :abort (not ,ok)))))))
;; this is the old version
#+(or)
(defmacro with-pg-transaction (con &body body)
"Execute BODY forms in a BEGIN..END block.
If a PostgreSQL error occurs during execution of the forms, execute
a ROLLBACK command.
Large-object manipulations _must_ occur within a transaction, since
the large object descriptors are only valid within the context of a
transaction."
`(progn
(pg-exec ,con "BEGIN WORK")
(handler-case (prog1 (progn ,@body) (pg-exec ,con "COMMIT WORK"))
(error (e)
(pg-exec ,con "ROLLBACK WORK")
(error e)))))
;;; this version thanks to Daniel Barlow. The old version would abort
;;; the transaction before entering the debugger, which made
;;; debugging difficult.
(defmacro with-pg-transaction (con &body body)
"Execute BODY forms in a BEGIN..END block.
If a PostgreSQL error occurs during execution of the forms, execute
a ROLLBACK command.
Large-object manipulations _must_ occur within a transaction, since
the large object descriptors are only valid within the context of a
transaction."
(let ((success (gensym "SUCCESS")))
`(let (,success)
(unwind-protect
(prog2
(pg-exec ,con "BEGIN WORK")
(progn ,@body)
(setf ,success t))
(pg-exec ,con (if ,success "COMMIT WORK" "ROLLBACK WORK"))))))
(defun pg-for-each (conn select-form callback)
"Create a cursor for SELECT-FORM, and call CALLBACK for each result.
Uses the PostgreSQL database connection CONN. SELECT-FORM must be an
SQL SELECT statement. The cursor is created using an SQL DECLARE
CURSOR command, then results are fetched successively until no results
are left. The cursor is then closed.
The work is performed within a transaction. The work can be
interrupted before all tuples have been handled by THROWing to a tag
called 'pg-finished."
(let ((cursor (symbol-name (gensym "PGCURSOR"))))
(catch 'pg-finished
(with-pg-transaction conn
(pg-exec conn "DECLARE " cursor " CURSOR FOR " select-form)
(unwind-protect
(loop :for res = (pg-result (pg-exec conn "FETCH 1 FROM " cursor) :tuples)
:until (zerop (length res))
:do (funcall callback (first res)))
(pg-exec conn "CLOSE " cursor))))))
;; EOF
|
