1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: sqlite3-api.lisp
6 ;;;; Purpose: Low-level SQLite3 interface using UFFI
7 ;;;; Authors: Aurelio Bignoli
12 ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli
14 ;;;; CLSQL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
19 (in-package #:cl-user
)
22 (:use
#:common-lisp
#:uffi
)
27 #:sqlite3-error-message
37 #:sqlite3-column-count
41 #:sqlite3-column-bytes
48 #:unsigned-char-ptr-type
58 (in-package #:sqlite3
)
60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62 ;;;; Return values for sqlite_exec() and sqlite_step()
64 (defconstant SQLITE-OK
0 "Successful result")
65 (defconstant SQLITE-ERROR
1 "SQL error or missing database")
66 (defconstant SQLITE-INTERNAL
2 "An internal logic error in SQLite")
67 (defconstant SQLITE-PERM
3 "Access permission denied")
68 (defconstant SQLITE-ABORT
4 "Callback routine requested an abort")
69 (defconstant SQLITE-BUSY
5 "The database file is locked")
70 (defconstant SQLITE-LOCKED
6 "A table in the database is locked")
71 (defconstant SQLITE-NOMEM
7 "A malloc() failed")
72 (defconstant SQLITE-READONLY
8 "Attempt to write a readonly database")
73 (defconstant SQLITE-INTERRUPT
9 "Operation terminated by sqlite3_interrupt()")
74 (defconstant SQLITE-IOERR
10 "Some kind of disk I/O error occurred")
75 (defconstant SQLITE-CORRUPT
11 "The database disk image is malformed")
76 (defconstant SQLITE-NOTFOUND
12 "(Internal Only) Table or record not found")
77 (defconstant SQLITE-FULL
13 "Insertion failed because database is full")
78 (defconstant SQLITE-CANTOPEN
14 "Unable to open the database file")
79 (defconstant SQLITE-PROTOCOL
15 "Database lock protocol error")
80 (defconstant SQLITE-EMPTY
16 "Database is empty")
81 (defconstant SQLITE-SCHEMA
17 "The database schema changed")
82 (defconstant SQLITE-TOOBIG
18 "Too much data for one row of a table")
83 (defconstant SQLITE-CONSTRAINT
19 "Abort due to contraint violation")
84 (defconstant SQLITE-MISMATCH
20 "Data type mismatch")
85 (defconstant SQLITE-MISUSE
21 "Library used incorrectly")
86 (defconstant SQLITE-NOLFS
22 "Uses OS features not supported on host")
87 (defconstant SQLITE-AUTH
23 "Authorization denied")
88 (defconstant SQLITE-FORMAT
24 "Auxiliary database format error")
89 (defconstant SQLITE-RANGE
25 "2nd parameter to sqlite3_bind out of range")
90 (defconstant SQLITE-NOTADB
26 "File opened that is not a database file")
91 (defconstant SQLITE-ROW
100 "sqlite3_step() has another row ready")
92 (defconstant SQLITE-DONE
101 "sqlite3_step() has finished executing")
94 (defparameter error-codes
96 (cons SQLITE-OK
"not an error")
97 (cons SQLITE-ERROR
"SQL logic error or missing database")
98 (cons SQLITE-INTERNAL
"internal SQLite implementation flaw")
99 (cons SQLITE-PERM
"access permission denied")
100 (cons SQLITE-ABORT
"callback requested query abort")
101 (cons SQLITE-BUSY
"database is locked")
102 (cons SQLITE-LOCKED
"database table is locked")
103 (cons SQLITE-NOMEM
"out of memory")
104 (cons SQLITE-READONLY
"attempt to write a readonly database")
105 (cons SQLITE-INTERRUPT
"interrupted")
106 (cons SQLITE-IOERR
"disk I/O error")
107 (cons SQLITE-CORRUPT
"database disk image is malformed")
108 (cons SQLITE-NOTFOUND
"table or record not found")
109 (cons SQLITE-FULL
"database is full")
110 (cons SQLITE-CANTOPEN
"unable to open database file")
111 (cons SQLITE-PROTOCOL
"database locking protocol failure")
112 (cons SQLITE-EMPTY
"table contains no data")
113 (cons SQLITE-SCHEMA
"database schema has changed")
114 (cons SQLITE-TOOBIG
"too much data for one table row")
115 (cons SQLITE-CONSTRAINT
"constraint failed")
116 (cons SQLITE-MISMATCH
"datatype mismatch")
117 (cons SQLITE-MISUSE
"library routine called out of sequence")
118 (cons SQLITE-NOLFS
"kernel lacks large file support")
119 (cons SQLITE-AUTH
"authorization denied")
120 (cons SQLITE-FORMAT
"auxiliary database format error")
121 (cons SQLITE-RANGE
"bind index out of range")
122 (cons SQLITE-NOTADB
"file is encrypted or is not a database"))
123 "Association list of error messages.")
125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 (defconstant SQLITE-INTEGER
1)
130 (defconstant SQLITE-FLOAT
2)
131 (defconstant SQLITE-TEXT
3)
132 (defconstant SQLITE-BLOB
4)
133 (defconstant SQLITE-NULL
5)
135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
137 ;;;; Foreign types definitions.
139 (def-foreign-type sqlite3-db
:pointer-void
)
140 (def-foreign-type sqlite3-stmt
:pointer-void
)
142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
144 ;;;; Lisp types definitions.
146 (def-type sqlite3-db-type sqlite3-db
)
147 (def-type sqlite3-db-ptr-type
(* sqlite3-db
))
148 (def-type sqlite3-stmt-type sqlite3-stmt
)
149 (def-type sqlite3-stmt-ptr-type
(* sqlite3-stmt
))
150 (def-type unsigned-char-ptr-type
(* :unsigned-char
))
152 (defparameter null-stmt
(make-null-pointer :void
))
154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
156 ;;; Hash tables for db and statement pointers.
158 (defvar *db-pointers
* (make-hash-table))
159 (defvar *stmt-pointers
* (make-hash-table))
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
165 (define-condition sqlite3-error
()
166 ((message :initarg
:message
:reader sqlite3-error-message
:initform
"")
167 (code :initarg
:code
:reader sqlite3-error-code
))
168 (:report
(lambda (condition stream
)
169 (format stream
"Sqlite3 error [~A]: ~A"
170 (sqlite3-error-code condition
)
171 (sqlite3-error-message condition
)))))
173 (defmethod signal-sqlite3-error (db)
175 (make-condition 'sqlite3-error
176 :code
(sqlite3-errcode db
)
177 :message
(convert-from-cstring (sqlite3-errmsg db
)))))
178 (unless (signal condition
)
179 (invoke-debugger condition
))))
181 (defmethod signal-sqlite3-error ((code number
))
183 (make-condition 'sqlite3-error
185 :message
(let ((s (cdr (assoc code error-codes
))))
189 (unless (signal condition
)
190 (invoke-debugger condition
))))
192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
194 ;;;; Library functions.
196 (defmacro def-sqlite3-function
(name args
&key
(returning :void
))
197 `(def-function ,name
,args
199 :returning
,returning
))
201 (declaim (inline %errcode
))
202 (def-sqlite3-function
207 (declaim (inline %errmsg
))
208 (def-sqlite3-function
213 (declaim (inline %open
))
214 (def-sqlite3-function
215 ("sqlite3_open" %open
)
220 (declaim (inline %close
))
221 (def-sqlite3-function
222 ("sqlite3_close" %close
)
226 (declaim (inline %prepare
))
227 (def-sqlite3-function
228 ("sqlite3_prepare" %prepare
)
232 (stmt (* sqlite3-stmt
))
233 (sql-tail (* (* :unsigned-char
))))
236 (declaim (inline %step
))
237 (def-sqlite3-function
238 ("sqlite3_step" %step
)
239 ((stmt sqlite3-stmt
))
242 (declaim (inline %finalize
))
243 (def-sqlite3-function
244 ("sqlite3_finalize" %finalize
)
245 ((stmt sqlite3-stmt
))
248 (declaim (inline sqlite3-column-count
))
249 (def-sqlite3-function
250 "sqlite3_column_count"
251 ((stmt sqlite3-stmt
))
254 (declaim (inline %column-name
))
255 (def-sqlite3-function
256 ("sqlite3_column_name" %column-name
)
261 (declaim (inline sqlite3-column-type
))
262 (def-sqlite3-function
263 "sqlite3_column_type"
268 (declaim (inline sqlite3-column-text
))
269 (def-sqlite3-function
270 "sqlite3_column_text"
273 :returning
(* :unsigned-char
))
275 (declaim (inline sqlite3-column-bytes
))
276 (def-sqlite3-function
277 "sqlite3_column_bytes"
282 (declaim (inline sqlite3-column-blob
))
283 (def-sqlite3-function
284 "sqlite3_column_blob"
287 :returning
:pointer-void
)
289 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
291 ;;;; wrapper functions.
293 (defun sqlite3-open (db-name &optional
(mode 0))
294 (declare (ignore mode
) (type string db-name
))
295 (let ((dbp (allocate-foreign-object 'sqlite3-db
)))
296 (declare (type sqlite3-db-ptr-type dbp
))
297 (with-cstring (db-name-native db-name
)
298 (let ((result (%open db-name-native dbp
)))
301 ;; According to docs, the db must be closed even in case
303 (%close
(deref-pointer dbp
'sqlite3-db
))
304 (free-foreign-object dbp
)
305 (signal-sqlite3-error result
))
306 (let ((db (deref-pointer dbp
'sqlite3-db
)))
307 (declare (type sqlite3-db-type db
))
308 (setf (gethash db
*db-pointers
*) dbp
)
311 (declaim (ftype (function (sqlite3-db-type) t
) sqlite3-close
))
312 (defun sqlite3-close (db)
313 (declare (type sqlite3-db-type db
))
314 (let ((result (%close db
)))
316 (signal-sqlite3-error result
)
318 (free-foreign-object (gethash db
*db-pointers
*))
319 (remhash db
*db-pointers
*)
322 (declaim (ftype (function (sqlite3-db-type string
) sqlite3-stmt-type
) sqlite3-prepare
))
323 (defun sqlite3-prepare (db sql
)
324 (declare (type sqlite3-db-type db
))
325 (with-cstring (sql-native sql
)
326 (let ((stmtp (allocate-foreign-object 'sqlite3-stmt
)))
327 (declare (type sqlite3-stmt-ptr-type stmtp
))
328 (with-foreign-object (sql-tail '(* :unsigned-char
))
329 (let ((result (%prepare db sql-native -
1 stmtp sql-tail
)))
330 (if (/= result SQLITE-OK
)
332 (unless (null-pointer-p stmtp
)
333 ;; There is an error, but a statement has been allocated:
334 ;; finalize it (better safe than sorry).
335 (%finalize
(deref-pointer stmtp
'sqlite3-stmt
)))
336 (free-foreign-object stmtp
)
337 (signal-sqlite3-error db
))
338 (let ((stmt (deref-pointer stmtp
'sqlite3-stmt
)))
339 (declare (type sqlite3-stmt-type stmt
))
340 (setf (gethash stmt
*stmt-pointers
*) stmtp
)
343 (declaim (ftype (function (sqlite3-stmt-type) t
) sqlite3-step
))
344 (defun sqlite3-step (stmt)
345 (declare (type sqlite3-stmt-type stmt
))
346 (let ((result (%step stmt
)))
347 (cond ((= result SQLITE-ROW
) t
)
348 ((= result SQLITE-DONE
) nil
)
349 (t (signal-sqlite3-error result
)))))
351 (declaim (ftype (function (sqlite3-stmt-type) t
) sqlite3-finalize
))
352 (defun sqlite3-finalize (stmt)
353 (declare (type sqlite3-stmt-type stmt
))
354 (let ((result (%finalize stmt
)))
355 (if (/= result SQLITE-OK
)
356 (signal-sqlite3-error result
)
358 (free-foreign-object (gethash stmt
*stmt-pointers
*))
359 (remhash stmt
*stmt-pointers
*)
362 (declaim (inline sqlite3-column-name
))
363 (defun sqlite3-column-name (stmt n
)
364 (declare (type sqlite3-stmt-type stmt
) (type fixnum n
))
365 (convert-from-cstring (%column-name stmt n
)))