db-sqlite/sqlite-sql.lisp

   1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          sqlite-sql.lisp
   6 ;;;; Purpose:       High-level SQLite interface
   7 ;;;; Programmers:   Aurelio Bignoli
   8 ;;;; Date Started:  Aug 2003
   9 ;;;;
  10 ;;;; $Id: sqlite-sql.lisp,v 1.5 2004/03/09 20:57:44 aurelio Exp $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2003 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 (declaim (optimize (speed 3) (debug 0) (safety 0)))
  20
  21 (in-package :clsql-sqlite)
  22
  23 (defclass sqlite-database (database)
  24   ((sqlite-db :initarg :sqlite-db :accessor sqlite-db)))
  25
  26 (defmethod database-initialize-database-type ((database-type (eql :sqlite)))
  27   t)
  28
  29 (defun check-sqlite-connection-spec (connection-spec)
  30   (check-connection-spec connection-spec :sqlite (name)))
  31
  32 (defmethod database-name-from-spec (connection-spec
  33                                     (database-type (eql :sqlite)))
  34   (check-sqlite-connection-spec connection-spec)
  35   (first connection-spec))
  36
  37 (defmethod database-connect (connection-spec (database-type (eql :sqlite)))
  38   (check-sqlite-connection-spec connection-spec)
  39   (handler-case
  40       (make-instance 'sqlite-database
  41                      :name (database-name-from-spec connection-spec :sqlite)
  42                      :sqlite-db (sqlite:sqlite-open (first connection-spec)))
  43     (sqlite:sqlite-error (err)
  44       (error 'clsql-connect-error
  45              :database-type database-type
  46              :connection-spec connection-spec
  47              :errno (sqlite:sqlite-error-code err)
  48              :error (sqlite:sqlite-error-message err)))))
  49
  50 (defmethod database-disconnect ((database sqlite-database))
  51   (sqlite:sqlite-close (sqlite-db database))
  52   (setf (sqlite-db database) nil)
  53   t)
  54
  55 (defmethod database-execute-command (sql-expression (database sqlite-database))
  56   (handler-case
  57       (multiple-value-bind (data row-n col-n)
  58           (sqlite:sqlite-get-table (sqlite-db database) sql-expression)
  59         #+clisp (declare (ignore data))
  60         #-clisp (sqlite:sqlite-free-table data)
  61         (unless (= row-n 0)
  62           (error 'clsql-simple-warning
  63                  :format-control
  64                  "Result set not empty: ~@(~A~) row~:P, ~@(~A~) column~:P "
  65                  :format-arguments (list row-n col-n))))
  66     (sqlite:sqlite-error (err)
  67       (error 'clsql-sql-error
  68              :database database
  69              :expression sql-expression
  70              :errno (sqlite:sqlite-error-code err)
  71              :error (sqlite:sqlite-error-message err))))
  72   t)
  73
  74 (defmethod database-query (query-expression (database sqlite-database) types)
  75   (declare (ignore types))              ; SQLite is typeless!
  76   (handler-case
  77       (multiple-value-bind (data row-n col-n)
  78           (sqlite:sqlite-get-table (sqlite-db database) query-expression)
  79         #-clisp (declare (type sqlite:sqlite-row-pointer data))
  80         (if (= row-n 0)
  81             nil
  82             (prog1
  83                 ;; The first col-n elements are column names.
  84                 (loop for i from col-n below (* (1+ row-n) col-n) by col-n
  85                       collect (loop for j from 0 below col-n
  86                                     collect
  87                                     (#+clisp aref
  88                                      #-clisp sqlite:sqlite-aref
  89                                              data (+ i j))))
  90                 #-clisp (sqlite:sqlite-free-table data))
  91               ))
  92     (sqlite:sqlite-error (err)
  93       (error 'clsql-sql-error
  94              :database database
  95              :expression query-expression
  96              :errno (sqlite:sqlite-error-code err)
  97              :error (sqlite:sqlite-error-message err)))))
  98
  99 #-clisp
 100 (defstruct sqlite-result-set
 101   (vm (sqlite:make-null-vm)
 102       :type sqlite:sqlite-vm-pointer)
 103   (first-row (sqlite:make-null-row)
 104              :type sqlite:sqlite-row-pointer)
 105   (n-col 0 :type fixnum))
 106 #+clisp
 107 (defstruct sqlite-result-set
 108   (vm nil)
 109   (first-row nil)
 110   (n-col 0 :type fixnum))
 111
 112 (defmethod database-query-result-set
 113     (query-expression (database sqlite-database) &key full-set types)
 114   (declare (ignore full-set types))
 115   (handler-case
 116       (let* ((vm (sqlite:sqlite-compile (sqlite-db database)
 117                                         query-expression))
 118              (result-set (make-sqlite-result-set :vm vm)))
 119         #-clisp (declare (type sqlite:sqlite-vm-pointer vm))
 120
 121         ;;; To obtain column number we have to read the first row.
 122         (multiple-value-bind (n-col cols col-names)
 123             (sqlite:sqlite-step vm)
 124           (declare (ignore col-names)
 125                    #-clisp (type sqlite:sqlite-row-pointer cols)
 126                    )
 127           (setf (sqlite-result-set-first-row result-set) cols
 128                 (sqlite-result-set-n-col result-set) n-col)
 129           (values result-set n-col nil)))
 130     (sqlite:sqlite-error (err)
 131       (error 'clsql-sql-error
 132              :database database
 133              :expression query-expression
 134              :errno (sqlite:sqlite-error-code err)
 135              :error (sqlite:sqlite-error-message err)))))
 136
 137 (defmethod database-dump-result-set (result-set (database sqlite-database))
 138   (declare (ignore database))
 139   (handler-case
 140       (sqlite:sqlite-finalize (sqlite-result-set-vm result-set))
 141     (sqlite:sqlite-error (err)
 142       (error 'clsql-simple-error
 143              :format-control "Error finalizing SQLite VM: ~A"
 144              :format-arguments (list (sqlite:sqlite-error-message err))))))
 145
 146 (defmethod database-store-next-row (result-set (database sqlite-database) list)
 147   (let ((n-col (sqlite-result-set-n-col result-set)))
 148     (if (= n-col 0)
 149         ;; empty result set
 150         nil
 151         (let ((row (sqlite-result-set-first-row result-set)))
 152           (if (sqlite:null-row-p row)
 153               ;; First row already used. fetch another row from DB.
 154               (handler-case
 155                   (multiple-value-bind (n new-row col-names)
 156                       (sqlite:sqlite-step (sqlite-result-set-vm result-set))
 157                     (declare (ignore n col-names)
 158                              #-clisp (type sqlite:sqlite-row-pointer new-row)
 159                              )
 160                     (if (sqlite:null-row-p new-row)
 161                         (return-from database-store-next-row nil)
 162                         (setf row new-row)))
 163                 (sqlite:sqlite-error (err)
 164                   (error 'clsql-simple-error
 165                          :format-control "Error in sqlite-step: ~A"
 166                          :format-arguments
 167                          (list (sqlite:sqlite-error-message err)))))
 168
 169               ;; Use the row previously read by database-query-result-set.
 170               (setf (sqlite-result-set-first-row result-set)
 171                     (sqlite:make-null-row)))
 172           (loop for i = 0 then (1+ i)
 173                 for rest on list
 174                 do (setf (car rest)
 175                          (#+clisp aref
 176                           #-clisp sqlite:sqlite-aref
 177                           row i)))
 178           #-clisp (sqlite:sqlite-free-row row)
 179           t))))