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-type ((database sqlite-database))
29 (defmethod database-initialize-database-type ((database-type (eql :sqlite)))
32 (defun check-sqlite-connection-spec (connection-spec)
33 (check-connection-spec connection-spec :sqlite (name)))
35 (defmethod database-name-from-spec (connection-spec
36 (database-type (eql :sqlite)))
37 (check-sqlite-connection-spec connection-spec)
38 (first connection-spec))
40 (defmethod database-connect (connection-spec (database-type (eql :sqlite)))
41 (check-sqlite-connection-spec connection-spec)
43 (make-instance 'sqlite-database
44 :name (database-name-from-spec connection-spec :sqlite)
45 :sqlite-db (sqlite:sqlite-open (first connection-spec)))
46 (sqlite:sqlite-error (err)
47 (error 'clsql-connect-error
48 :database-type database-type
49 :connection-spec connection-spec
50 :errno (sqlite:sqlite-error-code err)
51 :error (sqlite:sqlite-error-message err)))))
53 (defmethod database-disconnect ((database sqlite-database))
54 (sqlite:sqlite-close (sqlite-db database))
55 (setf (sqlite-db database) nil)
58 (defmethod database-execute-command (sql-expression (database sqlite-database))
60 (multiple-value-bind (data row-n col-n)
61 (sqlite:sqlite-get-table (sqlite-db database) sql-expression)
62 #+clisp (declare (ignore data))
63 #-clisp (sqlite:sqlite-free-table data)
65 (error 'clsql-simple-warning
67 "Result set not empty: ~@(~A~) row~:P, ~@(~A~) column~:P "
68 :format-arguments (list row-n col-n))))
69 (sqlite:sqlite-error (err)
70 (error 'clsql-sql-error
72 :expression sql-expression
73 :errno (sqlite:sqlite-error-code err)
74 :error (sqlite:sqlite-error-message err))))
77 (defmethod database-query (query-expression (database sqlite-database) types)
78 (declare (ignore types)) ; SQLite is typeless!
80 (multiple-value-bind (data row-n col-n)
81 (sqlite:sqlite-get-table (sqlite-db database) query-expression)
82 #-clisp (declare (type sqlite:sqlite-row-pointer data))
86 ;; The first col-n elements are column names.
87 (loop for i from col-n below (* (1+ row-n) col-n) by col-n
88 collect (loop for j from 0 below col-n
91 #-clisp sqlite:sqlite-aref
93 #-clisp (sqlite:sqlite-free-table data))
95 (sqlite:sqlite-error (err)
96 (error 'clsql-sql-error
98 :expression query-expression
99 :errno (sqlite:sqlite-error-code err)
100 :error (sqlite:sqlite-error-message err)))))
103 (defstruct sqlite-result-set
104 (vm (sqlite:make-null-vm)
105 :type sqlite:sqlite-vm-pointer)
106 (first-row (sqlite:make-null-row)
107 :type sqlite:sqlite-row-pointer)
108 (n-col 0 :type fixnum))
110 (defstruct sqlite-result-set
113 (n-col 0 :type fixnum))
115 (defmethod database-query-result-set
116 (query-expression (database sqlite-database) &key full-set types)
117 (declare (ignore full-set types))
119 (let* ((vm (sqlite:sqlite-compile (sqlite-db database)
121 (result-set (make-sqlite-result-set :vm vm)))
122 #-clisp (declare (type sqlite:sqlite-vm-pointer vm))
124 ;;; To obtain column number we have to read the first row.
125 (multiple-value-bind (n-col cols col-names)
126 (sqlite:sqlite-step vm)
127 (declare (ignore col-names)
128 #-clisp (type sqlite:sqlite-row-pointer cols)
130 (setf (sqlite-result-set-first-row result-set) cols
131 (sqlite-result-set-n-col result-set) n-col)
132 (values result-set n-col nil)))
133 (sqlite:sqlite-error (err)
134 (error 'clsql-sql-error
136 :expression query-expression
137 :errno (sqlite:sqlite-error-code err)
138 :error (sqlite:sqlite-error-message err)))))
140 (defmethod database-dump-result-set (result-set (database sqlite-database))
141 (declare (ignore database))
143 (sqlite:sqlite-finalize (sqlite-result-set-vm result-set))
144 (sqlite:sqlite-error (err)
145 (error 'clsql-simple-error
146 :format-control "Error finalizing SQLite VM: ~A"
147 :format-arguments (list (sqlite:sqlite-error-message err))))))
149 (defmethod database-store-next-row (result-set (database sqlite-database) list)
150 (let ((n-col (sqlite-result-set-n-col result-set)))
154 (let ((row (sqlite-result-set-first-row result-set)))
155 (if (sqlite:null-row-p row)
156 ;; First row already used. fetch another row from DB.
158 (multiple-value-bind (n new-row col-names)
159 (sqlite:sqlite-step (sqlite-result-set-vm result-set))
160 (declare (ignore n col-names)
161 #-clisp (type sqlite:sqlite-row-pointer new-row)
163 (if (sqlite:null-row-p new-row)
164 (return-from database-store-next-row nil)
166 (sqlite:sqlite-error (err)
167 (error 'clsql-simple-error
168 :format-control "Error in sqlite-step: ~A"
170 (list (sqlite:sqlite-error-message err)))))
172 ;; Use the row previously read by database-query-result-set.
173 (setf (sqlite-result-set-first-row result-set)
174 (sqlite:make-null-row)))
175 (loop for i = 0 then (1+ i)
179 #-clisp sqlite:sqlite-aref
181 #-clisp (sqlite:sqlite-free-row row)