From f7ffd9617ac7b70d330add3ad409128a9dec266f Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 31 Oct 2004 23:59:26 +0000 Subject: [PATCH] r10128: Add SQLite3 backend --- ChangeLog | 4 + clsql-sqlite3.asd | 38 ++ db-sqlite3/init-func-sample/Makefile | 19 + db-sqlite3/init-func-sample/example.lisp | 70 ++++ .../init-func-sample/iso-8859-15-coll.c | 79 ++++ db-sqlite3/sqlite3-api.lisp | 365 ++++++++++++++++++ db-sqlite3/sqlite3-loader.lisp | 46 +++ db-sqlite3/sqlite3-package.lisp | 23 ++ db-sqlite3/sqlite3-sql.lisp | 321 +++++++++++++++ tests/test-init.lisp | 5 + tests/utils.lisp | 3 +- 11 files changed, 972 insertions(+), 1 deletion(-) create mode 100644 clsql-sqlite3.asd create mode 100644 db-sqlite3/init-func-sample/Makefile create mode 100644 db-sqlite3/init-func-sample/example.lisp create mode 100644 db-sqlite3/init-func-sample/iso-8859-15-coll.c create mode 100644 db-sqlite3/sqlite3-api.lisp create mode 100644 db-sqlite3/sqlite3-loader.lisp create mode 100644 db-sqlite3/sqlite3-package.lisp create mode 100644 db-sqlite3/sqlite3-sql.lisp diff --git a/ChangeLog b/ChangeLog index 7af023f..912680e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +31 Oct 2004 Kevin Rosenberg + * clsql-sqlite3, db-sqlite3/*: NEW BACKEND + contributed by Aurelio Bignoli + 23 Oct 2004 Kevin Rosenberg * sql/oodml.lisp: Commit patch from Walter Pelis to use an object's database for a select on its slot. diff --git a/clsql-sqlite3.asd b/clsql-sqlite3.asd new file mode 100644 index 0000000..4795362 --- /dev/null +++ b/clsql-sqlite3.asd @@ -0,0 +1,38 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: clsql-sqlite.asd +;;;; Purpose: ASDF file for CLSQL SQLite3 backend +;;;; Programmer: Aurelio Bignoli +;;;; Date Started: Oct 2004 +;;;; +;;;; $Id$ +;;;; +;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* + +(defpackage #:clsql-sqlite3-system (:use #:asdf #:cl)) +(in-package #:clsql-sqlite3-system) + +(defsystem clsql-sqlite3 + :name "cl-sql-sqlite3" + :author "Aurelio Bignoli " + :maintainer "Aurelio Bignoli" + :licence "Lessor Lisp General Public License" + :description "Common Lisp Sqlite3 Driver" + :long-description "cl-sql-sqlite3 package provides a database driver to SQLite Versione 3 database library." + + + :depends-on (clsql clsql-uffi) + :components + ((:module :db-sqlite3 + :components + ((:file "sqlite3-package") + (:file "sqlite3-loader" :depends-on ("sqlite3-package")) + (:file "sqlite3-api" :depends-on ("sqlite3-loader")) + (:file "sqlite3-sql" :depends-on ("sqlite3-api")))))) diff --git a/db-sqlite3/init-func-sample/Makefile b/db-sqlite3/init-func-sample/Makefile new file mode 100644 index 0000000..de1cf29 --- /dev/null +++ b/db-sqlite3/init-func-sample/Makefile @@ -0,0 +1,19 @@ +# FILE IDENTIFICATION +# +# Name: Makefile +# Purpose: Makefile for SQLite 3 init function example. +# Programer: Aurelio Bignoli +# Date Started: Oct 2004 +# +# CVS Id: $Id$ +# +# This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli +# +# CLSQL users are granted the rights to distribute and use this software +# as governed by the terms of the Lisp Lesser GNU Public License +# (http://opensource.franz.com/preamble.html), also known as the LLGPL. + +sqlite3-utils.so: iso-8859-15-coll.c Makefile + gcc -c -fPIC iso-8859-15-coll.c -o iso-8859-15-coll.o + gcc -shared iso-8859-15-coll.o -o sqlite3-utils.so -l sqlite3 + diff --git a/db-sqlite3/init-func-sample/example.lisp b/db-sqlite3/init-func-sample/example.lisp new file mode 100644 index 0000000..1a81645 --- /dev/null +++ b/db-sqlite3/init-func-sample/example.lisp @@ -0,0 +1,70 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: example.lisp +;;;; Purpose: Sample code for SQLite 3 initialization functions +;;;; Authors: Aurelio Bignoli +;;;; Created: Oct 2004 +;;;; +;;;; $Id$ +;;;; +;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* + +;;;; Load CLSQL. +(asdf:oos 'asdf:load-op :clsql-sqlite3) + +;;;; Load sqlite3-utils.so library. See Makefile for library creation. +(unless (uffi:load-foreign-library "/usr/lib/clsql/sqlite3-utils.so" + :module "sqlite3-utils" + :supporting-libraries '("c")) + (error "Unable to load foreign library")) + +;;;; Define the foreign function to be used as init function. +(uffi:def-function + ("create_iso_8859_15_ci_collation" create-coll) + ((db sqlite3:sqlite3-db)) + :returning :int + :module "sqlite3-utils") + +;;;; Create the DB using create-coll as init function. +(defparameter db-name "init-func-test.db") +(clsql:destroy-database (list db-name) :database-type :sqlite3) +(clsql:connect (list db-name #'create-coll) :database-type :sqlite3) + +;;;; Create a table. Field f2 uses the newly defined collating +;;;; sequence. +(clsql:execute-command + "CREATE TABLE t1 (f1 CHAR(1), f2 CHAR(1) COLLATE ISO_8859_15_CI)") + +;;;; Populate the table. +(clsql:execute-command "INSERT INTO t1 VALUES ('à', 'à')") +(clsql:execute-command "INSERT INTO t1 VALUES ('a', 'a')") +(clsql:execute-command "INSERT INTO t1 VALUES ('A', 'A')") +(clsql:execute-command "INSERT INTO t1 VALUES ('é', 'é')") +(clsql:execute-command "INSERT INTO t1 VALUES ('e', 'e')") +(clsql:execute-command "INSERT INTO t1 VALUES ('E', 'E')") +(clsql:execute-command "INSERT INTO t1 VALUES ('ì', 'ì')") +(clsql:execute-command "INSERT INTO t1 VALUES ('i', 'i')") +(clsql:execute-command "INSERT INTO t1 VALUES ('I', 'I')") +(clsql:execute-command "INSERT INTO t1 VALUES ('ò', 'ò')") +(clsql:execute-command "INSERT INTO t1 VALUES ('o', 'o')") +(clsql:execute-command "INSERT INTO t1 VALUES ('O', 'O')") +(clsql:execute-command "INSERT INTO t1 VALUES ('ù', 'ù')") +(clsql:execute-command "INSERT INTO t1 VALUES ('u', 'u')") +(clsql:execute-command "INSERT INTO t1 VALUES ('U', 'U')") + +;;;; Perform some SELECTs. +(format t "~&SELECT * FROM t1 ==> ~A~%"(clsql:query "SELECT * FROM t1")) +(format t "~&SELECT * FROM t1 ORDER BY f1 ==> ~A~%" + (clsql:query "SELECT * FROM t1 ORDER BY f1")) +(format t "~&SELECT * FROM t1 ORDER BY f2 ==> ~A~%" + (clsql:query "SELECT * FROM t1 ORDER BY f2")) + +;;;; Disconnect from database. +(clsql:disconnect) \ No newline at end of file diff --git a/db-sqlite3/init-func-sample/iso-8859-15-coll.c b/db-sqlite3/init-func-sample/iso-8859-15-coll.c new file mode 100644 index 0000000..0e7fea1 --- /dev/null +++ b/db-sqlite3/init-func-sample/iso-8859-15-coll.c @@ -0,0 +1,79 @@ +/**************************************************************************** + * FILE IDENTIFICATION + * + * Name: iso-8859-15-coll.c + * Purpose: SQLite 3 initialization function for + * ISO-8859-15 collating sequence. + * Programmer: Aurelio Bignoli + * Date Started: Oct 2004 + * + * $Id$ + * + * This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli + * + * CLSQL users are granted the rights to distribute and use this software + * as governed by the terms of the Lisp Lesser GNU Public License + * (http://opensource.franz.com/preamble.html), also known as the LLGPL. + ***************************************************************************/ + + +/* Collating sequence name. CI = Case Insensitive */ +#define ISO_8859_15_CI_NAME "ISO_8859_15_CI" + +/* Conversion table. */ +const unsigned char iso_8859_15_ci [] = { + /* 0 */ 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, + /* 1 */ 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1A, 0x1B, 0x1C, 0x1D, 0x1E, 0x1F, + /* 2 */ 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x2D, 0x2E, 0x2F, + /* 3 */ 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3A, 0x3B, 0x3C, 0x3D, 0x3E, 0x3F, + /* 4 */ 0x40, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, + /* 5 */ 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x5B, 0x5C, 0x5D, 0x5E, 0x5F, + /* 6 */ 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, + /* 7 */ 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x7B, 0x7C, 0x7D, 0x7E, 0x7F, + /* 8 */ 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x73, 0x8B, 0x6F, 0x8D, 0x7A, 0x79, + /* 9 */ 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0x73, 0x9B, 0x6F, 0x9D, 0x7A, 0x79, + /* A */ 0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0x73, 0xA7, 0x73, 0xA9, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF, + /* B */ 0xB0, 0xB1, 0xB2, 0xB3, 0x7A, 0xB5, 0xB6, 0xB7, 0x7A, 0xB9, 0xBA, 0xBB, 0x6F, 0xBD, 0x79, 0xBF, + /* C */ 0x61, 0x61, 0x61, 0x61, 0x61, 0x61, 0x65, 0x63, 0x65, 0x65, 0x65, 0x65, 0x69, 0x69, 0x69, 0x69, + /* D */ 0x64, 0x6E, 0x6F, 0x6F, 0x6F, 0x6F, 0x6F, 0xD7, 0x6F, 0x75, 0x75, 0x75, 0x75, 0x79, 0xDE, 0x73, + /* E */ 0x61, 0x61, 0x61, 0x61, 0x61, 0x61, 0x65, 0x63, 0x65, 0x65, 0x65, 0x65, 0x69, 0x69, 0x69, 0x69, + /* F */ 0x64, 0x6E, 0x6F, 0x6F, 0x6F, 0x6F, 0x6F, 0xF7, 0x6F, 0x75, 0x75, 0x75, 0x75, 0x79, 0xFE, 0x73 +}; + +/* + * A modified version of sqlite3StrNICmp in sqlite/src/util.c + */ +int iso_8859_15_ci_StrCmp(const char *zLeft, const char *zRight, int N){ + register unsigned char *a, *b; + a = (unsigned char *)zLeft; + b = (unsigned char *)zRight; + while( N-- > 0 && *a!=0 && iso_8859_15_ci[*a]==iso_8859_15_ci[*b]){ a++; b++; } + return N<0 ? 0 : iso_8859_15_ci[*a] - iso_8859_15_ci[*b]; +} + +/* + * A modified version of nocaseCollatinFunc in sqlite/src/main.c. + */ +int iso_8859_15_ci_CollatingFunc( + void *NotUsed, + int nKey1, const void *pKey1, + int nKey2, const void *pKey2 +){ + int r = iso_8859_15_ci_StrCmp( + (const char *)pKey1, (const char *)pKey2, (nKey1 n-col 0) + (get-result-types stmt n-col result-types))))) + (if full-set + (values result-set n-col nil) + (values result-set n-col)))) + (sqlite3:sqlite3-error (err) + (progn + (unless (eq stmt sqlite3:null-stmt) + (ignore-errors + (sqlite3:sqlite3-finalize stmt))) + (error 'sql-database-data-error + :database database + :expression query-expression + :error-id (sqlite3:sqlite3-error-code err) + :message (sqlite3:sqlite3-error-message err))))))) + +(defmethod database-dump-result-set (result-set (database sqlite3-database)) + (handler-case + (sqlite3:sqlite3-finalize (sqlite3-result-set-stmt result-set)) + (sqlite3:sqlite3-error (err) + (error 'sql-database-error + :message + (format nil "Error finalizing SQLite3 statement: ~A" + (sqlite3:sqlite3-error-message err)))))) + +(defmethod database-store-next-row (result-set (database sqlite3-database) list) + (let ((n-col (sqlite3-result-set-n-col result-set))) + (if (= n-col 0) + ;; empty result set. + nil + ;; Non-empty set. + (let ((stmt (sqlite3-result-set-stmt result-set))) + (declare (type sqlite3:sqlite3-stmt-type stmt)) + ;; Store row in list. + (loop for i = 0 then (1+ i) + for rest on list + for types = (sqlite3-result-set-result-types result-set) then (rest types) + do (setf (car rest) + (if (eq (first types) :blob) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-blob stmt i) + types 0 + (sqlite3:sqlite3-column-bytes stmt i)) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-text stmt i) + types 0)))) + ;; Advance result set cursor. + (handler-case + (unless (sqlite3:sqlite3-step stmt) + (setf (sqlite3-result-set-n-col result-set) 0)) + (sqlite3:sqlite3-error (err) + (error 'sql-database-error + :message "Error in sqlite3-step: ~A" + (sqlite3:sqlite3-error-message err)))) + t)))) + + +(defmethod database-query (query-expression (database sqlite3-database) result-types field-names) + (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) + (handler-case + (let ((stmt (sqlite3:sqlite3-prepare (sqlite3-db database) + query-expression)) + (rows '()) + (col-names '())) + (declare (type sqlite3:sqlite3-stmt-type stmt)) + (unwind-protect + (when (sqlite3:sqlite3-step stmt) + (let ((n-col (sqlite3:sqlite3-column-count stmt))) + (flet ((extract-row-data () + (loop for i from 0 below n-col + for types = (get-result-types stmt n-col result-types) then (rest types) + collect (if (eq (first types) :blob) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-blob stmt i) + types 0 + (sqlite3:sqlite3-column-bytes stmt i)) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-text stmt i) + types 0))))) + (when field-names + (setf col-names (loop for n from 0 below n-col + collect (sqlite3:sqlite3-column-name stmt n)))) + (push (extract-row-data) rows) + (do* () (nil) + (if (sqlite3:sqlite3-step stmt) + (push (extract-row-data) rows) + (return)))))) + (sqlite3:sqlite3-finalize stmt)) + (values (nreverse rows) col-names)) + (sqlite3:sqlite3-error (err) + (error 'sql-database-data-error + :database database + :expression query-expression + :error-id (sqlite3:sqlite3-error-code err) + :message (sqlite3:sqlite3-error-message err))))) + +;;; Object listing + +(defmethod database-list-tables-and-sequences ((database sqlite3-database) &key owner) + (declare (ignore owner)) + ;; Query is copied from .table command of sqlite3 command line utility. + (mapcar #'car (database-query + "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name" + database nil nil))) + +(defmethod database-list-tables ((database sqlite3-database) &key owner) + (remove-if #'(lambda (s) + (and (>= (length s) 11) + (string-equal (subseq s 0 11) "_CLSQL_SEQ_"))) + (database-list-tables-and-sequences database :owner owner))) + +(defmethod database-list-views ((database sqlite3-database) + &key (owner nil)) + (declare (ignore owner)) + (mapcar #'car (database-query + "SELECT name FROM sqlite_master WHERE type='view' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='view' ORDER BY name" + database nil nil))) + +(defmethod database-list-indexes ((database sqlite3-database) + &key (owner nil)) + (declare (ignore owner)) + (mapcar #'car (database-query + "SELECT name FROM sqlite_master WHERE type='index' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' ORDER BY name" + database nil nil))) + +(defmethod database-list-table-indexes (table (database sqlite3-database) + &key (owner nil)) + (declare (ignore owner)) + (let ((*print-circle* nil)) + (mapcar #'car + (database-query + (format + nil + "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='~A' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' AND tbl_name='~A' ORDER BY name" + table table) + database nil nil)))) + +(declaim (inline sqlite3-table-info)) +(defun sqlite3-table-info (table database) + (database-query (format nil "PRAGMA table_info('~A')" table) + database nil nil)) + +(defmethod database-list-attributes (table (database sqlite3-database) + &key (owner nil)) + (declare (ignore owner)) + (mapcar #'(lambda (table-info) (second table-info)) + (sqlite3-table-info table database))) + +(defmethod database-attribute-type (attribute table + (database sqlite3-database) + &key (owner nil)) + (declare (ignore owner)) + (loop for field-info in (sqlite3-table-info table database) + when (string= attribute (second field-info)) + return + (let* ((raw-type (third field-info)) + (start-length (position #\( raw-type)) + (type (if start-length + (subseq raw-type 0 start-length) + raw-type)) + (length (if start-length + (parse-integer (subseq raw-type (1+ start-length)) + :junk-allowed t) + nil))) + (values (when type (ensure-keyword type)) + length + nil + (if (string-equal (fourth field-info) "0") + 1 0))))) + +(defmethod database-create (connection-spec (type (eql :sqlite3))) + (declare (ignore connection-spec)) + ;; databases are created automatically by Sqlite3 + t) + +(defmethod database-destroy (connection-spec (type (eql :sqlite3))) + (destructuring-bind (name) connection-spec + (if (probe-file name) + (delete-file name) + nil))) + +(defmethod database-probe (connection-spec (type (eql :sqlite3))) + (destructuring-bind (name) connection-spec + ;; TODO: Add a test that this file is a real sqlite3 database + (or (string-equal ":memory:" name) + (and (probe-file name) t)))) + +;;; Database capabilities + +(defmethod db-type-has-boolean-where? ((db-type (eql :sqlite3))) + nil) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index b1a8934..84d09d3 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -584,6 +584,11 @@ :fdml/select/21 :fdml/select/32 :fdml/select/33)) (push (cons test "not supported by sqlite") skip-tests)) + ((and (eql *test-database-type* :sqlite3) + (clsql-sys:in test :fddl/view/4 :fdml/select/10 + :fdml/select/21 :fdml/select/32 + :fdml/select/33)) + (push (cons test "not supported by sqlite3") skip-tests)) ((and (not (clsql-sys:db-type-has-bigint? db-type)) (clsql-sys:in test :basic/bigint/1)) (push (cons test "bigint not supported") skip-tests)) diff --git a/tests/utils.lisp b/tests/utils.lisp index eb10ec3..948d75a 100644 --- a/tests/utils.lisp +++ b/tests/utils.lisp @@ -24,7 +24,7 @@ :type "config")) (defvar +all-db-types+ - '(:postgresql :postgresql-socket :mysql :sqlite :odbc :oracle + '(:postgresql :postgresql-socket :mysql :sqlite :sqlite3 :odbc :oracle #+allegro :aodbc)) (defclass conn-specs () @@ -33,6 +33,7 @@ (postgresql :accessor postgresql-spec :initform nil) (postgresql-socket :accessor postgresql-socket-spec :initform nil) (sqlite :accessor sqlite-spec :initform nil) + (sqlite3 :accessor sqlite3-spec :initform nil) (odbc :accessor odbc-spec :initform nil) (oracle :accessor oracle-spec :initform nil)) (:documentation "Connection specs for CLSQL testing")) -- 2.34.1