r8811: add support for usql backend, integrate Marcus Pearce <ek735@soi.city.ac.uk...
authorKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 2 Apr 2004 20:45:48 +0000 (20:45 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 2 Apr 2004 20:45:48 +0000 (20:45 +0000)
14 files changed:
ChangeLog
base/classes.lisp
base/conditions.lisp
base/db-interface.lisp
base/initialize.lisp
base/package.lisp
clsql-postgresql-socket.asd
db-mysql/mysql-api.lisp
db-mysql/mysql-usql.lisp
db-postgresql-socket/postgresql-socket-usql.lisp [new file with mode: 0644]
db-postgresql/postgresql-usql.lisp
db-sqlite/sqlite-sql.lisp
db-sqlite/sqlite-usql.lisp
debian/changelog

index 554b73d..e9b659f 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+02 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
+       * Integrate patch from Marcus Pearce <ek735@soi.city.ac.uk>
+       adding further support for providing backend for UncommonSQL
+
 10 Mar 2004 Kevin Rosenberg (kevin@rosenberg.net)
        * Integrate patch from Aurelio Bignoli for SQLite backend
 
index 104c7b6..26655d8 100644 (file)
 
 (defclass database ()
   ((name :initform nil :initarg :name :reader database-name)
-   (connection-spec :initform nil :initarg :connection-spec :reader connection-spec
+   (connection-spec :initform nil :initarg :connection-spec
+                    :reader connection-spec
                    :documentation "Require to use connection pool")
+   (command-recording-stream :accessor command-recording-stream :initform nil)
+   (result-recording-stream :accessor result-recording-stream :initform nil)
+   (view-classes :accessor database-view-classes :initform nil)
+   (schema :accessor database-schema :initform nil)
    (transaction-level :initform 0 :accessor transaction-level)
    (transaction :initform nil :accessor transaction)
    (conn-pool :initform nil :initarg :conn-pool :accessor conn-pool))
index 228ed36..7fc7781 100644 (file)
@@ -157,3 +157,26 @@ and signal an clsql-invalid-spec-error if they don't match."
          'clsql-nodb-error
          :database database))
 
+
+;; for USQL support
+
+(define-condition clsql-type-error (clsql-error clsql-condition)
+  ((slotname :initarg :slotname
+            :reader clsql-type-error-slotname)
+   (typespec :initarg :typespec
+            :reader clsql-type-error-typespec)
+   (value :initarg :value
+         :reader clsql-type-error-value))
+  (:report (lambda (c stream)
+            (format stream
+                    "Invalid value ~A in slot ~A, not of type ~A."
+                    (clsql-type-error-value c)
+                    (clsql-type-error-slotname c)
+                    (clsql-type-error-typespec c)))))
+
+(define-condition clsql-sql-syntax-error (clsql-error)
+  ((reason :initarg :reason
+          :reader clsql-sql-syntax-error-reason))
+  (:report (lambda (c stream)
+            (format stream "Invalid SQL syntax: ~A"
+                    (clsql-sql-syntax-error-reason c)))))
\ No newline at end of file
index 8b60847..a27a958 100644 (file)
@@ -134,6 +134,15 @@ returns nil when result-set is finished."))
 (defgeneric database-sequence-next (name database)
   (:documentation "Increment a sequence in DATABASE."))
 
+(defgeneric database-list-sequences (database &key owner)
+  (:documentation "List all sequences in DATABASE."))
+
+(defgeneric database-set-sequence-position (name position database)
+  (:documentation "Set the position of the sequence called NAME in DATABASE."))
+
+(defgeneric database-sequence-last (name database)
+  (:documentation "Select the last value in sequence NAME in DATABASE."))
+
 (defgeneric database-start-transaction (database)
   (:documentation "Start a transaction in DATABASE."))
 
@@ -147,13 +156,19 @@ returns nil when result-set is finished."))
   (:documentation "Return the type SQL type specifier as a string, for
 the given lisp type and parameters."))
 
-(defgeneric database-list-tables (database &key system-tables)
+(defgeneric database-list-tables (database &key owner)
   (:documentation "List all tables in the given database"))
+(defgeneric database-list-views (database &key owner)
+  (:documentation "List all views in the DATABASE."))
 
-(defgeneric database-list-attributes (table database)
+(defgeneric database-list-indexes (database &key owner)
+  (:documentation "List all indexes in the DATABASE."))
+
+(defgeneric database-list-attributes (table database &key owner)
   (:documentation "List all attributes in TABLE."))
 
-(defgeneric database-attribute-type (attribute table database)
+(defgeneric database-attribute-type (attribute table database &key owner)
   (:documentation "Return the type of ATTRIBUTE in TABLE."))
 
 (defgeneric database-add-attribute (table attribute database)
@@ -165,7 +180,7 @@ the given lisp type and parameters."))
 (defgeneric oid (object)
   (:documentation "Return the unique ID of a database object."))
 
+
 ;;; Large objects support (Marc Battyani)
 
 (defgeneric database-create-large-object (database)
index ffa08b2..8e98d5e 100644 (file)
@@ -45,9 +45,9 @@ to initialize-database-type.")
   "Initialize the given database-type, if it is not already
 initialized, as indicated by `*initialized-database-types*'."
   (if (member database-type *initialized-database-types*)
-      t
+      database-type
       (when (database-initialize-database-type database-type)
        (push database-type *initialized-database-types*)
-       t)))
+       database-type)))
 
 
index 3211598..ea9f936 100644 (file)
      #:database-drop-sequence
      #:database-sequence-next
      #:sql-escape
-
+     #:database-sequence-last
+     #:database-set-sequence-position
+     #:database-list-attributes
+     #:database-list-sequences
+     #:database-list-indexes
+     #:database-list-views
+     
      ;; Support for pooled connections
      #:database-type
 
@@ -89,7 +95,9 @@
         #:clsql-exists-error
         #:clsql-closed-error
         #:clsql-closed-error-database
-        
+         #:clsql-sql-syntax-error
+         #:clsql-type-error
+         
         #:*loaded-database-types*
         #:reload-database-types
         #:*default-database-type*
index 3955adc..76825b8 100644 (file)
@@ -37,5 +37,7 @@
             (:file "postgresql-socket-api"
                    :depends-on ("postgresql-socket-package"))
             (:file "postgresql-socket-sql"
-                   :depends-on ("postgresql-socket-api")))))
+                   :depends-on ("postgresql-socket-api"))
+             (:file "postgresql-socket-usql"
+                   :depends-on ("postgresql-socket-sql")))))
   :depends-on (:clsql-base :uffi :md5))
index 480345d..7170fda 100644 (file)
      (:var-string 253)
      (:string 254)))
 
-#+:mysql-client-v3
+#+mysql-client-v3
 (uffi:def-struct mysql-field
     (name (* :char))
   (table (* :char))
   (decimals :unsigned-int))
 
 ;; structure changed in mysql 4 client
-#+:mysql-client-v4
+#+mysql-client-v4
 (uffi:def-struct mysql-field
     (name (* :char))
   (table (* :char))
 
 ;; Need to comment this out for LW 4.2.6
 ;; ? bug in LW version
-;;(declaim (inline mysql-real-connect))
+#-lispworks (declaim (inline mysql-real-connect))
 (uffi:def-function "mysql_real_connect"
     ((mysql (* mysql-mysql))
      (host :cstring)
index 06f574c..8b198e0 100644 (file)
 
 ;; Table and attribute introspection
 
-(defmethod database-list-tables ((database mysql-database)
-                                &key (system-tables nil))
-  (declare (ignore system-tables))
-  (mapcar #'car (database-query "show tables" database :auto)))
+(defmethod database-list-tables ((database mysql-database) &key (owner nil))
+  (declare (ignore owner))
+  (remove-if #'(lambda (s)
+                 (and (>= (length s) 10)
+                      (string= (subseq s 0 10) "_usql_seq_")))
+             (mapcar #'car (database-query "SHOW TABLES" database nil))))
     
+;; MySQL 4.1 does not support views 
+(defmethod database-list-views ((database mysql-database)
+                                &key (owner nil))
+  (declare (ignore owner database))
+  nil)
 
-(defmethod database-list-attributes ((table string) (database mysql-database))
+(defmethod database-list-indexes ((database mysql-database)
+                                  &key (owner nil))
+  (let ((result '()))
+    (dolist (table (database-list-tables database :owner owner) result)
+      (mapc #'(lambda (index) (push (nth 2 index) result))
+            (database-query 
+             (format nil "SHOW INDEX FROM ~A" (string-upcase table))
+             database nil)))))
+  
+(defmethod database-list-attributes ((table string) (database mysql-database)
+                                     &key (owner nil))
+  (declare (ignore owner))
   (mapcar #'car
          (database-query
           (format nil "SHOW COLUMNS FROM ~A" table)
           database nil)))
 
 (defmethod database-attribute-type (attribute (table string)
-                                   (database mysql-database))
+                                   (database mysql-database)
+                                    &key (owner nil))
+  (declare (ignore owner))
   (let ((result
-         (mapcar #'cadr
-                 (database-query
-                  (format nil
-                          "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
-                  database nil))))
+         (mapcar #'cadr
+                 (database-query
+                  (format nil
+                          "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
+                  database nil))))
     (let* ((str (car result))
           (end-str (position #\( str))
           (substr (subseq str 0 end-str)))
 (defun %sequence-name-to-table (sequence-name)
   (concatenate 'string "_usql_seq_" (sql-escape sequence-name)))
 
+(defun %table-name-to-sequence-name (table-name)
+  (and (>= (length table-name) 10)
+       (string= (subseq table-name 0 10) "_usql_seq_")
+       (subseq table-name 10)))
+
 (defmethod database-create-sequence (sequence-name
                                     (database mysql-database))
   (let ((table-name (%sequence-name-to-table sequence-name)))
    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name)) 
    database))
 
+(defmethod database-list-sequences ((database mysql-database)
+                                    &key (owner nil))
+  (declare (ignore owner))
+  (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
+          (database-query "SHOW TABLES LIKE '%usql_seq%'" 
+                          database nil)))
+
+(defmethod database-set-sequence-position (sequence-name
+                                           (position integer)
+                                           (database mysql-database))
+  (database-execute-command
+   (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name)
+           position)
+   database)
+  (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
+
 (defmethod database-sequence-next (sequence-name (database mysql-database))
   (database-execute-command 
    (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
    database)
   (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
 
+(defmethod database-sequence-last (sequence-name (database mysql-database))
+  (declare (ignore sequence-name database)))
+
 ;; Misc USQL functions
 
 #|
diff --git a/db-postgresql-socket/postgresql-socket-usql.lisp b/db-postgresql-socket/postgresql-socket-usql.lisp
new file mode 100644 (file)
index 0000000..3c134e2
--- /dev/null
@@ -0,0 +1,160 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          postgresql-socket-usql.sql
+;;;; Purpose:       PostgreSQL interface for USQL routines
+;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc
+;;;; Date Started:  Mar 2002
+;;;;
+;;;; $Id: postgresql-socket-usql.lisp 7061 2003-09-07 06:34:45Z kevin $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and by onShore Development Inc.
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(in-package #:clsql-postgresql-socket)
+
+
+(defmethod database-list-objects-of-type ((database postgresql-socket-database)
+                                          type owner)
+  (let ((owner-clause
+         (cond ((stringp owner)
+                (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" owner))
+               ((null owner)
+                (format nil " AND (NOT (relowner=1))"))
+               (t ""))))
+    (mapcar #'car
+            (database-query
+             (format nil
+                     "SELECT relname FROM pg_class WHERE (relkind = '~A')~A"
+                     type
+                     owner-clause)
+             database nil))))
+    
+(defmethod database-list-tables ((database postgresql-socket-database)
+                                 &key (owner nil))
+  (database-list-objects-of-type database "r" owner))
+  
+(defmethod database-list-views ((database postgresql-socket-database)
+                                &key (owner nil))
+  (database-list-objects-of-type database "v" owner))
+  
+(defmethod database-list-indexes ((database postgresql-socket-database)
+                                  &key (owner nil))
+  (database-list-objects-of-type database "i" owner))
+  
+(defmethod database-list-attributes ((table string)
+                                    (database postgresql-socket-database)
+                                     &key (owner nil))
+  (let* ((owner-clause
+          (cond ((stringp owner)
+                 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
+                ((null owner) " AND (not (relowner=1))")
+                (t "")))
+         (result
+         (mapcar #'car
+                 (database-query
+                  (format nil "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'~A"
+                           (string-downcase table)
+                           owner-clause)
+                   database nil))))
+    (if result
+       (reverse
+         (remove-if #'(lambda (it) (member it '("cmin"
+                                                "cmax"
+                                                "xmax"
+                                                "xmin"
+                                               "oid"
+                                                "ctid"
+                                               ;; kmr -- added tableoid
+                                               "tableoid") :test #'equal)) 
+                   result)))))
+
+(defmethod database-attribute-type (attribute (table string)
+                                   (database postgresql-socket-database)
+                                    &key (owner nil))
+  (let* ((owner-clause
+          (cond ((stringp owner)
+                 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
+                ((null owner) " AND (not (relowner=1))")
+                (t "")))
+         (result
+         (mapcar #'car
+                 (database-query
+                  (format nil "SELECT pg_type.typname FROM pg_type,pg_class,pg_attribute WHERE pg_class.oid=pg_attribute.attrelid AND pg_class.relname='~A' AND pg_attribute.attname='~A' AND pg_attribute.atttypid=pg_type.oid~A"
+                          (string-downcase table)
+                           (string-downcase attribute)
+                           owner-clause)
+                  database nil))))
+    (when result
+      (intern (string-upcase (car result)) :keyword))))
+
+(defmethod database-create-sequence (sequence-name
+                                    (database postgresql-socket-database))
+  (database-execute-command
+   (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name))
+   database))
+
+(defmethod database-drop-sequence (sequence-name
+                                  (database postgresql-socket-database))
+  (database-execute-command
+   (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database))
+
+(defmethod database-list-sequences ((database postgresql-socket-database)
+                                    &key (owner nil))
+  (database-list-objects-of-type database "S" owner))
+
+(defmethod database-set-sequence-position (name (position integer)
+                                          (database postgresql-socket-database))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (format nil "SELECT SETVAL ('~A', ~A)" name position)
+      database nil)))))
+
+(defmethod database-sequence-next (sequence-name 
+                                  (database postgresql-socket-database))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
+      database nil)))))
+
+(defmethod database-sequence-last (sequence-name (database postgresql-socket-database))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (concatenate 'string "SELECT LAST_VALUE ('" sequence-name "')")
+      database nil)))))
+  
+
+;; Functions depending upon high-level USQL classes/functions
+
+#|
+(defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp) 
+                               (database postgresql-socket-database))
+  (with-slots (clsql-sys::modifier clsql-sys::components)
+    expr
+    (if clsql-sys::modifier
+        (progn
+          (clsql-sys::output-sql clsql-sys::components database)
+          (write-char #\: clsql-sys::*sql-stream*)
+          (write-char #\: clsql-sys::*sql-stream*)
+          (write-string (symbol-name clsql-sys::modifier) 
+                       clsql-sys::*sql-stream*)))))
+
+(defmethod database-output-sql-as-type ((type (eql 'integer)) val
+                                       (database postgresql-socket-database))
+  (when val   ;; typecast it so it uses the indexes
+    (make-instance 'clsql-sys::sql-typecast-exp
+                   :modifier 'int8
+                   :components val)))
+|#
index b42438b..ef85e7d 100644 (file)
 
 (in-package #:clsql-postgresql)
 
-(defmethod database-list-tables ((database postgresql-database)
-                                 &key (system-tables nil))
-  (let ((res (mapcar #'car (database-query
-                           "SELECT tablename FROM pg_tables"
-                           database nil))))
-    (if (not system-tables)
-        (remove-if #'(lambda (table)
-                       (equal (subseq table 0 3)
-                              "pg_")) res)
-      res)))
-
-
 
+(defmethod database-list-objects-of-type ((database postgresql-database)
+                                          type owner)
+  (let ((owner-clause
+         (cond ((stringp owner)
+                (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" owner))
+               ((null owner)
+                (format nil " AND (NOT (relowner=1))"))
+               (t ""))))
+    (mapcar #'car
+            (database-query
+             (format nil
+                     "SELECT relname FROM pg_class WHERE (relkind = '~A')~A"
+                     type
+                     owner-clause)
+             database nil))))
+    
+(defmethod database-list-tables ((database postgresql-database)
+                                 &key (owner nil))
+  (database-list-objects-of-type database "r" owner))
+  
+(defmethod database-list-views ((database postgresql-database)
+                                &key (owner nil))
+  (database-list-objects-of-type database "v" owner))
+  
+(defmethod database-list-indexes ((database postgresql-database)
+                                  &key (owner nil))
+  (database-list-objects-of-type database "i" owner))
+  
 (defmethod database-list-attributes ((table string)
-                                    (database postgresql-database))
-  (let* ((result
+                                    (database postgresql-database)
+                                     &key (owner nil))
+  (let* ((owner-clause
+          (cond ((stringp owner)
+                 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
+                ((null owner) " AND (not (relowner=1))")
+                (t "")))
+         (result
          (mapcar #'car
                  (database-query
-                  (format nil
-                          "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'" table)
-                  database nil))))
+                  (format nil "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'~A"
+                           (string-downcase table)
+                           owner-clause)
+                   database nil))))
     (if result
        (reverse
          (remove-if #'(lambda (it) (member it '("cmin"
                    result)))))
 
 (defmethod database-attribute-type (attribute (table string)
-                                   (database postgresql-database))
-  (let ((result
+                                   (database postgresql-database)
+                                    &key (owner nil))
+  (let* ((owner-clause
+          (cond ((stringp owner)
+                 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
+                ((null owner) " AND (not (relowner=1))")
+                (t "")))
+         (result
          (mapcar #'car
                  (database-query
-                  (format nil
-                          "SELECT pg_type.typname FROM pg_type,pg_class,pg_attribute WHERE pg_class.oid=pg_attribute.attrelid AND pg_class.relname='~A' AND pg_attribute.attname='~A' AND pg_attribute.atttypid=pg_type.oid"
-                          table attribute)
+                  (format nil "SELECT pg_type.typname FROM pg_type,pg_class,pg_attribute WHERE pg_class.oid=pg_attribute.attrelid AND pg_class.relname='~A' AND pg_attribute.attname='~A' AND pg_attribute.atttypid=pg_type.oid~A"
+                          (string-downcase table)
+                           (string-downcase attribute)
+                           owner-clause)
                   database nil))))
-    (if result
-       (intern (string-upcase (car result)) :keyword) nil)))
-
+    (when result
+      (intern (string-upcase (car result)) :keyword))))
 
 (defmethod database-create-sequence (sequence-name
                                     (database postgresql-database))
   (database-execute-command
-   (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name)) database))
+   (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name))
+   database))
 
 (defmethod database-drop-sequence (sequence-name
                                   (database postgresql-database))
   (database-execute-command
    (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database))
 
+(defmethod database-list-sequences ((database postgresql-database)
+                                    &key (owner nil))
+  (database-list-objects-of-type database "S" owner))
+
+(defmethod database-set-sequence-position (name (position integer)
+                                                (database postgresql-database))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (format nil "SELECT SETVAL ('~A', ~A)" name position)
+      database nil)))))
+
 (defmethod database-sequence-next (sequence-name 
                                   (database postgresql-database))
-  (parse-integer
-   (caar
-    (database-query
-     (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
-     database nil))))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
+      database nil)))))
+
+(defmethod database-sequence-last (sequence-name (database postgresql-database))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (concatenate 'string "SELECT LAST_VALUE ('" sequence-name "')")
+      database nil)))))
+  
 
 ;; Functions depending upon high-level USQL classes/functions
 
index 78068fb..a2526ed 100644 (file)
@@ -1,4 +1,4 @@
-;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -23,6 +23,9 @@
 (defclass sqlite-database (database)
   ((sqlite-db :initarg :sqlite-db :accessor sqlite-db)))
 
+(defmethod database-type ((database sqlite-database))
+  :sqlite)
+
 (defmethod database-initialize-database-type ((database-type (eql :sqlite)))
   t)
 
index 4d66be7..852cf92 100644 (file)
 
 (in-package :clsql-sqlite)
 
+(defmethod database-list-tables ((database sqlite-database) &key owner)
+  (declare (ignore owner))
+  ;; Query is copied from .table command of sqlite comamnd line utility.
+  (remove-if #'(lambda (s)
+                 (and (>= (length s) 10)
+                      (string= (subseq s 0 10) "_usql_seq_")))
+             (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 '()))))
+
+(defmethod database-list-views ((database sqlite-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)))
+
+(defmethod database-list-indexes ((database sqlite-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)))
+
+(declaim (inline sqlite-table-info))
+(defun sqlite-table-info (table database)
+  (database-query (format nil "PRAGMA table_info('~A')" table)
+                         database '()))
+
+(defmethod database-list-attributes (table (database sqlite-database)
+                                           &key (owner nil))
+  (declare (ignore owner))
+  (mapcar #'(lambda (table-info) (second table-info))
+         (sqlite-table-info table database)))
+
+(defmethod database-attribute-type (attribute table 
+                                   (database sqlite-database)
+                                    &key (owner nil))
+  (declare (ignore owner))
+  (loop for field-info in (sqlite-table-info table database)
+       when (string= attribute (second field-info))
+       return (third field-info)))
+
 (defun %sequence-name-to-table-name (sequence-name)
   (concatenate 'string "_usql_seq_" (sql-escape sequence-name)))
 
+(defun %table-name-to-sequence-name (table-name)
+  (and (>= (length table-name) 10)
+       (string= (subseq table-name 0 10) "_usql_seq_")
+       (subseq table-name 10)))
+
 (defmethod database-create-sequence (sequence-name
                                     (database sqlite-database))
   (let ((table-name (%sequence-name-to-table-name sequence-name)))
                (%sequence-name-to-table-name sequence-name)) 
    database))
 
+(defmethod database-list-sequences ((database sqlite-database)
+                                    &key (owner nil))
+  (declare (ignore owner))
+  (mapcan #'(lambda (s)
+              (let ((sn (%table-name-to-sequence-name (car s))))
+                (and sn (list sn))))
+          (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 '())))
+
 (defmethod database-sequence-next (sequence-name (database sqlite-database))
   (let ((table-name (%sequence-name-to-table-name sequence-name)))
     (database-execute-command
      (format nil "UPDATE ~A SET id=(SELECT id FROM ~A)+1"
             table-name table-name)
-     database))
-  (sqlite:sqlite-last-insert-rowid (sqlite-db database)))
-
-(defmethod database-list-tables ((database sqlite-database) &key system-tables)
-  (declare (ignore system-tables))
-  ;; Query is copied from .table command of sqlite comamnd 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 '())))
-
-(declaim (inline sqlite-table-info))
-(defun sqlite-table-info (table database)
-  (database-query (format nil "PRAGMA table_info('~A')" table)
-                         database '()))
+     database)
+    (sqlite:sqlite-last-insert-rowid (sqlite-db database))
+    (parse-integer
+     (caar (database-query (format nil "SELECT id from ~A" table-name)
+                           database nil)))))
 
-(defmethod database-list-attributes (table (database sqlite-database))
-  (mapcar #'(lambda (table-info) (third table-info))
-         (sqlite-table-info table database)))
+(defmethod database-set-sequence-position (sequence-name
+                                           (position integer)
+                                           (database sqlite-database))
+  (let ((table-name (%sequence-name-to-table-name sequence-name)))
+    (database-execute-command
+     (format nil "UPDATE ~A SET id=~A" table-name position)
+     database)
+    (sqlite:sqlite-last-insert-rowid (sqlite-db database))))
 
-(defmethod database-attribute-type (attribute table 
-                                   (database sqlite-database))
-  (loop for field-info in (sqlite-table-info table database)
-       when (string= attribute (second field-info))
-       return (third field-info)))
+(defmethod database-sequence-last (sequence-name (database sqlite-database))
+  (declare (ignore sequence-name database)))
\ No newline at end of file
index 7e9bd4c..480160e 100644 (file)
@@ -1,3 +1,9 @@
+cl-sql (2.0.0-1) unstable; urgency=low
+
+  * New upstream, integrating patch from Marcus Pearce
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Fri,  2 Apr 2004 13:34:35 -0700
+
 cl-sql (1.9.2-1) unstable; urgency=low
 
   * Automatically detect mysql version