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 ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli
  11 ;;;;
  12 ;;;; CLSQL users are granted the rights to distribute and use this software
  13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  15 ;;;; *************************************************************************
  16
  17 (in-package #:cl-user)
  18
  19 (defpackage #:sqlite3
  20   (:use #:common-lisp #:uffi)
  21     (:export
  22            ;;; Conditions
  23            #:sqlite3-error
  24            #:sqlite3-error-code
  25            #:sqlite3-error-message
  26
  27            ;;; API functions.
  28            #:sqlite3-open
  29            #:sqlite3-close
  30
  31            #:sqlite3-prepare
  32            #:sqlite3-step
  33            #:sqlite3-finalize
  34
  35            #:sqlite3-column-count
  36            #:sqlite3-column-name
  37            #:sqlite3-column-type
  38            #:sqlite3-column-text
  39            #:sqlite3-column-bytes
  40            #:sqlite3-column-blob
  41
  42            ;;; Types.
  43            #:sqlite3-db
  44            #:sqlite3-db-type
  45            #:sqlite3-stmt-type
  46            #:unsigned-char-ptr-type
  47            #:null-stmt
  48
  49            ;;; Columnt types.
  50            #:SQLITE-INTEGER
  51            #:SQLITE-FLOAT
  52            #:SQLITE-TEXT
  53            #:SQLITE-BLOB
  54            #:SQLITE-NULL))
  55
  56 (in-package #:sqlite3)
  57
  58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  59 ;;;;
  60 ;;;; Return values for sqlite_exec() and sqlite_step()
  61 ;;;;
  62 (defconstant SQLITE-OK           0   "Successful result")
  63 (defconstant SQLITE-ERROR        1   "SQL error or missing database")
  64 (defconstant SQLITE-INTERNAL     2   "An internal logic error in SQLite")
  65 (defconstant SQLITE-PERM         3   "Access permission denied")
  66 (defconstant SQLITE-ABORT        4   "Callback routine requested an abort")
  67 (defconstant SQLITE-BUSY         5   "The database file is locked")
  68 (defconstant SQLITE-LOCKED       6   "A table in the database is locked")
  69 (defconstant SQLITE-NOMEM        7   "A malloc() failed")
  70 (defconstant SQLITE-READONLY     8   "Attempt to write a readonly database")
  71 (defconstant SQLITE-INTERRUPT    9   "Operation terminated by sqlite3_interrupt()")
  72 (defconstant SQLITE-IOERR       10   "Some kind of disk I/O error occurred")
  73 (defconstant SQLITE-CORRUPT     11   "The database disk image is malformed")
  74 (defconstant SQLITE-NOTFOUND    12   "(Internal Only) Table or record not found")
  75 (defconstant SQLITE-FULL        13   "Insertion failed because database is full")
  76 (defconstant SQLITE-CANTOPEN    14   "Unable to open the database file")
  77 (defconstant SQLITE-PROTOCOL    15   "Database lock protocol error")
  78 (defconstant SQLITE-EMPTY       16   "Database is empty")
  79 (defconstant SQLITE-SCHEMA      17   "The database schema changed")
  80 (defconstant SQLITE-TOOBIG      18   "Too much data for one row of a table")
  81 (defconstant SQLITE-CONSTRAINT  19   "Abort due to contraint violation")
  82 (defconstant SQLITE-MISMATCH    20   "Data type mismatch")
  83 (defconstant SQLITE-MISUSE      21   "Library used incorrectly")
  84 (defconstant SQLITE-NOLFS       22   "Uses OS features not supported on host")
  85 (defconstant SQLITE-AUTH        23   "Authorization denied")
  86 (defconstant SQLITE-FORMAT      24   "Auxiliary database format error")
  87 (defconstant SQLITE-RANGE       25   "2nd parameter to sqlite3_bind out of range")
  88 (defconstant SQLITE-NOTADB      26   "File opened that is not a database file")
  89 (defconstant SQLITE-ROW         100  "sqlite3_step() has another row ready")
  90 (defconstant SQLITE-DONE        101  "sqlite3_step() has finished executing")
  91
  92 (defparameter error-codes
  93   (list
  94    (cons SQLITE-OK "not an error")
  95    (cons SQLITE-ERROR "SQL logic error or missing database")
  96    (cons SQLITE-INTERNAL "internal SQLite implementation flaw")
  97    (cons SQLITE-PERM "access permission denied")
  98    (cons SQLITE-ABORT "callback requested query abort")
  99    (cons SQLITE-BUSY "database is locked")
 100    (cons SQLITE-LOCKED "database table is locked")
 101    (cons SQLITE-NOMEM "out of memory")
 102    (cons SQLITE-READONLY "attempt to write a readonly database")
 103    (cons SQLITE-INTERRUPT "interrupted")
 104    (cons SQLITE-IOERR "disk I/O error")
 105    (cons SQLITE-CORRUPT "database disk image is malformed")
 106    (cons SQLITE-NOTFOUND "table or record not found")
 107    (cons SQLITE-FULL "database is full")
 108    (cons SQLITE-CANTOPEN "unable to open database file")
 109    (cons SQLITE-PROTOCOL "database locking protocol failure")
 110    (cons SQLITE-EMPTY "table contains no data")
 111    (cons SQLITE-SCHEMA "database schema has changed")
 112    (cons SQLITE-TOOBIG "too much data for one table row")
 113    (cons SQLITE-CONSTRAINT "constraint failed")
 114    (cons SQLITE-MISMATCH "datatype mismatch")
 115    (cons SQLITE-MISUSE "library routine called out of sequence")
 116    (cons SQLITE-NOLFS "kernel lacks large file support")
 117    (cons SQLITE-AUTH "authorization denied")
 118    (cons SQLITE-FORMAT "auxiliary database format error")
 119    (cons SQLITE-RANGE "bind index out of range")
 120    (cons SQLITE-NOTADB "file is encrypted or is not a database"))
 121   "Association list of error messages.")
 122
 123 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 124 ;;;;
 125 ;;;; Column types.
 126 ;;;;
 127 (defconstant SQLITE-INTEGER  1)
 128 (defconstant SQLITE-FLOAT    2)
 129 (defconstant SQLITE-TEXT     3)
 130 (defconstant SQLITE-BLOB     4)
 131 (defconstant SQLITE-NULL     5)
 132
 133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 134 ;;;;
 135 ;;;; Foreign types definitions.
 136 ;;;;
 137 (def-foreign-type sqlite3-db :pointer-void)
 138 (def-foreign-type sqlite3-stmt :pointer-void)
 139
 140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 141 ;;;;
 142 ;;;; Lisp types definitions.
 143 ;;;;
 144 (def-type sqlite3-db-type sqlite3-db)
 145 (def-type sqlite3-db-ptr-type (* sqlite3-db))
 146 (def-type sqlite3-stmt-type sqlite3-stmt)
 147 (def-type sqlite3-stmt-ptr-type (* sqlite3-stmt))
 148 (def-type unsigned-char-ptr-type (* :unsigned-char))
 149
 150 (defparameter null-stmt (make-null-pointer :void))
 151
 152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 153 ;;;
 154 ;;; Hash tables for db and statement pointers.
 155 ;;;
 156 (defvar *db-pointers* (make-hash-table))
 157 (defvar *stmt-pointers* (make-hash-table))
 158
 159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 160 ;;;;
 161 ;;;; Conditions.
 162 ;;;;
 163 (define-condition sqlite3-error ()
 164   ((message :initarg :message :reader sqlite3-error-message :initform "")
 165    (code :initarg :code :reader sqlite3-error-code))
 166   (:report (lambda (condition stream)
 167              (format stream "Sqlite3 error [~A]: ~A"
 168                      (sqlite3-error-code condition)
 169                      (sqlite3-error-message condition)))))
 170
 171 (defgeneric signal-sqlite3-error (db))
 172 (defmethod signal-sqlite3-error (db)
 173   (let ((condition
 174          (make-condition 'sqlite3-error
 175                          :code (sqlite3-errcode db)
 176                          :message (convert-from-cstring (sqlite3-errmsg db)))))
 177     (unless (signal condition)
 178       (invoke-debugger condition))))
 179
 180 (defmethod signal-sqlite3-error ((code number))
 181   (let ((condition
 182          (make-condition 'sqlite3-error
 183                          :code code
 184                          :message (let ((s (cdr (assoc code error-codes))))
 185                                     (if s
 186                                         s
 187                                         "unknown error")))))
 188     (unless (signal condition)
 189       (invoke-debugger condition))))
 190
 191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 192 ;;;;
 193 ;;;; Library functions.
 194 ;;;;
 195 (defmacro def-sqlite3-function (name args &key (returning :void))
 196   `(def-function ,name ,args
 197     :module "sqlite3"
 198     :returning ,returning))
 199
 200 (declaim (inline %errcode))
 201 (def-sqlite3-function
 202     "sqlite3_errcode"
 203     ((db sqlite3-db))
 204   :returning :int)
 205
 206 (declaim (inline %errmsg))
 207 (def-sqlite3-function
 208     "sqlite3_errmsg"
 209     ((db sqlite3-db))
 210   :returning :cstring)
 211
 212 (declaim (inline %open))
 213 (def-sqlite3-function
 214     ("sqlite3_open" %open)
 215     ((dbname :cstring)
 216      (db (* sqlite3-db)))
 217   :returning :int)
 218
 219 (declaim (inline %close))
 220 (def-sqlite3-function
 221     ("sqlite3_close" %close)
 222     ((db sqlite3-db))
 223   :returning :int)
 224
 225 (declaim (inline %prepare))
 226 (def-sqlite3-function
 227     ("sqlite3_prepare" %prepare)
 228     ((db sqlite3-db)
 229      (sql :cstring)
 230      (len :int)
 231      (stmt (* sqlite3-stmt))
 232      (sql-tail (* (* :unsigned-char))))
 233   :returning :int)
 234
 235 (declaim (inline %step))
 236 (def-sqlite3-function
 237     ("sqlite3_step" %step)
 238     ((stmt sqlite3-stmt))
 239   :returning :int)
 240
 241 (declaim (inline %finalize))
 242 (def-sqlite3-function
 243     ("sqlite3_finalize" %finalize)
 244     ((stmt sqlite3-stmt))
 245   :returning :int)
 246
 247 (declaim (inline sqlite3-column-count))
 248 (def-sqlite3-function
 249     "sqlite3_column_count"
 250     ((stmt sqlite3-stmt))
 251   :returning :int)
 252
 253 (declaim (inline %column-name))
 254 (def-sqlite3-function
 255     ("sqlite3_column_name" %column-name)
 256     ((stmt sqlite3-stmt)
 257      (n-col :int))
 258   :returning :cstring)
 259
 260 (declaim (inline sqlite3-column-type))
 261 (def-sqlite3-function
 262     "sqlite3_column_type"
 263     ((stmt sqlite3-stmt)
 264      (n-col :int))
 265   :returning :int)
 266
 267 (declaim (inline sqlite3-column-text))
 268 (def-sqlite3-function
 269     "sqlite3_column_text"
 270     ((stmt sqlite3-stmt)
 271      (n-col :int))
 272   :returning (* :unsigned-char))
 273
 274 (declaim (inline sqlite3-column-bytes))
 275 (def-sqlite3-function
 276     "sqlite3_column_bytes"
 277     ((stmt sqlite3-stmt)
 278      (n-col :int))
 279   :returning :int)
 280
 281 (declaim (inline sqlite3-column-blob))
 282 (def-sqlite3-function
 283     "sqlite3_column_blob"
 284     ((stmt sqlite3-stmt)
 285      (n-col :int))
 286   :returning :pointer-void)
 287
 288 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 289 ;;;;
 290 ;;;; wrapper functions.
 291 ;;;;
 292 (defun sqlite3-open (db-name &optional (mode 0))
 293   (declare (ignore mode) (type string db-name))
 294   (let ((dbp (allocate-foreign-object 'sqlite3-db)))
 295     (declare (type sqlite3-db-ptr-type dbp))
 296     (with-cstring (db-name-native db-name)
 297       (let ((result (%open db-name-native dbp)))
 298         (if (/=  result 0)
 299             (progn
 300               ;; According to docs, the db must be closed even in case
 301               ;; of error.
 302               (%close (deref-pointer dbp 'sqlite3-db))
 303               (free-foreign-object dbp)
 304               (signal-sqlite3-error result))
 305             (let ((db (deref-pointer dbp 'sqlite3-db)))
 306               (declare (type sqlite3-db-type db))
 307               (setf (gethash db *db-pointers*) dbp)
 308               db))))))
 309
 310 (declaim (ftype (function (sqlite3-db-type) t) sqlite3-close))
 311 (defun sqlite3-close (db)
 312   (declare (type sqlite3-db-type db))
 313   (let ((result (%close db)))
 314     (if (/= result 0)
 315         (signal-sqlite3-error result)
 316         (progn
 317           (free-foreign-object (gethash db *db-pointers*))
 318           (remhash db *db-pointers*)
 319           t))))
 320
 321 (declaim (ftype (function (sqlite3-db-type string) sqlite3-stmt-type) sqlite3-prepare))
 322 (defun sqlite3-prepare (db sql)
 323   (declare (type sqlite3-db-type db))
 324   (with-cstring (sql-native sql)
 325     (let ((stmtp (allocate-foreign-object 'sqlite3-stmt)))
 326       (declare (type sqlite3-stmt-ptr-type stmtp))
 327       (with-foreign-object (sql-tail '(* :unsigned-char))
 328         (let ((result (%prepare db sql-native -1 stmtp sql-tail)))
 329           (if (/= result SQLITE-OK)
 330               (progn
 331                 (unless (null-pointer-p stmtp)
 332                   ;; There is an error, but a statement has been allocated:
 333                   ;; finalize it (better safe than sorry).
 334                   (%finalize (deref-pointer stmtp 'sqlite3-stmt)))
 335                 (free-foreign-object stmtp)
 336                 (signal-sqlite3-error db))
 337               (let ((stmt (deref-pointer stmtp 'sqlite3-stmt)))
 338                 (declare (type sqlite3-stmt-type stmt))
 339                 (setf (gethash stmt *stmt-pointers*) stmtp)
 340                 stmt)))))))
 341
 342 (declaim (ftype (function (sqlite3-stmt-type) t) sqlite3-step))
 343 (defun sqlite3-step (stmt)
 344   (declare (type sqlite3-stmt-type stmt))
 345   (let ((result (%step stmt)))
 346     (cond ((= result SQLITE-ROW) t)
 347           ((= result SQLITE-DONE) nil)
 348           (t (signal-sqlite3-error result)))))
 349
 350 (declaim (ftype (function (sqlite3-stmt-type) t) sqlite3-finalize))
 351 (defun sqlite3-finalize (stmt)
 352   (declare (type sqlite3-stmt-type stmt))
 353   (let ((result (%finalize  stmt)))
 354     (if (/= result SQLITE-OK)
 355         (signal-sqlite3-error result)
 356         (progn
 357           (free-foreign-object (gethash stmt *stmt-pointers*))
 358           (remhash stmt *stmt-pointers*)
 359           t))))
 360
 361 (declaim (inline sqlite3-column-name))
 362 (defun sqlite3-column-name (stmt n)
 363   (declare (type sqlite3-stmt-type stmt) (type fixnum n))
 364   (convert-from-cstring (%column-name stmt n)))