1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: sqlite-sql.lisp
6 ;;;; Purpose: High-level SQLite interface
7 ;;;; Programmers: Aurelio Bignoli
8 ;;;; Date Started: Aug 2003
10 ;;;; $Id: sqlite-sql.lisp,v 1.5 2004/03/09 20:57:44 aurelio Exp $
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 (declaim (optimize (speed 3) (debug 0) (safety 0)))
21 (in-package :clsql-sqlite)
23 (defclass sqlite-database (database)
24 ((sqlite-db :initarg :sqlite-db :accessor sqlite-db)))
26 (defmethod database-initialize-database-type ((database-type (eql :sqlite)))
29 (defun check-sqlite-connection-spec (connection-spec)
30 (check-connection-spec connection-spec :sqlite (name)))
32 (defmethod database-name-from-spec (connection-spec
33 (database-type (eql :sqlite)))
34 (check-sqlite-connection-spec connection-spec)
35 (first connection-spec))
37 (defmethod database-connect (connection-spec (database-type (eql :sqlite)))
38 (check-sqlite-connection-spec connection-spec)
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)))))
50 (defmethod database-disconnect ((database sqlite-database))
51 (sqlite:sqlite-close (sqlite-db database))
52 (setf (sqlite-db database) nil)
55 (defmethod database-execute-command (sql-expression (database sqlite-database))
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)
62 (error 'clsql-simple-warning
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
69 :expression sql-expression
70 :errno (sqlite:sqlite-error-code err)
71 :error (sqlite:sqlite-error-message err))))
74 (defmethod database-query (query-expression (database sqlite-database) types)
75 (declare (ignore types)) ; SQLite is typeless!
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))
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
88 #-clisp sqlite:sqlite-aref
90 #-clisp (sqlite:sqlite-free-table data))
92 (sqlite:sqlite-error (err)
93 (error 'clsql-sql-error
95 :expression query-expression
96 :errno (sqlite:sqlite-error-code err)
97 :error (sqlite:sqlite-error-message err)))))
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))
107 (defstruct sqlite-result-set
110 (n-col 0 :type fixnum))
112 (defmethod database-query-result-set
113 (query-expression (database sqlite-database) &key full-set types)
114 (declare (ignore full-set types))
116 (let* ((vm (sqlite:sqlite-compile (sqlite-db database)
118 (result-set (make-sqlite-result-set :vm vm)))
119 #-clisp (declare (type sqlite:sqlite-vm-pointer vm))
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)
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
133 :expression query-expression
134 :errno (sqlite:sqlite-error-code err)
135 :error (sqlite:sqlite-error-message err)))))
137 (defmethod database-dump-result-set (result-set (database sqlite-database))
138 (declare (ignore database))
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))))))
146 (defmethod database-store-next-row (result-set (database sqlite-database) list)
147 (let ((n-col (sqlite-result-set-n-col result-set)))
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.
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)
160 (if (sqlite:null-row-p new-row)
161 (return-from database-store-next-row nil)
163 (sqlite:sqlite-error (err)
164 (error 'clsql-simple-error
165 :format-control "Error in sqlite-step: ~A"
167 (list (sqlite:sqlite-error-message err)))))
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)
176 #-clisp sqlite:sqlite-aref
178 #-clisp (sqlite:sqlite-free-row row)