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 and Kevin Rosenberg
8 ;;;; Date Started: Nov 2003
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 ;;;; *************************************************************************
19 (in-package #:cl-user)
22 (:use #:common-lisp #:uffi)
27 #:sqlite-error-message
41 #:sqlite-version ; Defined as constant.
42 #:sqlite-encoding ; Defined as constant.
43 #:sqlite-last-insert-rowid
45 ;;; Utility functions.
59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
61 ;;;; Return values for sqlite_exec() and sqlite_step()
63 (defconstant SQLITE-OK 0 "Successful result")
64 (defconstant SQLITE-ERROR 1 "SQL error or missing database")
65 (defconstant SQLITE-ROW 100 "sqlite_step() has another row ready")
66 (defconstant SQLITE-DONE 101 "sqlite_step() has finished executing")
68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
72 (define-condition sqlite-error ()
73 ((message :initarg :message :reader sqlite-error-message :initform "")
74 (code :initarg :code :reader sqlite-error-code))
75 (:report (lambda (condition stream)
76 (let ((code (sqlite-error-code condition)))
77 (format stream "SQLite error [~A]: ~A"
78 code (sqlite-error-message condition))))))
80 (defun signal-sqlite-error (code &optional message)
82 (make-condition 'sqlite-error
86 (sqlite-error-string code)))))
87 (unless (signal condition)
88 (invoke-debugger condition))))
90 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92 ;;;; Foreign types definitions.
94 (def-foreign-type errmsg (* :char))
95 (def-foreign-type sqlite-db :pointer-void)
96 (def-foreign-type sqlite-vm :pointer-void)
97 (def-foreign-type string-pointer (* (* :char)))
98 (def-foreign-type sqlite-row-pointer (* string-pointer))
100 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
102 ;;; Lisp types used in declarations.
104 (def-type sqlite-db sqlite-db)
105 (def-type sqlite-row string-pointer)
106 (def-type sqlite-row-pointer-type (* string-pointer))
107 (def-type sqlite-vm-pointer (* sqlite-vm))
109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111 ;;;; Library functions.
113 (defmacro def-sqlite-function (name args &key (returning :void))
114 `(def-function ,name ,args
116 :returning ,returning))
119 "sqlite_error_string"
123 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
127 (declaim (inline %open))
129 ("sqlite_open" %open)
132 (error-message (* errmsg)))
133 :returning sqlite-db)
135 (declaim (inline sqlite-close))
140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
144 (declaim (inline %compile))
146 ("sqlite_compile" %compile)
149 (sql-tail (* (* :char)))
151 (error-message (* errmsg)))
154 (declaim (inline %step))
156 ("sqlite_step" %step)
159 (cols (* (* (* :char))))
160 (col-names (* (* (* :char)))))
163 (declaim (inline %finalize))
165 ("sqlite_finalize" %finalize)
167 (error-message (* errmsg)))
170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
174 (declaim (inline sqlite-last-insert-rowid))
176 "sqlite_last_insert_rowid"
180 (declaim (inline %get-table))
182 ("sqlite_get_table" %get-table)
185 (result (* (* (* :char))))
188 (error-message (* errmsg)))
191 (declaim (inline %free-table))
193 ("sqlite_free_table" %free-table)
194 ((rows :pointer-void)))
196 (declaim (inline sqlite-libversion))
202 (declaim (inline sqlite-libencoding))
208 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
210 ;;;; Wrapper functions.
212 (defparameter sqlite-version (sqlite-libversion))
213 (defparameter sqlite-encoding (sqlite-libencoding))
215 (defun sqlite-open (db-name &optional (mode 0))
216 (with-cstring (db-name-native db-name)
217 (let ((db (%open db-name-native mode nil)))
218 (if (null-pointer-p db)
219 (signal-sqlite-error SQLITE-ERROR
220 (format nil "unable to open ~A" db-name))
223 (defun sqlite-compile (db sql)
224 (with-cstring (sql-native sql)
225 (let ((vm (allocate-foreign-object 'sqlite-vm)))
226 (with-foreign-object (sql-tail '(* :char))
227 (let ((result (%compile db sql-native sql-tail vm nil)))
228 (if (= result SQLITE-OK)
231 (free-foreign-object vm)
232 (signal-sqlite-error result))))))))
234 (defun sqlite-step (vm)
235 (declare (type sqlite-vm-pointer vm))
236 (with-foreign-object (cols-n :int)
237 (let ((cols (allocate-foreign-object '(* (* :char))))
238 (col-names (allocate-foreign-object '(* (* :char)))))
239 (declare (type sqlite-row-pointer-type cols col-names))
240 (let ((result (%step (deref-pointer vm 'sqlite-vm)
241 cols-n cols col-names)))
243 ((= result SQLITE-ROW)
244 (let ((n (deref-pointer cols-n :int)))
245 (values n cols col-names)))
246 ((= result SQLITE-DONE)
247 (free-foreign-object cols)
248 (free-foreign-object col-names)
249 (values 0 (make-null-pointer 'string-pointer)
250 (make-null-pointer 'string-pointer)))
252 (free-foreign-object cols)
253 (free-foreign-object col-names)
254 (signal-sqlite-error result)))))))
256 (defun sqlite-finalize (vm)
257 (declare (type sqlite-vm-pointer vm))
258 (let ((result (%finalize (deref-pointer vm 'sqlite-vm) nil)))
259 (if (= result SQLITE-OK)
261 (free-foreign-object vm)
263 (signal-sqlite-error result))))
265 (defun sqlite-get-table (db sql)
266 (declare (type sqlite-db db))
267 (with-cstring (sql-native sql)
268 (let ((rows (allocate-foreign-object '(* (* :char)))))
269 (declare (type sqlite-row-pointer-type rows))
270 (with-foreign-object (rows-n :int)
271 (with-foreign-object (cols-n :int)
272 (let ((result (%get-table db sql-native rows rows-n cols-n nil)))
273 (if (= result SQLITE-OK)
274 (let ((cn (deref-pointer cols-n :int))
275 (rn (deref-pointer rows-n :int)))
278 (free-foreign-object rows)
279 (signal-sqlite-error result)))))))))
281 (declaim (inline sqlite-free-table))
282 (defun sqlite-free-table (table)
283 (declare (type sqlite-row-pointer-type table))
284 (%free-table (deref-pointer table 'sqlite-row-pointer)))
286 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
288 ;;;; Utility functions.
290 (declaim (inline make-null-row))
291 (defun make-null-row ()
292 (uffi:make-null-pointer 'string-pointer))
294 (declaim (inline make-null-vm))
295 (defun make-null-vm ()
296 (uffi:make-null-pointer 'sqlite-vm))
298 (declaim (inline null-row-p))
299 (defun null-row-p (row)
300 (null-pointer-p row))
302 (declaim (inline sqlite-aref))
303 (defun sqlite-aref (a n)
304 (declare (type sqlite-row-pointer-type a))
305 (convert-from-foreign-string (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array :char) n)))
307 (declaim (inline sqlite-free-row))
308 (defun sqlite-free-row (row)
309 (declare (type sqlite-row-pointer-type row))
310 (free-foreign-object row))