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 (defmethod signal-sqlite3-error (db)
 174   (let ((condition
 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))))
 180
 181 (defmethod signal-sqlite3-error ((code number))
 182   (let ((condition
 183          (make-condition 'sqlite3-error
 184                          :code code
 185                          :message (let ((s (cdr (assoc code error-codes))))
 186                                     (if s
 187                                         s
 188                                         "unknown error")))))
 189     (unless (signal condition)
 190       (invoke-debugger condition))))
 191
 192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 193 ;;;;
 194 ;;;; Library functions.
 195 ;;;;
 196 (defmacro def-sqlite3-function (name args &key (returning :void))
 197   `(def-function ,name ,args
 198     :module "sqlite3"
 199     :returning ,returning))
 200
 201 (declaim (inline %errcode))
 202 (def-sqlite3-function
 203     "sqlite3_errcode"
 204     ((db sqlite3-db))
 205   :returning :int)
 206
 207 (declaim (inline %errmsg))
 208 (def-sqlite3-function
 209     "sqlite3_errmsg"
 210     ((db sqlite3-db))
 211   :returning :cstring)
 212
 213 (declaim (inline %open))
 214 (def-sqlite3-function
 215     ("sqlite3_open" %open)
 216     ((dbname :cstring)
 217      (db (* sqlite3-db)))
 218   :returning :int)
 219
 220 (declaim (inline %close))
 221 (def-sqlite3-function
 222     ("sqlite3_close" %close)
 223     ((db sqlite3-db))
 224   :returning :int)
 225
 226 (declaim (inline %prepare))
 227 (def-sqlite3-function
 228     ("sqlite3_prepare" %prepare)
 229     ((db sqlite3-db)
 230      (sql :cstring)
 231      (len :int)
 232      (stmt (* sqlite3-stmt))
 233      (sql-tail (* (* :unsigned-char))))
 234   :returning :int)
 235
 236 (declaim (inline %step))
 237 (def-sqlite3-function
 238     ("sqlite3_step" %step)
 239     ((stmt sqlite3-stmt))
 240   :returning :int)
 241
 242 (declaim (inline %finalize))
 243 (def-sqlite3-function
 244     ("sqlite3_finalize" %finalize)
 245     ((stmt sqlite3-stmt))
 246   :returning :int)
 247
 248 (declaim (inline sqlite3-column-count))
 249 (def-sqlite3-function
 250     "sqlite3_column_count"
 251     ((stmt sqlite3-stmt))
 252   :returning :int)
 253
 254 (declaim (inline %column-name))
 255 (def-sqlite3-function
 256     ("sqlite3_column_name" %column-name)
 257     ((stmt sqlite3-stmt)
 258      (n-col :int))
 259   :returning :cstring)
 260
 261 (declaim (inline sqlite3-column-type))
 262 (def-sqlite3-function
 263     "sqlite3_column_type"
 264     ((stmt sqlite3-stmt)
 265      (n-col :int))
 266   :returning :int)
 267
 268 (declaim (inline sqlite3-column-text))
 269 (def-sqlite3-function
 270     "sqlite3_column_text"
 271     ((stmt sqlite3-stmt)
 272      (n-col :int))
 273   :returning (* :unsigned-char))
 274
 275 (declaim (inline sqlite3-column-bytes))
 276 (def-sqlite3-function
 277     "sqlite3_column_bytes"
 278     ((stmt sqlite3-stmt)
 279      (n-col :int))
 280   :returning :int)
 281
 282 (declaim (inline sqlite3-column-blob))
 283 (def-sqlite3-function
 284     "sqlite3_column_blob"
 285     ((stmt sqlite3-stmt)
 286      (n-col :int))
 287   :returning :pointer-void)
 288
 289 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 290 ;;;;
 291 ;;;; wrapper functions.
 292 ;;;;
 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)))
 299         (if (/=  result 0)
 300             (progn
 301               ;; According to docs, the db must be closed even in case
 302               ;; of error.
 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)
 309               db))))))
 310
 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)))
 315     (if (/= result 0)
 316         (signal-sqlite3-error result)
 317         (progn
 318           (free-foreign-object (gethash db *db-pointers*))
 319           (remhash db *db-pointers*)
 320           t))))
 321
 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)
 331               (progn
 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)
 341                 stmt)))))))
 342
 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)))))
 350
 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)
 357         (progn
 358           (free-foreign-object (gethash stmt *stmt-pointers*))
 359           (remhash stmt *stmt-pointers*)
 360           t))))
 361
 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)))