db-sqlite3/sqlite3-api.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:     sqlite3-api.lisp
   6 ;;;; Purpose:  Low-level SQLite3 interface using UFFI
   7 ;;;; Authors:  Aurelio Bignoli
   8 ;;;; Created:  Oct 2004
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli
  13 ;;;;
  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
  19 (in-package #:cl-user)
  20
  21 (defpackage #:sqlite3
  22   (:use #:common-lisp #:uffi)
  23     (:export
  24            ;;; Conditions
  25            #:sqlite3-error
  26            #:sqlite3-error-code
  27            #:sqlite3-error-message
  28
  29            ;;; API functions.
  30            #:sqlite3-open
  31            #:sqlite3-close
  32
  33            #:sqlite3-prepare
  34            #:sqlite3-step
  35            #:sqlite3-finalize
  36
  37            #:sqlite3-column-count
  38            #:sqlite3-column-name
  39            #:sqlite3-column-type
  40            #:sqlite3-column-text
  41            #:sqlite3-column-bytes
  42            #:sqlite3-column-blob
  43
  44            ;;; Types.
  45            #:sqlite3-db
  46            #:sqlite3-db-type
  47            #:sqlite3-stmt-type
  48            #:unsigned-char-ptr-type
  49            #:null-stmt
  50
  51            ;;; Columnt types.
  52            #:SQLITE-INTEGER
  53            #:SQLITE-FLOAT
  54            #:SQLITE-TEXT
  55            #:SQLITE-BLOB
  56            #:SQLITE-NULL))
  57
  58 (in-package #:sqlite3)
  59
  60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  61 ;;;;
  62 ;;;; Return values for sqlite_exec() and sqlite_step()
  63 ;;;;
  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")
  93
  94 (defparameter error-codes
  95   (list
  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.")
 124
 125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 126 ;;;;
 127 ;;;; Column types.
 128 ;;;;
 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)
 134
 135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 136 ;;;;
 137 ;;;; Foreign types definitions.
 138 ;;;;
 139 (def-foreign-type sqlite3-db :pointer-void)
 140 (def-foreign-type sqlite3-stmt :pointer-void)
 141
 142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 143 ;;;;
 144 ;;;; Lisp types definitions.
 145 ;;;;
 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))
 151
 152 (defparameter null-stmt (make-null-pointer :void))
 153
 154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 155 ;;;
 156 ;;; Hash tables for db and statement pointers.
 157 ;;;
 158 (defvar *db-pointers* (make-hash-table))
 159 (defvar *stmt-pointers* (make-hash-table))
 160
 161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 162 ;;;;
 163 ;;;; Conditions.
 164 ;;;;
 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)))))
 172
 173 (defgeneric signal-sqlite3-error (db))
 174 (defmethod signal-sqlite3-error (db)
 175   (let ((condition
 176          (make-condition 'sqlite3-error
 177                          :code (sqlite3-errcode db)
 178                          :message (convert-from-cstring (sqlite3-errmsg db)))))
 179     (unless (signal condition)
 180       (invoke-debugger condition))))
 181
 182 (defmethod signal-sqlite3-error ((code number))
 183   (let ((condition
 184          (make-condition 'sqlite3-error
 185                          :code code
 186                          :message (let ((s (cdr (assoc code error-codes))))
 187                                     (if s
 188                                         s
 189                                         "unknown error")))))
 190     (unless (signal condition)
 191       (invoke-debugger condition))))
 192
 193 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 194 ;;;;
 195 ;;;; Library functions.
 196 ;;;;
 197 (defmacro def-sqlite3-function (name args &key (returning :void))
 198   `(def-function ,name ,args
 199     :module "sqlite3"
 200     :returning ,returning))
 201
 202 (declaim (inline %errcode))
 203 (def-sqlite3-function
 204     "sqlite3_errcode"
 205     ((db sqlite3-db))
 206   :returning :int)
 207
 208 (declaim (inline %errmsg))
 209 (def-sqlite3-function
 210     "sqlite3_errmsg"
 211     ((db sqlite3-db))
 212   :returning :cstring)
 213
 214 (declaim (inline %open))
 215 (def-sqlite3-function
 216     ("sqlite3_open" %open)
 217     ((dbname :cstring)
 218      (db (* sqlite3-db)))
 219   :returning :int)
 220
 221 (declaim (inline %close))
 222 (def-sqlite3-function
 223     ("sqlite3_close" %close)
 224     ((db sqlite3-db))
 225   :returning :int)
 226
 227 (declaim (inline %prepare))
 228 (def-sqlite3-function
 229     ("sqlite3_prepare" %prepare)
 230     ((db sqlite3-db)
 231      (sql :cstring)
 232      (len :int)
 233      (stmt (* sqlite3-stmt))
 234      (sql-tail (* (* :unsigned-char))))
 235   :returning :int)
 236
 237 (declaim (inline %step))
 238 (def-sqlite3-function
 239     ("sqlite3_step" %step)
 240     ((stmt sqlite3-stmt))
 241   :returning :int)
 242
 243 (declaim (inline %finalize))
 244 (def-sqlite3-function
 245     ("sqlite3_finalize" %finalize)
 246     ((stmt sqlite3-stmt))
 247   :returning :int)
 248
 249 (declaim (inline sqlite3-column-count))
 250 (def-sqlite3-function
 251     "sqlite3_column_count"
 252     ((stmt sqlite3-stmt))
 253   :returning :int)
 254
 255 (declaim (inline %column-name))
 256 (def-sqlite3-function
 257     ("sqlite3_column_name" %column-name)
 258     ((stmt sqlite3-stmt)
 259      (n-col :int))
 260   :returning :cstring)
 261
 262 (declaim (inline sqlite3-column-type))
 263 (def-sqlite3-function
 264     "sqlite3_column_type"
 265     ((stmt sqlite3-stmt)
 266      (n-col :int))
 267   :returning :int)
 268
 269 (declaim (inline sqlite3-column-text))
 270 (def-sqlite3-function
 271     "sqlite3_column_text"
 272     ((stmt sqlite3-stmt)
 273      (n-col :int))
 274   :returning (* :unsigned-char))
 275
 276 (declaim (inline sqlite3-column-bytes))
 277 (def-sqlite3-function
 278     "sqlite3_column_bytes"
 279     ((stmt sqlite3-stmt)
 280      (n-col :int))
 281   :returning :int)
 282
 283 (declaim (inline sqlite3-column-blob))
 284 (def-sqlite3-function
 285     "sqlite3_column_blob"
 286     ((stmt sqlite3-stmt)
 287      (n-col :int))
 288   :returning :pointer-void)
 289
 290 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 291 ;;;;
 292 ;;;; wrapper functions.
 293 ;;;;
 294 (defun sqlite3-open (db-name &optional (mode 0))
 295   (declare (ignore mode) (type string db-name))
 296   (let ((dbp (allocate-foreign-object 'sqlite3-db)))
 297     (declare (type sqlite3-db-ptr-type dbp))
 298     (with-cstring (db-name-native db-name)
 299       (let ((result (%open db-name-native dbp)))
 300         (if (/=  result 0)
 301             (progn
 302               ;; According to docs, the db must be closed even in case
 303               ;; of error.
 304               (%close (deref-pointer dbp 'sqlite3-db))
 305               (free-foreign-object dbp)
 306               (signal-sqlite3-error result))
 307             (let ((db (deref-pointer dbp 'sqlite3-db)))
 308               (declare (type sqlite3-db-type db))
 309               (setf (gethash db *db-pointers*) dbp)
 310               db))))))
 311
 312 (declaim (ftype (function (sqlite3-db-type) t) sqlite3-close))
 313 (defun sqlite3-close (db)
 314   (declare (type sqlite3-db-type db))
 315   (let ((result (%close db)))
 316     (if (/= result 0)
 317         (signal-sqlite3-error result)
 318         (progn
 319           (free-foreign-object (gethash db *db-pointers*))
 320           (remhash db *db-pointers*)
 321           t))))
 322
 323 (declaim (ftype (function (sqlite3-db-type string) sqlite3-stmt-type) sqlite3-prepare))
 324 (defun sqlite3-prepare (db sql)
 325   (declare (type sqlite3-db-type db))
 326   (with-cstring (sql-native sql)
 327     (let ((stmtp (allocate-foreign-object 'sqlite3-stmt)))
 328       (declare (type sqlite3-stmt-ptr-type stmtp))
 329       (with-foreign-object (sql-tail '(* :unsigned-char))
 330         (let ((result (%prepare db sql-native -1 stmtp sql-tail)))
 331           (if (/= result SQLITE-OK)
 332               (progn
 333                 (unless (null-pointer-p stmtp)
 334                   ;; There is an error, but a statement has been allocated:
 335                   ;; finalize it (better safe than sorry).
 336                   (%finalize (deref-pointer stmtp 'sqlite3-stmt)))
 337                 (free-foreign-object stmtp)
 338                 (signal-sqlite3-error db))
 339               (let ((stmt (deref-pointer stmtp 'sqlite3-stmt)))
 340                 (declare (type sqlite3-stmt-type stmt))
 341                 (setf (gethash stmt *stmt-pointers*) stmtp)
 342                 stmt)))))))
 343
 344 (declaim (ftype (function (sqlite3-stmt-type) t) sqlite3-step))
 345 (defun sqlite3-step (stmt)
 346   (declare (type sqlite3-stmt-type stmt))
 347   (let ((result (%step stmt)))
 348     (cond ((= result SQLITE-ROW) t)
 349           ((= result SQLITE-DONE) nil)
 350           (t (signal-sqlite3-error result)))))
 351
 352 (declaim (ftype (function (sqlite3-stmt-type) t) sqlite3-finalize))
 353 (defun sqlite3-finalize (stmt)
 354   (declare (type sqlite3-stmt-type stmt))
 355   (let ((result (%finalize  stmt)))
 356     (if (/= result SQLITE-OK)
 357         (signal-sqlite3-error result)
 358         (progn
 359           (free-foreign-object (gethash stmt *stmt-pointers*))
 360           (remhash stmt *stmt-pointers*)
 361           t))))
 362
 363 (declaim (inline sqlite3-column-name))
 364 (defun sqlite3-column-name (stmt n)
 365   (declare (type sqlite3-stmt-type stmt) (type fixnum n))
 366   (convert-from-cstring (%column-name stmt n)))