1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: sqlite-api-uffi.lisp
6 ;;;; Purpose: Low-level SQLite interface using UFFI
7 ;;;; Programmers: Aurelio Bignoli
8 ;;;; Date Started: Nov 2003
10 ;;;; $Id: sqlite-api-uffi.lisp,v 1.5 2004/03/09 20:57:19 aurelio Exp $
12 ;;;; This file, part of CLSQL, is Copyright (c) 2003 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 ;;;; *************************************************************************
18 (declaim (optimize (debug 0) (speed 3) (safety 0) (compilation-speed 0)))
23 (:use :common-lisp :uffi)
28 #:sqlite-error-message
42 #:sqlite-version ; Defined as constant.
43 #:sqlite-encoding ; Defined as constant.
44 #:sqlite-last-insert-rowid
46 ;;; Utility functions.
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-ROW 100 "sqlite_step() has another row ready")
67 (defconstant SQLITE-DONE 101 "sqlite_step() has finished executing")
69 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73 (define-condition sqlite-error ()
74 ((message :initarg :message :reader sqlite-error-message :initform "")
75 (code :initarg :code :reader sqlite-error-code))
76 (:report (lambda (condition stream)
77 (let ((code (sqlite-error-code condition)))
78 (format stream "SQLite error [~A]: ~A"
79 code (sqlite-error-message condition))))))
81 (defun signal-sqlite-error (code &optional message)
83 (make-condition 'sqlite-error
87 (sqlite-error-string code)))))
88 (unless (signal condition)
89 (invoke-debugger condition))))
91 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
93 ;;;; Foreign types definitions.
95 (def-foreign-type sqlite-db :pointer-void)
96 (def-foreign-type sqlite-vm :pointer-void)
97 (def-foreign-type errmsg :cstring)
99 (def-array-pointer string-array-pointer :cstring)
101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103 ;;; Lisp types used in declarations.
105 (def-type sqlite-db-pointer '(* sqlite-db))
106 (def-type sqlite-int-pointer '(* :int))
107 (def-type sqlite-row 'string-array-pointer)
108 (def-type sqlite-row-pointer '(* string-array-pointer))
109 (def-type sqlite-vm-pointer '(* sqlite-vm))
111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
113 ;;;; Library functions.
115 (defmacro def-sqlite-function (name args &key (returning :void))
116 `(def-function ,name ,args
118 :returning ,returning))
121 "sqlite_error_string"
125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 (declaim (inline %open))
131 ("sqlite_open" %open)
134 (error-message '(* errmsg)))
135 :returning sqlite-db)
137 (declaim (inline sqlite-close))
142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
146 (declaim (inline %compile))
148 ("sqlite_compile" %compile)
151 (sql-tail '(* :cstring))
153 (error-message '(* errmsg)))
156 (declaim (inline %step))
158 ("sqlite_step" %step)
161 (cols '(* (* :cstring)))
162 (col-names '(* (* :cstring))))
165 (declaim (inline %finalize))
167 ("sqlite_finalize" %finalize)
169 (error-message '(* errmsg)))
172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
176 (declaim (inline sqlite-last-insert-rowid))
178 "sqlite_last_insert_rowid"
182 (declaim (inline %get-table))
184 ("sqlite_get_table" %get-table)
187 (result '(* (* :cstring)))
190 (error-message '(* errmsg)))
193 (declaim (inline %free-table))
195 ("sqlite_free_table" %free-table)
196 ((rows :pointer-void)))
198 (declaim (inline sqlite-libversion))
204 (declaim (inline sqlite-libencoding))
210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
212 ;;;; Wrapper functions.
214 (defparameter sqlite-version (sqlite-libversion))
215 (defparameter sqlite-encoding (sqlite-libencoding))
217 (defun sqlite-open (db-name &optional (mode 0))
218 (let ((db (%open db-name mode nil)))
219 (declare (type sqlite-db-pointer db))
220 (if (null-pointer-p db)
221 (signal-sqlite-error SQLITE-ERROR
222 (format nil "unable to open ~A" db-name))
225 (defun sqlite-compile (db sql)
226 (declare (type sqlite-db-pointer db))
227 (let ((vm (allocate-foreign-object 'sqlite-vm)))
228 (with-foreign-object (sql-tail :cstring)
229 (let ((result (%compile db sql sql-tail vm nil)))
230 (if (= result SQLITE-OK)
233 (free-foreign-object vm)
234 (signal-sqlite-error result)))))))
236 (defun sqlite-step (vm)
237 (declare (type sqlite-vm-pointer vm))
238 (with-foreign-object (cols-n :int)
239 (let ((cols (allocate-foreign-object '(* :cstring)))
240 (col-names (allocate-foreign-object '(* :cstring))))
241 (declare (type sqlite-row-pointer cols col-names))
242 (let ((result (%step (deref-pointer vm 'sqlite-vm)
243 cols-n cols col-names)))
245 ((= result SQLITE-ROW)
246 (let ((n (deref-pointer cols-n :int)))
247 (values n cols col-names)))
248 ((= result SQLITE-DONE)
249 (free-foreign-object cols)
250 (free-foreign-object col-names)
251 (values 0 (make-null-pointer 'string-array-pointer)
252 (make-null-pointer 'string-array-pointer)))
254 (free-foreign-object cols)
255 (free-foreign-object col-names)
256 (signal-sqlite-error result)))))))
258 (defun sqlite-finalize (vm)
259 (declare (type sqlite-vm-pointer vm))
260 (let ((result (%finalize (deref-pointer vm 'sqlite-vm) nil)))
261 (if (= result SQLITE-OK)
263 (free-foreign-object vm)
265 (signal-sqlite-error result))))
267 (defun sqlite-get-table (db sql)
268 (declare (type sqlite-db-pointer db))
269 (let ((rows (allocate-foreign-object '(* :cstring))))
270 (with-foreign-object (rows-n :int)
271 (with-foreign-object (cols-n :int)
272 (declare (type sqlite-row-pointer rows))
273 (let ((result (%get-table db sql rows rows-n cols-n nil)))
274 (if (= result SQLITE-OK)
275 (let ((cn (deref-pointer cols-n :int))
276 (rn (deref-pointer rows-n :int)))
279 (free-foreign-object rows)
280 (signal-sqlite-error result))))))))
282 (declaim (inline sqlite-free-table))
283 (defun sqlite-free-table (table)
284 (declare (type sqlite-row-pointer table))
285 (%free-table (deref-pointer table 'sqlite-row-pointer)))
287 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
289 ;;;; Utility functions.
291 (declaim (inline make-null-row))
292 (defun make-null-row ()
293 (uffi:make-null-pointer 'string-array-pointer))
295 (declaim (inline make-null-vm))
296 (defun make-null-vm ()
297 (uffi:make-null-pointer 'sqlite-vm))
299 (declaim (inline null-row-p))
300 (defun null-row-p (row)
301 (null-pointer-p row))
303 (declaim (inline sqlite-aref))
304 (defun sqlite-aref (a n)
305 (declare (type sqlite-row-pointer a))
306 (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array :cstring) n))
308 (declaim (inline sqlite-free-row))
309 (defun sqlite-free-row (row)
310 (declare (type sqlite-row-pointer row))
311 (free-foreign-object row))