r2741: Start migration to pathname-less asd files, remove .system files

diff --git a/base/.cvsignore b/base/.cvsignore
new file mode 100644 (file)
index 0000000..ca8d09f
--- /dev/null
+++ b/base/.cvsignore
@@ -0,0 +1 @@
+.bin

diff --git a/base/Makefile b/base/Makefile
new file mode 100644 (file)
index 0000000..31dc910
--- /dev/null
+++ b/base/Makefile
@@ -0,0 +1,6 @@
+SUBDIRS                := 
+
+include ../Makefile.common
+
+.PHONY: distclean
+distclean: clean

diff --git a/base/classes.cl b/base/classes.cl
new file mode 100644 (file)
index 0000000..26dbf71
--- /dev/null
+++ b/base/classes.cl
@@ -0,0 +1,55 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          classes.cl
+;;;; Purpose:       Classes for High-level SQL interface
+;;;; Programmers:   Kevin M. Rosenberg based on
+;;;;                 original code by Pierre R. Mai 
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: classes.cl,v 1.4 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-base-sys)
+
+
+(defclass database ()
+  ((name :initform nil :initarg :name :reader database-name)
+   (connection-spec :initform nil :initarg :connection-spec :reader connection-spec
+                   :documentation "Require to use connection pool")
+   (transaction-level :initform 0 :accessor transaction-level)
+   (transaction :initform nil :accessor transaction)
+   (conn-pool :initform nil :initarg :conn-pool :accessor conn-pool))
+  (:documentation
+   "This class is the supertype of all databases handled by CLSQL."))
+
+(defmethod print-object ((object database) stream)
+  (print-unreadable-object (object stream :type t :identity t)
+    (write-string (if (slot-boundp object 'name)
+                     (database-name object)
+                     "<unbound>")
+                 stream)))
+
+;; Closed database idea and original code comes from UncommonSQL
+
+(defclass closed-database ()
+  ((name :initarg :name :reader database-name))
+  (:documentation
+   "This class represents databases after they are closed via 'disconnect'."))
+
+(defmethod print-object ((object closed-database) stream)
+  (print-unreadable-object (object stream :type t :identity t)
+    (write-string (if (slot-boundp object 'name)
+                     (database-name object)
+                     "<unbound>")
+                 stream)))
+

diff --git a/base/cmucl-compat.cl b/base/cmucl-compat.cl
new file mode 100644 (file)
index 0000000..4f65794
--- /dev/null
+++ b/base/cmucl-compat.cl
@@ -0,0 +1,115 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          cmucl-compat.sql
+;;;; Purpose:       Compatiblity library for CMUCL functions
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: cmucl-compat.cl,v 1.3 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defpackage :cmucl-compat
+  (:export
+   #:shrink-vector
+   #:make-sequence-of-type
+   #:result-type-or-lose
+   #:required-argument
+   ))
+(in-package :cmucl-compat)
+
+#+cmu
+(defmacro required-argument ()
+  `(ext:required-argument))
+
+#-cmu
+(defun required-argument ()
+  (error "~&A required keyword argument was not supplied"))
+
+#+cmu
+(defmacro shrink-vector (vec len)
+  `(lisp::shrink-vector ,vec ,len))
+
+#-cmu
+(defmacro shrink-vector (vec len)
+  "Shrinks a vector. Optimized if vector has a fill pointer.
+Needs to be a macro to overwrite value of VEC."
+  (let ((new-vec (gensym)))
+    `(cond
+      ((adjustable-array-p ,vec)
+       (adjust-array ,vec ,len))
+      ((typep ,vec 'simple-array)
+       (let ((,new-vec (make-array ,len :element-type
+                                  (array-element-type ,vec))))
+        (dotimes (i ,len)
+          (declare (fixnum i))
+          (setf (aref ,new-vec i) (aref ,vec i)))
+        (setq ,vec ,new-vec)))
+      ((typep ,vec 'vector)
+       (setf (fill-pointer ,vec) ,len)
+       ,vec)
+      (t
+       (error "Unable to shrink vector ~S which is type-of ~S" ,vec (type-of ,vec))) 
+       )))
+
+
+
+#-cmu
+(defun make-sequence-of-type (type length)
+  "Returns a sequence of the given TYPE and LENGTH."
+  (declare (fixnum length))
+  (case type
+    (list 
+     (make-list length))
+    ((bit-vector simple-bit-vector) 
+     (make-array length :element-type '(mod 2)))
+    ((string simple-string base-string simple-base-string)
+     (make-string length))
+    (simple-vector 
+     (make-array length))
+    ((array simple-array vector)
+     (if (listp type)
+        (make-array length :element-type (cadr type))
+       (make-array length)))
+    (t
+     (make-sequence-of-type (result-type-or-lose type t) length))))
+
+
+#+cmu
+(if (fboundp 'lisp::make-sequence-of-type)
+    (defun make-sequence-of-type (type len)
+      (lisp::make-sequence-of-type type len))
+  (defun make-sequence-of-type (type len)
+    (system::make-sequence-of-type type len)))
+  
+
+#-cmu
+(defun result-type-or-lose (type nil-ok)
+  (unless (or type nil-ok)
+    (error "NIL output type invalid for this sequence function"))
+  (case type
+    ((list cons)
+     'list)
+    ((string simple-string base-string simple-base-string)
+     'string)
+    (simple-vector
+     'simple-vector)
+    (vector
+     'vector)
+    (t
+     (error "~S is a bad type specifier for sequence functions." type))
+    ))
+
+#+cmu
+(defun result-type-or-lose (type nil-ok)
+  (lisp::result-type-or-lose type nil-ok))

diff --git a/base/conditions.cl b/base/conditions.cl
new file mode 100644 (file)
index 0000000..c713f20
--- /dev/null
+++ b/base/conditions.cl
@@ -0,0 +1,160 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          conditions.cl
+;;;; Purpose:       Error conditions for high-level SQL interface
+;;;; Programmers:   Kevin M. Rosenberg based on
+;;;;                 Original code by Pierre R. Mai 
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: conditions.cl,v 1.4 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-base-sys)
+
+;;; Conditions
+(define-condition clsql-condition ()
+  ())
+
+(define-condition clsql-error (error clsql-condition)
+  ())
+
+(define-condition clsql-simple-error (simple-condition clsql-error)
+  ())
+
+(define-condition clsql-warning (warning clsql-condition)
+  ())
+
+(define-condition clsql-simple-warning (simple-condition clsql-warning)
+  ())
+
+(define-condition clsql-invalid-spec-error (clsql-error)
+  ((connection-spec :initarg :connection-spec
+                   :reader clsql-invalid-spec-error-connection-spec)
+   (database-type :initarg :database-type
+                 :reader clsql-invalid-spec-error-database-type)
+   (template :initarg :template
+            :reader clsql-invalid-spec-error-template))
+  (:report (lambda (c stream)
+            (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
+                    (clsql-invalid-spec-error-connection-spec c)
+                    (clsql-invalid-spec-error-database-type c)
+                    (clsql-invalid-spec-error-template c)))))
+
+(defmacro check-connection-spec (connection-spec database-type template)
+  "Check the connection specification against the provided template,
+and signal an clsql-invalid-spec-error if they don't match."
+  `(handler-case
+    (destructuring-bind ,template ,connection-spec 
+      (declare (ignore ,@template))
+      t)
+    (error () (error 'clsql-invalid-spec-error
+                    :connection-spec ,connection-spec
+                    :database-type ,database-type
+                    :template (quote ,template)))))
+
+(define-condition clsql-connect-error (clsql-error)
+  ((database-type :initarg :database-type
+                 :reader clsql-connect-error-database-type)
+   (connection-spec :initarg :connection-spec
+                   :reader clsql-connect-error-connection-spec)
+   (errno :initarg :errno :reader clsql-connect-error-errno)
+   (error :initarg :error :reader clsql-connect-error-error))
+  (:report (lambda (c stream)
+            (format stream "While trying to connect to database ~A~%  using database-type ~A:~%  Error ~D / ~A~%  has occurred."
+                    (database-name-from-spec
+                     (clsql-connect-error-connection-spec c)
+                     (clsql-connect-error-database-type c))
+                    (clsql-connect-error-database-type c)
+                    (clsql-connect-error-errno c)
+                    (clsql-connect-error-error c)))))
+
+(define-condition clsql-sql-error (clsql-error)
+  ((database :initarg :database :reader clsql-sql-error-database)
+   (expression :initarg :expression :reader clsql-sql-error-expression)
+   (errno :initarg :errno :reader clsql-sql-error-errno)
+   (error :initarg :error :reader clsql-sql-error-error))
+  (:report (lambda (c stream)
+            (format stream "While accessing database ~A~%  with expression ~S:~%  Error ~D / ~A~%  has occurred."
+                    (clsql-sql-error-database c)
+                    (clsql-sql-error-expression c)
+                    (clsql-sql-error-errno c)
+                    (clsql-sql-error-error c)))))
+
+(define-condition clsql-database-warning (clsql-warning)
+  ((database :initarg :database :reader clsql-database-warning-database)
+   (message :initarg :message :reader clsql-database-warning-message))
+  (:report (lambda (c stream)
+            (format stream "While accessing database ~A~%  Warning: ~A~%  has occurred."
+                    (clsql-database-warning-database c)
+                    (clsql-database-warning-message c)))))
+
+(define-condition clsql-exists-condition (clsql-condition)
+   ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
+    (new-db :initarg :new-db :reader clsql-exists-condition-new-db
+           :initform nil))
+   (:report (lambda (c stream)
+             (format stream "In call to ~S:~%" 'connect)
+             (cond
+               ((null (clsql-exists-condition-new-db c))
+                (format stream
+                        "  There is an existing connection ~A to database ~A."
+                        (clsql-exists-condition-old-db c)
+                        (database-name (clsql-exists-condition-old-db c))))
+               ((eq (clsql-exists-condition-new-db c)
+                    (clsql-exists-condition-old-db c))
+                (format stream
+                        "  Using existing connection ~A to database ~A."
+                        (clsql-exists-condition-old-db c)
+                        (database-name (clsql-exists-condition-old-db c))))
+               (t
+                (format stream
+                        "  Created new connection ~A to database ~A~%  ~
+although there is an existing connection (~A)."
+                        (clsql-exists-condition-new-db c)
+                        (database-name (clsql-exists-condition-new-db c))
+                        (clsql-exists-condition-old-db c)))))))
+
+(define-condition clsql-exists-warning (clsql-exists-condition
+                                        clsql-warning)
+  ())
+
+(define-condition clsql-exists-error (clsql-exists-condition
+                                      clsql-error)
+  ())
+
+(define-condition clsql-closed-error (clsql-error)
+  ((database :initarg :database :reader clsql-closed-error-database))
+  (:report (lambda (c stream)
+            (format stream "The database ~A has already been closed."
+                    (clsql-closed-error-database c)))))
+
+(define-condition clsql-nodb-error (clsql-error)
+  ((database :initarg :database :reader clsql-nodb-error-database))
+  (:report (lambda (c stream)
+            (format stream "No such database ~S is open." 
+                    (clsql-nodb-error-database c)))))
+
+
+;; Signal conditions
+
+
+(defun signal-closed-database-error (database)
+  (cerror "Ignore this error and return nil."
+         'clsql-closed-error
+         :database database))
+
+(defun signal-nodb-error (database)
+  (cerror "Ignore this error and return nil."
+         'clsql-nodb-error
+         :database database))
+

diff --git a/base/db-interface.cl b/base/db-interface.cl
new file mode 100644 (file)
index 0000000..b6c99f4
--- /dev/null
+++ b/base/db-interface.cl
@@ -0,0 +1,181 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          db-interface.cl
+;;;; Purpose:       Generic function definitions for DB interfaces
+;;;; Programmers:   Kevin M. Rosenberg based on
+;;;;                Original code by Pierre R. Mai. Additions from
+;;;;                onShoreD to support UncommonSQL front-end 
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: db-interface.cl,v 1.4 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai, and onShoreD
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-base-sys)
+
+(defgeneric database-type-load-foreign (database-type)
+  (:documentation
+   "The internal generic implementation of reload-database-types."))
+
+(defgeneric database-type-library-loaded (database-type)
+  (:documentation
+   "The internal generic implementation for checking if
+database type library loaded successfully."))
+
+(defgeneric database-type (database)
+  (:documentation
+   "Returns database type")
+  (:method (database)
+          (signal-nodb-error database)))
+
+
+(defgeneric database-initialize-database-type (database-type)
+  (:documentation
+   "The internal generic implementation of initialize-database-type."))
+
+(defgeneric database-name-from-spec (connection-spec database-type)
+  (:documentation
+   "Returns the name of the database that would be created if connect
+was called with the connection-spec."))
+
+(defgeneric database-connect (connection-spec database-type)
+  (:documentation "Internal generic implementation of connect."))
+
+(defgeneric database-disconnect (database)
+  (:method ((database closed-database))
+          (signal-closed-database-error database))
+  (:method ((database t))
+          (signal-nodb-error database))
+  (:documentation "Internal generic implementation of disconnect."))
+
+(defgeneric database-query (query-expression database types)
+  (:method (query-expression (database closed-database) types)
+          (declare (ignore query-expression types))
+          (signal-closed-database-error database))  
+  (:method (query-expression (database t) types)
+          (declare (ignore query-expression types))
+          (signal-nodb-error database))
+  (:documentation "Internal generic implementation of query."))
+
+
+(defgeneric database-execute-command (sql-expression database)
+  (:method (sql-expression (database closed-database))
+          (declare (ignore sql-expression))
+          (signal-closed-database-error database))
+  (:method (sql-expression (database t))
+          (declare (ignore sql-expression))
+          (signal-nodb-error database))
+  (:documentation "Internal generic implementation of execute-command."))
+
+;;; Mapping and iteration
+(defgeneric database-query-result-set
+    (query-expression database &key full-set types)
+  (:method (query-expression (database closed-database) &key full-set types)
+          (declare (ignore query-expression full-set types))
+          (signal-closed-database-error database)
+          (values nil nil nil))
+  (:method (query-expression (database t) &key full-set types)
+          (declare (ignore query-expression full-set types))
+          (signal-nodb-error database)
+          (values nil nil nil))
+  (:documentation
+   "Internal generic implementation of query mapping.  Starts the
+query specified by query-expression on the given database and returns
+a result-set to be used with database-store-next-row and
+database-dump-result-set to access the returned data.  The second
+value is the number of columns in the result-set, if there are any.
+If full-set is true, the number of rows in the result-set is returned
+as a third value, if this is possible (otherwise nil is returned for
+the third value).  This might have memory and resource usage
+implications, since many databases will require the query to be
+executed in full to answer this question.  If the query produced no
+results then nil is returned for all values that would have been
+returned otherwise.  If an error occurs during query execution, the
+function should signal a clsql-sql-error."))
+
+(defgeneric database-dump-result-set (result-set database)
+  (:method (result-set (database closed-database))
+          (declare (ignore result-set))
+          (signal-closed-database-error database))
+  (:method (result-set (database t))
+          (declare (ignore result-set))
+          (signal-nodb-error database))
+  (:documentation "Dumps the received result-set."))
+
+(defgeneric database-store-next-row (result-set database list)
+  (:method (result-set (database closed-database) list)
+          (declare (ignore result-set list))
+          (signal-closed-database-error database))
+  (:method (result-set (database t) list)
+          (declare (ignore result-set list))
+          (signal-nodb-error database))
+  (:documentation
+   "Returns t and stores the next row in the result set in list or
+returns nil when result-set is finished."))
+
+
+;; Interfaces to support UncommonSQL
+
+(defgeneric database-create-sequence (name database)
+  (:documentation "Create a sequence in DATABASE."))
+
+(defgeneric database-drop-sequence (name database)
+  (:documentation "Drop a sequence from DATABASE."))
+
+(defgeneric database-sequence-next (name database)
+  (:documentation "Increment a sequence in DATABASE."))
+
+(defgeneric database-start-transaction (database)
+  (:documentation "Start a transaction in DATABASE."))
+
+(defgeneric database-commit-transaction (database)
+  (:documentation "Commit current transaction in DATABASE."))
+
+(defgeneric database-abort-transaction (database)
+  (:documentation "Abort current transaction in DATABASE."))
+
+(defgeneric database-get-type-specifier (type args database)
+  (: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 nil))
+  (:documentation "List all tables in the given database"))
+
+(defgeneric database-list-attributes (table database)
+  (:documentation "List all attributes in TABLE."))
+
+(defgeneric database-attribute-type (attribute table database)
+  (:documentation "Return the type of ATTRIBUTE in TABLE."))
+
+(defgeneric database-add-attribute (table attribute database)
+  (:documentation "Add the attribute to the table."))
+
+(defgeneric database-rename-attribute (table oldatt newname database)
+  (:documentation "Rename the attribute in the table to NEWNAME."))
+
+(defgeneric oid (object)
+  (:documentation "Return the unique ID of a database object."))
+
+ 
+;;; Large objects support (Marc Battyani)
+
+(defgeneric database-create-large-object (database)
+  (:documentation "Creates a new large object in the database and returns the object identifier"))
+
+(defgeneric database-write-large-object (object-id (data string) database)
+  (:documentation "Writes data to the large object"))
+
+(defgeneric database-read-large-object (object-id database)
+  (:documentation "Reads the large object content"))
+
+(defgeneric database-delete-large-object (object-id database)
+  (:documentation "Deletes the large object in the database"))

diff --git a/base/initialize.cl b/base/initialize.cl
new file mode 100644 (file)
index 0000000..6215376
--- /dev/null
+++ b/base/initialize.cl
@@ -0,0 +1,51 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          initialize.cl
+;;;; Purpose:       Initializion routines for backend
+;;;; Programmers:   Kevin M. Rosenberg 
+;;;; Date Started:  May 2002
+;;;;
+;;;; $Id: initialize.cl,v 1.4 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-base-sys)
+
+(defvar *loaded-database-types* nil
+  "Contains a list of database types which have been defined/loaded.")
+
+(defmethod database-type-load-foreign :after (database-type)
+  (when (database-type-library-loaded database-type)
+     (pushnew database-type *loaded-database-types*)))
+
+(defun reload-database-types ()
+  "Reloads any foreign code for the loaded database types after a dump."
+  (mapc #'database-type-load-foreign *loaded-database-types*))
+
+(defvar *default-database-type* nil
+  "Specifies the default type of database.  Currently only :mysql is
+supported.")
+
+(defvar *initialized-database-types* nil
+  "Contains a list of database types which have been initialized by calls
+to initialize-database-type.")
+
+(defun initialize-database-type (&key (database-type *default-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
+      (when (database-initialize-database-type database-type)
+       (push database-type *initialized-database-types*)
+       t)))
+
+

diff --git a/base/package.cl b/base/package.cl
new file mode 100644 (file)
index 0000000..8f8fc4a
--- /dev/null
+++ b/base/package.cl
@@ -0,0 +1,128 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          package.cl
+;;;; Purpose:       Package definition for base (low-level) SQL interface
+;;;; Programmers:   Kevin M. Rosenberg based on
+;;;;                Original code by Pierre R. Mai 
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: package.cl,v 1.8 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+;;;; This file makes the required package definitions for CLSQL's
+;;;; core packages.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+(defpackage :clsql-base-sys
+  (:use :common-lisp)
+  (:export
+     ;; "Private" exports for use by interface packages
+     #:check-connection-spec
+     #:database-type-load-foreign
+     #:database-type-library-loaded ;; KMR - Tests if foreign library okay
+     #:database-initialize-database-type
+     #:database-connect
+     #:database-disconnect
+     #:database-query
+     #:database-execute-command
+     #:database-query-result-set
+     #:database-dump-result-set
+     #:database-store-next-row
+     
+     ;; For UncommonSQL support
+     #:database-list-tables
+     #:database-list-attributes
+     #:database-attribute-type
+     #:database-create-sequence 
+     #:database-drop-sequence
+     #:database-sequence-next
+     #:sql-escape
+
+     ;; Support for pooled connections
+     #:database-type
+
+     ;; Large objects (Marc B)
+     #:database-create-large-object
+     #:database-write-large-object
+     #:database-read-large-object
+     #:database-delete-large-object
+     
+     ;; Shared exports for re-export by CLSQL-BASE
+     .
+     #1=(#:clsql-condition
+        #:clsql-error
+        #:clsql-simple-error
+        #:clsql-warning
+        #:clsql-simple-warning
+        #:clsql-invalid-spec-error
+        #:clsql-invalid-spec-error-connection-spec
+        #:clsql-invalid-spec-error-database-type
+        #:clsql-invalid-spec-error-template
+        #:clsql-connect-error
+        #:clsql-connect-error-database-type
+        #:clsql-connect-error-connection-spec
+        #:clsql-connect-error-errno
+        #:clsql-connect-error-error
+        #:clsql-sql-error
+        #:clsql-sql-error-database
+        #:clsql-sql-error-expression
+        #:clsql-sql-error-errno
+        #:clsql-sql-error-error
+        #:clsql-database-warning
+        #:clsql-database-warning-database
+        #:clsql-database-warning-message
+        #:clsql-exists-condition
+        #:clsql-exists-condition-new-db
+        #:clsql-exists-condition-old-db
+        #:clsql-exists-warning
+        #:clsql-exists-error
+        #:clsql-closed-error
+        #:clsql-closed-error-database
+        
+        #:*loaded-database-types*
+        #:reload-database-types
+        #:*default-database-type*
+        #:*initialized-database-types*
+        #:initialize-database-type
+        #:*connect-if-exists*
+        #:*default-database*
+        #:connected-databases
+        #:database
+        #:database-name
+        #:closed-database
+        #:find-database
+        #:database-name-from-spec
+
+        ;; accessors for database class
+        #:name
+        #:connection-spec
+        #:transaction
+        #:transaction-level
+        #:conn-pool
+        
+        ;; utils.cl
+        #:number-to-sql-string
+        #:float-to-sql-string
+        #:sql-escape-quotes
+        ))
+    (:documentation "This is the INTERNAL SQL-Interface package of CLSQL-BASE."))
+
+(defpackage #:clsql-base
+    (:import-from :clsql-base-sys . #1#)
+    (:export . #1#)
+    (:documentation "This is the SQL-Interface package of CLSQL-BASE."))
+);eval-when
+
+

diff --git a/base/utils.cl b/base/utils.cl
new file mode 100644 (file)
index 0000000..93d5ece
--- /dev/null
+++ b/base/utils.cl
@@ -0,0 +1,65 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:         utils.cl
+;;;; Purpose:      SQL utility functions
+;;;; Programmer:   Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: utils.cl,v 1.6 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-base-sys)
+
+(defun number-to-sql-string (num)
+  (etypecase num
+    (integer
+     num)
+    (rational
+     (float-to-sql-string (coerce num 'double-float)))
+    (number
+     (float-to-sql-string num))))
+
+(defun float-to-sql-string (num)
+  "Convert exponent character for SQL"
+  (substitute #\e #\f (substitute #\e #\d (write-to-string num :readably t))))
+
+(defun sql-escape (identifier)
+  "Change hyphens to underscores, ensure string"
+  (let* ((unescaped (etypecase identifier
+                      (symbol (symbol-name identifier))
+                      (string identifier)))
+         (escaped (make-string (length unescaped))))
+    (dotimes (i (length unescaped))
+      (setf (char escaped i)
+            (cond ((equal (char unescaped i) #\-)
+                   #\_)
+                  ;; ...
+                  (t
+                   (char unescaped i)))))
+    escaped))
+
+
+(defun sql-escape-quotes (s)
+  "Escape quotes for SQL string writing"
+  (substitute-string-for-char s #\' "''"))
+
+(defun substitute-string-for-char (procstr match-char subst-str) 
+"Substitutes a string for a single matching character of a string"
+  (let ((pos (position match-char procstr)))
+    (if pos
+       (concatenate 'string
+         (subseq procstr 0 pos) subst-str
+         (substitute-string-for-char 
+          (subseq procstr (1+ pos)) match-char subst-str))
+      procstr)))
+
+

diff --git a/clsql-aodbc.asd b/clsql-aodbc.asd
index 7b046274f86bffcd619843fa08c758cfc7afe0d4..7e598167e7051d132b0b39b24a26616e599f2b19 100644 (file)
--- a/clsql-aodbc.asd
+++ b/clsql-aodbc.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;

-;;;; $Id: clsql-aodbc.asd,v 1.5 2002/09/06 10:56:13 kevin Exp $
+;;;; $Id: clsql-aodbc.asd,v 1.6 2002/09/17 17:16:43 kevin Exp $

 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;


@@ -16,18 +16,16 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 

-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))

 (in-package :asdf)
 
 (in-package :asdf)
 

-(defsystem clsql-aodbc
-    :pathname #.(format nil "~A:clsql-aodbc;"
-                       #+common-lisp-controller "cl-library"
-                       #-common-lisp-controller "clsql")
-    :components ((:file "aodbc-package")
-                (:file "aodbc-sql" :depends-on ("aodbc-package")))
+(defsystem :clsql-aodbc
+    :components
+    ((:module :clsql-aodbc
+             :components
+             ((:file "aodbc-package")
+              (:file "aodbc-sql" :depends-on ("aodbc-package")))))

     :depends-on (:clsql-base))
 
     :depends-on (:clsql-base))
 

-    

 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-aodbc)))) 
    "cl")
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-aodbc)))) 
    "cl")

diff --git a/clsql-aodbc.system b/clsql-aodbc.system
deleted file mode 100644 (file)
index 315ea62..0000000
--- a/clsql-aodbc.system
+++ /dev/null
@@ -1,32 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          clsql-aodbc.system
-;;;; Purpose:       Defsystem-3/4 definition file for CLSQL AODBC backend
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: clsql-aodbc.system,v 1.11 2002/09/06 10:56:13 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :make)
-
-(defsystem :clsql-aodbc
-  :source-pathname #.(format nil "~A:clsql-aodbc;"
-                            #+common-lisp-controller "cl-library"
-                            #-common-lisp-controller "clsql")
-
-  :source-extension "cl"
-  :components ((:file "aodbc-package")
-              (:file "aodbc-sql" :depends-on ("aodbc-package")))
-  :depends-on (:clsql-base))
-
-

diff --git a/clsql-base.asd b/clsql-base.asd
index 888f1f224d33624a459026e4cf8b5ff2ae748fa4..c45a806636a77db87437663feee2e3f31df543e7 100644 (file)
--- a/clsql-base.asd
+++ b/clsql-base.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;

-;;;; $Id: clsql-base.asd,v 1.9 2002/09/06 11:08:19 kevin Exp $
+;;;; $Id: clsql-base.asd,v 1.10 2002/09/17 17:16:43 kevin Exp $

 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;


@@ -16,38 +16,21 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 

-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))

 (in-package :asdf)
 
 (in-package :asdf)
 

-;; For use with non-Common Lisp Controller installations
-#-common-lisp-controller
-(let ((path (make-pathname :name "set-logical" :type "cl"
-                                     :defaults *load-truename*)))
-  (when (probe-file path)
-    (load path)
-    (set-logical-host-for-pathname 
-     "clsql" 
-     (make-pathname :host (pathname-host *load-truename*)
-                   :device (pathname-device *load-truename*)
-                   :directory (pathname-directory *load-truename*)))))
-
-
- ;;; System definitions
-

 (defsystem clsql-base
 (defsystem clsql-base

-    :pathname #.(format nil "~A:clsql-base;" 
-      #+common-lisp-controller "cl-library"
-      #-common-lisp-controller "clsql")

     :perform (load-op :after (op clsql-base)
                      (pushnew :clsql-base cl:*features*))
     :perform (load-op :after (op clsql-base)
                      (pushnew :clsql-base cl:*features*))

-    :components ((:file "cmucl-compat")
-                (:file "package")
-                (:file "utils" :depends-on ("package"))
-                (:file "classes" :depends-on ("package"))
-                (:file "conditions" :depends-on ("classes"))
-                (:file "db-interface" :depends-on ("conditions"))
-                (:file "initialize" :depends-on ("db-interface")))
-    )
+    :components
+    ((:module :base
+             :components
+             ((:file "cmucl-compat")
+              (:file "package")
+              (:file "utils" :depends-on ("package"))
+              (:file "classes" :depends-on ("package"))
+              (:file "conditions" :depends-on ("classes"))
+              (:file "db-interface" :depends-on ("conditions"))
+              (:file "initialize" :depends-on ("db-interface"))))))

 
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-base)))) 
 
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-base)))) 

diff --git a/clsql-base.system b/clsql-base.system
deleted file mode 100644 (file)
index fd8e4d2..0000000
--- a/clsql-base.system
+++ /dev/null
@@ -1,50 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          clsql-base.system
-;;;; Purpose:       Defsystem-3/4 for Base CLSQL
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: clsql-base.system,v 1.12 2002/09/06 10:56:13 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :make)
-
-;; For use with non-Common Lisp Controller installations
-#-common-lisp-controller
-(let ((path (make-pathname :name "set-logical" :type "cl"
-                                     :defaults *load-truename*)))
-  (when (probe-file path)
-    (load path)
-    (set-logical-host-for-pathname 
-     "clsql" 
-     (make-pathname :host (pathname-host *load-truename*)
-                   :device (pathname-device *load-truename*)
-                   :directory (pathname-directory *load-truename*)))))
-
-;;; System definitions
-
-(defsystem :clsql-base
-  :source-pathname #.(format nil "~A:clsql-base;"
-                            #+common-lisp-controller "cl-library"
-                            #-common-lisp-controller "clsql")
-  :source-extension "cl"
-  :components ((:file "cmucl-compat")
-              (:file "package")
-              (:file "utils" :depends-on ("package"))
-              (:file "classes" :depends-on ("package"))
-              (:file "conditions" :depends-on ("classes"))
-              (:file "db-interface" :depends-on ("conditions"))
-              (:file "initialize" :depends-on ("db-interface")))
-  :finally-do
-  (pushnew :clsql-base cl:*features*)
-  )

diff --git a/clsql-base/.cvsignore b/clsql-base/.cvsignore
deleted file mode 100644 (file)
index ca8d09f..0000000
--- a/clsql-base/.cvsignore
+++ /dev/null
@@ -1 +0,0 @@
-.bin

diff --git a/clsql-base/Makefile b/clsql-base/Makefile
deleted file mode 100644 (file)
index 31dc910..0000000
--- a/clsql-base/Makefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SUBDIRS                := 
-
-include ../Makefile.common
-
-.PHONY: distclean
-distclean: clean

diff --git a/clsql-base/classes.cl b/clsql-base/classes.cl
deleted file mode 100644 (file)
index 315fae9..0000000
--- a/clsql-base/classes.cl
+++ /dev/null
@@ -1,55 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          classes.cl
-;;;; Purpose:       Classes for High-level SQL interface
-;;;; Programmers:   Kevin M. Rosenberg based on
-;;;;                 original code by Pierre R. Mai 
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: classes.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-base-sys)
-
-
-(defclass database ()
-  ((name :initform nil :initarg :name :reader database-name)
-   (connection-spec :initform nil :initarg :connection-spec :reader connection-spec
-                   :documentation "Require to use connection pool")
-   (transaction-level :initform 0 :accessor transaction-level)
-   (transaction :initform nil :accessor transaction)
-   (conn-pool :initform nil :initarg :conn-pool :accessor conn-pool))
-  (:documentation
-   "This class is the supertype of all databases handled by CLSQL."))
-
-(defmethod print-object ((object database) stream)
-  (print-unreadable-object (object stream :type t :identity t)
-    (write-string (if (slot-boundp object 'name)
-                     (database-name object)
-                     "<unbound>")
-                 stream)))
-
-;; Closed database idea and original code comes from UncommonSQL
-
-(defclass closed-database ()
-  ((name :initarg :name :reader database-name))
-  (:documentation
-   "This class represents databases after they are closed via 'disconnect'."))
-
-(defmethod print-object ((object closed-database) stream)
-  (print-unreadable-object (object stream :type t :identity t)
-    (write-string (if (slot-boundp object 'name)
-                     (database-name object)
-                     "<unbound>")
-                 stream)))
-

diff --git a/clsql-base/cmucl-compat.cl b/clsql-base/cmucl-compat.cl
deleted file mode 100644 (file)
index e18fa0c..0000000
--- a/clsql-base/cmucl-compat.cl
+++ /dev/null
@@ -1,115 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          cmucl-compat.sql
-;;;; Purpose:       Compatiblity library for CMUCL functions
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: cmucl-compat.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :cl-user)
-
-(defpackage :cmucl-compat
-  (:export
-   #:shrink-vector
-   #:make-sequence-of-type
-   #:result-type-or-lose
-   #:required-argument
-   ))
-(in-package :cmucl-compat)
-
-#+cmu
-(defmacro required-argument ()
-  `(ext:required-argument))
-
-#-cmu
-(defun required-argument ()
-  (error "~&A required keyword argument was not supplied"))
-
-#+cmu
-(defmacro shrink-vector (vec len)
-  `(lisp::shrink-vector ,vec ,len))
-
-#-cmu
-(defmacro shrink-vector (vec len)
-  "Shrinks a vector. Optimized if vector has a fill pointer.
-Needs to be a macro to overwrite value of VEC."
-  (let ((new-vec (gensym)))
-    `(cond
-      ((adjustable-array-p ,vec)
-       (adjust-array ,vec ,len))
-      ((typep ,vec 'simple-array)
-       (let ((,new-vec (make-array ,len :element-type
-                                  (array-element-type ,vec))))
-        (dotimes (i ,len)
-          (declare (fixnum i))
-          (setf (aref ,new-vec i) (aref ,vec i)))
-        (setq ,vec ,new-vec)))
-      ((typep ,vec 'vector)
-       (setf (fill-pointer ,vec) ,len)
-       ,vec)
-      (t
-       (error "Unable to shrink vector ~S which is type-of ~S" ,vec (type-of ,vec))) 
-       )))
-
-
-
-#-cmu
-(defun make-sequence-of-type (type length)
-  "Returns a sequence of the given TYPE and LENGTH."
-  (declare (fixnum length))
-  (case type
-    (list 
-     (make-list length))
-    ((bit-vector simple-bit-vector) 
-     (make-array length :element-type '(mod 2)))
-    ((string simple-string base-string simple-base-string)
-     (make-string length))
-    (simple-vector 
-     (make-array length))
-    ((array simple-array vector)
-     (if (listp type)
-        (make-array length :element-type (cadr type))
-       (make-array length)))
-    (t
-     (make-sequence-of-type (result-type-or-lose type t) length))))
-
-
-#+cmu
-(if (fboundp 'lisp::make-sequence-of-type)
-    (defun make-sequence-of-type (type len)
-      (lisp::make-sequence-of-type type len))
-  (defun make-sequence-of-type (type len)
-    (system::make-sequence-of-type type len)))
-  
-
-#-cmu
-(defun result-type-or-lose (type nil-ok)
-  (unless (or type nil-ok)
-    (error "NIL output type invalid for this sequence function"))
-  (case type
-    ((list cons)
-     'list)
-    ((string simple-string base-string simple-base-string)
-     'string)
-    (simple-vector
-     'simple-vector)
-    (vector
-     'vector)
-    (t
-     (error "~S is a bad type specifier for sequence functions." type))
-    ))
-
-#+cmu
-(defun result-type-or-lose (type nil-ok)
-  (lisp::result-type-or-lose type nil-ok))

diff --git a/clsql-base/conditions.cl b/clsql-base/conditions.cl
deleted file mode 100644 (file)
index 4371ccc..0000000
--- a/clsql-base/conditions.cl
+++ /dev/null
@@ -1,160 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          conditions.cl
-;;;; Purpose:       Error conditions for high-level SQL interface
-;;;; Programmers:   Kevin M. Rosenberg based on
-;;;;                 Original code by Pierre R. Mai 
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: conditions.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-base-sys)
-
-;;; Conditions
-(define-condition clsql-condition ()
-  ())
-
-(define-condition clsql-error (error clsql-condition)
-  ())
-
-(define-condition clsql-simple-error (simple-condition clsql-error)
-  ())
-
-(define-condition clsql-warning (warning clsql-condition)
-  ())
-
-(define-condition clsql-simple-warning (simple-condition clsql-warning)
-  ())
-
-(define-condition clsql-invalid-spec-error (clsql-error)
-  ((connection-spec :initarg :connection-spec
-                   :reader clsql-invalid-spec-error-connection-spec)
-   (database-type :initarg :database-type
-                 :reader clsql-invalid-spec-error-database-type)
-   (template :initarg :template
-            :reader clsql-invalid-spec-error-template))
-  (:report (lambda (c stream)
-            (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
-                    (clsql-invalid-spec-error-connection-spec c)
-                    (clsql-invalid-spec-error-database-type c)
-                    (clsql-invalid-spec-error-template c)))))
-
-(defmacro check-connection-spec (connection-spec database-type template)
-  "Check the connection specification against the provided template,
-and signal an clsql-invalid-spec-error if they don't match."
-  `(handler-case
-    (destructuring-bind ,template ,connection-spec 
-      (declare (ignore ,@template))
-      t)
-    (error () (error 'clsql-invalid-spec-error
-                    :connection-spec ,connection-spec
-                    :database-type ,database-type
-                    :template (quote ,template)))))
-
-(define-condition clsql-connect-error (clsql-error)
-  ((database-type :initarg :database-type
-                 :reader clsql-connect-error-database-type)
-   (connection-spec :initarg :connection-spec
-                   :reader clsql-connect-error-connection-spec)
-   (errno :initarg :errno :reader clsql-connect-error-errno)
-   (error :initarg :error :reader clsql-connect-error-error))
-  (:report (lambda (c stream)
-            (format stream "While trying to connect to database ~A~%  using database-type ~A:~%  Error ~D / ~A~%  has occurred."
-                    (database-name-from-spec
-                     (clsql-connect-error-connection-spec c)
-                     (clsql-connect-error-database-type c))
-                    (clsql-connect-error-database-type c)
-                    (clsql-connect-error-errno c)
-                    (clsql-connect-error-error c)))))
-
-(define-condition clsql-sql-error (clsql-error)
-  ((database :initarg :database :reader clsql-sql-error-database)
-   (expression :initarg :expression :reader clsql-sql-error-expression)
-   (errno :initarg :errno :reader clsql-sql-error-errno)
-   (error :initarg :error :reader clsql-sql-error-error))
-  (:report (lambda (c stream)
-            (format stream "While accessing database ~A~%  with expression ~S:~%  Error ~D / ~A~%  has occurred."
-                    (clsql-sql-error-database c)
-                    (clsql-sql-error-expression c)
-                    (clsql-sql-error-errno c)
-                    (clsql-sql-error-error c)))))
-
-(define-condition clsql-database-warning (clsql-warning)
-  ((database :initarg :database :reader clsql-database-warning-database)
-   (message :initarg :message :reader clsql-database-warning-message))
-  (:report (lambda (c stream)
-            (format stream "While accessing database ~A~%  Warning: ~A~%  has occurred."
-                    (clsql-database-warning-database c)
-                    (clsql-database-warning-message c)))))
-
-(define-condition clsql-exists-condition (clsql-condition)
-   ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
-    (new-db :initarg :new-db :reader clsql-exists-condition-new-db
-           :initform nil))
-   (:report (lambda (c stream)
-             (format stream "In call to ~S:~%" 'connect)
-             (cond
-               ((null (clsql-exists-condition-new-db c))
-                (format stream
-                        "  There is an existing connection ~A to database ~A."
-                        (clsql-exists-condition-old-db c)
-                        (database-name (clsql-exists-condition-old-db c))))
-               ((eq (clsql-exists-condition-new-db c)
-                    (clsql-exists-condition-old-db c))
-                (format stream
-                        "  Using existing connection ~A to database ~A."
-                        (clsql-exists-condition-old-db c)
-                        (database-name (clsql-exists-condition-old-db c))))
-               (t
-                (format stream
-                        "  Created new connection ~A to database ~A~%  ~
-although there is an existing connection (~A)."
-                        (clsql-exists-condition-new-db c)
-                        (database-name (clsql-exists-condition-new-db c))
-                        (clsql-exists-condition-old-db c)))))))
-
-(define-condition clsql-exists-warning (clsql-exists-condition
-                                        clsql-warning)
-  ())
-
-(define-condition clsql-exists-error (clsql-exists-condition
-                                      clsql-error)
-  ())
-
-(define-condition clsql-closed-error (clsql-error)
-  ((database :initarg :database :reader clsql-closed-error-database))
-  (:report (lambda (c stream)
-            (format stream "The database ~A has already been closed."
-                    (clsql-closed-error-database c)))))
-
-(define-condition clsql-nodb-error (clsql-error)
-  ((database :initarg :database :reader clsql-nodb-error-database))
-  (:report (lambda (c stream)
-            (format stream "No such database ~S is open." 
-                    (clsql-nodb-error-database c)))))
-
-
-;; Signal conditions
-
-
-(defun signal-closed-database-error (database)
-  (cerror "Ignore this error and return nil."
-         'clsql-closed-error
-         :database database))
-
-(defun signal-nodb-error (database)
-  (cerror "Ignore this error and return nil."
-         'clsql-nodb-error
-         :database database))
-

diff --git a/clsql-base/db-interface.cl b/clsql-base/db-interface.cl
deleted file mode 100644 (file)
index 479534e..0000000
--- a/clsql-base/db-interface.cl
+++ /dev/null
@@ -1,181 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          db-interface.cl
-;;;; Purpose:       Generic function definitions for DB interfaces
-;;;; Programmers:   Kevin M. Rosenberg based on
-;;;;                Original code by Pierre R. Mai. Additions from
-;;;;                onShoreD to support UncommonSQL front-end 
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: db-interface.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai, and onShoreD
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-base-sys)
-
-(defgeneric database-type-load-foreign (database-type)
-  (:documentation
-   "The internal generic implementation of reload-database-types."))
-
-(defgeneric database-type-library-loaded (database-type)
-  (:documentation
-   "The internal generic implementation for checking if
-database type library loaded successfully."))
-
-(defgeneric database-type (database)
-  (:documentation
-   "Returns database type")
-  (:method (database)
-          (signal-nodb-error database)))
-
-
-(defgeneric database-initialize-database-type (database-type)
-  (:documentation
-   "The internal generic implementation of initialize-database-type."))
-
-(defgeneric database-name-from-spec (connection-spec database-type)
-  (:documentation
-   "Returns the name of the database that would be created if connect
-was called with the connection-spec."))
-
-(defgeneric database-connect (connection-spec database-type)
-  (:documentation "Internal generic implementation of connect."))
-
-(defgeneric database-disconnect (database)
-  (:method ((database closed-database))
-          (signal-closed-database-error database))
-  (:method ((database t))
-          (signal-nodb-error database))
-  (:documentation "Internal generic implementation of disconnect."))
-
-(defgeneric database-query (query-expression database types)
-  (:method (query-expression (database closed-database) types)
-          (declare (ignore query-expression types))
-          (signal-closed-database-error database))  
-  (:method (query-expression (database t) types)
-          (declare (ignore query-expression types))
-          (signal-nodb-error database))
-  (:documentation "Internal generic implementation of query."))
-
-
-(defgeneric database-execute-command (sql-expression database)
-  (:method (sql-expression (database closed-database))
-          (declare (ignore sql-expression))
-          (signal-closed-database-error database))
-  (:method (sql-expression (database t))
-          (declare (ignore sql-expression))
-          (signal-nodb-error database))
-  (:documentation "Internal generic implementation of execute-command."))
-
-;;; Mapping and iteration
-(defgeneric database-query-result-set
-    (query-expression database &key full-set types)
-  (:method (query-expression (database closed-database) &key full-set types)
-          (declare (ignore query-expression full-set types))
-          (signal-closed-database-error database)
-          (values nil nil nil))
-  (:method (query-expression (database t) &key full-set types)
-          (declare (ignore query-expression full-set types))
-          (signal-nodb-error database)
-          (values nil nil nil))
-  (:documentation
-   "Internal generic implementation of query mapping.  Starts the
-query specified by query-expression on the given database and returns
-a result-set to be used with database-store-next-row and
-database-dump-result-set to access the returned data.  The second
-value is the number of columns in the result-set, if there are any.
-If full-set is true, the number of rows in the result-set is returned
-as a third value, if this is possible (otherwise nil is returned for
-the third value).  This might have memory and resource usage
-implications, since many databases will require the query to be
-executed in full to answer this question.  If the query produced no
-results then nil is returned for all values that would have been
-returned otherwise.  If an error occurs during query execution, the
-function should signal a clsql-sql-error."))
-
-(defgeneric database-dump-result-set (result-set database)
-  (:method (result-set (database closed-database))
-          (declare (ignore result-set))
-          (signal-closed-database-error database))
-  (:method (result-set (database t))
-          (declare (ignore result-set))
-          (signal-nodb-error database))
-  (:documentation "Dumps the received result-set."))
-
-(defgeneric database-store-next-row (result-set database list)
-  (:method (result-set (database closed-database) list)
-          (declare (ignore result-set list))
-          (signal-closed-database-error database))
-  (:method (result-set (database t) list)
-          (declare (ignore result-set list))
-          (signal-nodb-error database))
-  (:documentation
-   "Returns t and stores the next row in the result set in list or
-returns nil when result-set is finished."))
-
-
-;; Interfaces to support UncommonSQL
-
-(defgeneric database-create-sequence (name database)
-  (:documentation "Create a sequence in DATABASE."))
-
-(defgeneric database-drop-sequence (name database)
-  (:documentation "Drop a sequence from DATABASE."))
-
-(defgeneric database-sequence-next (name database)
-  (:documentation "Increment a sequence in DATABASE."))
-
-(defgeneric database-start-transaction (database)
-  (:documentation "Start a transaction in DATABASE."))
-
-(defgeneric database-commit-transaction (database)
-  (:documentation "Commit current transaction in DATABASE."))
-
-(defgeneric database-abort-transaction (database)
-  (:documentation "Abort current transaction in DATABASE."))
-
-(defgeneric database-get-type-specifier (type args database)
-  (: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 nil))
-  (:documentation "List all tables in the given database"))
-
-(defgeneric database-list-attributes (table database)
-  (:documentation "List all attributes in TABLE."))
-
-(defgeneric database-attribute-type (attribute table database)
-  (:documentation "Return the type of ATTRIBUTE in TABLE."))
-
-(defgeneric database-add-attribute (table attribute database)
-  (:documentation "Add the attribute to the table."))
-
-(defgeneric database-rename-attribute (table oldatt newname database)
-  (:documentation "Rename the attribute in the table to NEWNAME."))
-
-(defgeneric oid (object)
-  (:documentation "Return the unique ID of a database object."))
-
- 
-;;; Large objects support (Marc Battyani)
-
-(defgeneric database-create-large-object (database)
-  (:documentation "Creates a new large object in the database and returns the object identifier"))
-
-(defgeneric database-write-large-object (object-id (data string) database)
-  (:documentation "Writes data to the large object"))
-
-(defgeneric database-read-large-object (object-id database)
-  (:documentation "Reads the large object content"))
-
-(defgeneric database-delete-large-object (object-id database)
-  (:documentation "Deletes the large object in the database"))

diff --git a/clsql-base/initialize.cl b/clsql-base/initialize.cl
deleted file mode 100644 (file)
index 0380f70..0000000
--- a/clsql-base/initialize.cl
+++ /dev/null
@@ -1,51 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          initialize.cl
-;;;; Purpose:       Initializion routines for backend
-;;;; Programmers:   Kevin M. Rosenberg 
-;;;; Date Started:  May 2002
-;;;;
-;;;; $Id: initialize.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-base-sys)
-
-(defvar *loaded-database-types* nil
-  "Contains a list of database types which have been defined/loaded.")
-
-(defmethod database-type-load-foreign :after (database-type)
-  (when (database-type-library-loaded database-type)
-     (pushnew database-type *loaded-database-types*)))
-
-(defun reload-database-types ()
-  "Reloads any foreign code for the loaded database types after a dump."
-  (mapc #'database-type-load-foreign *loaded-database-types*))
-
-(defvar *default-database-type* nil
-  "Specifies the default type of database.  Currently only :mysql is
-supported.")
-
-(defvar *initialized-database-types* nil
-  "Contains a list of database types which have been initialized by calls
-to initialize-database-type.")
-
-(defun initialize-database-type (&key (database-type *default-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
-      (when (database-initialize-database-type database-type)
-       (push database-type *initialized-database-types*)
-       t)))
-
-

diff --git a/clsql-base/package.cl b/clsql-base/package.cl
deleted file mode 100644 (file)
index dfca868..0000000
--- a/clsql-base/package.cl
+++ /dev/null
@@ -1,128 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          package.cl
-;;;; Purpose:       Package definition for base (low-level) SQL interface
-;;;; Programmers:   Kevin M. Rosenberg based on
-;;;;                Original code by Pierre R. Mai 
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: package.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :cl-user)
-
-;;;; This file makes the required package definitions for CLSQL's
-;;;; core packages.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defpackage :clsql-base-sys
-  (:use :common-lisp)
-  (:export
-     ;; "Private" exports for use by interface packages
-     #:check-connection-spec
-     #:database-type-load-foreign
-     #:database-type-library-loaded ;; KMR - Tests if foreign library okay
-     #:database-initialize-database-type
-     #:database-connect
-     #:database-disconnect
-     #:database-query
-     #:database-execute-command
-     #:database-query-result-set
-     #:database-dump-result-set
-     #:database-store-next-row
-     
-     ;; For UncommonSQL support
-     #:database-list-tables
-     #:database-list-attributes
-     #:database-attribute-type
-     #:database-create-sequence 
-     #:database-drop-sequence
-     #:database-sequence-next
-     #:sql-escape
-
-     ;; Support for pooled connections
-     #:database-type
-
-     ;; Large objects (Marc B)
-     #:database-create-large-object
-     #:database-write-large-object
-     #:database-read-large-object
-     #:database-delete-large-object
-     
-     ;; Shared exports for re-export by CLSQL-BASE
-     .
-     #1=(#:clsql-condition
-        #:clsql-error
-        #:clsql-simple-error
-        #:clsql-warning
-        #:clsql-simple-warning
-        #:clsql-invalid-spec-error
-        #:clsql-invalid-spec-error-connection-spec
-        #:clsql-invalid-spec-error-database-type
-        #:clsql-invalid-spec-error-template
-        #:clsql-connect-error
-        #:clsql-connect-error-database-type
-        #:clsql-connect-error-connection-spec
-        #:clsql-connect-error-errno
-        #:clsql-connect-error-error
-        #:clsql-sql-error
-        #:clsql-sql-error-database
-        #:clsql-sql-error-expression
-        #:clsql-sql-error-errno
-        #:clsql-sql-error-error
-        #:clsql-database-warning
-        #:clsql-database-warning-database
-        #:clsql-database-warning-message
-        #:clsql-exists-condition
-        #:clsql-exists-condition-new-db
-        #:clsql-exists-condition-old-db
-        #:clsql-exists-warning
-        #:clsql-exists-error
-        #:clsql-closed-error
-        #:clsql-closed-error-database
-        
-        #:*loaded-database-types*
-        #:reload-database-types
-        #:*default-database-type*
-        #:*initialized-database-types*
-        #:initialize-database-type
-        #:*connect-if-exists*
-        #:*default-database*
-        #:connected-databases
-        #:database
-        #:database-name
-        #:closed-database
-        #:find-database
-        #:database-name-from-spec
-
-        ;; accessors for database class
-        #:name
-        #:connection-spec
-        #:transaction
-        #:transaction-level
-        #:conn-pool
-        
-        ;; utils.cl
-        #:number-to-sql-string
-        #:float-to-sql-string
-        #:sql-escape-quotes
-        ))
-    (:documentation "This is the INTERNAL SQL-Interface package of CLSQL-BASE."))
-
-(defpackage #:clsql-base
-    (:import-from :clsql-base-sys . #1#)
-    (:export . #1#)
-    (:documentation "This is the SQL-Interface package of CLSQL-BASE."))
-);eval-when
-
-

diff --git a/clsql-base/utils.cl b/clsql-base/utils.cl
deleted file mode 100644 (file)
index b26ee9e..0000000
--- a/clsql-base/utils.cl
+++ /dev/null
@@ -1,65 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:         utils.cl
-;;;; Purpose:      SQL utility functions
-;;;; Programmer:   Kevin M. Rosenberg
-;;;; Date Started: Mar 2002
-;;;;
-;;;; $Id: utils.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-base-sys)
-
-(defun number-to-sql-string (num)
-  (etypecase num
-    (integer
-     num)
-    (rational
-     (float-to-sql-string (coerce num 'double-float)))
-    (number
-     (float-to-sql-string num))))
-
-(defun float-to-sql-string (num)
-  "Convert exponent character for SQL"
-  (substitute #\e #\f (substitute #\e #\d (write-to-string num :readably t))))
-
-(defun sql-escape (identifier)
-  "Change hyphens to underscores, ensure string"
-  (let* ((unescaped (etypecase identifier
-                      (symbol (symbol-name identifier))
-                      (string identifier)))
-         (escaped (make-string (length unescaped))))
-    (dotimes (i (length unescaped))
-      (setf (char escaped i)
-            (cond ((equal (char unescaped i) #\-)
-                   #\_)
-                  ;; ...
-                  (t
-                   (char unescaped i)))))
-    escaped))
-
-
-(defun sql-escape-quotes (s)
-  "Escape quotes for SQL string writing"
-  (substitute-string-for-char s #\' "''"))
-
-(defun substitute-string-for-char (procstr match-char subst-str) 
-"Substitutes a string for a single matching character of a string"
-  (let ((pos (position match-char procstr)))
-    (if pos
-       (concatenate 'string
-         (subseq procstr 0 pos) subst-str
-         (substitute-string-for-char 
-          (subseq procstr (1+ pos)) match-char subst-str))
-      procstr)))
-
-

diff --git a/clsql-mysql.asd b/clsql-mysql.asd
index 9e17055ffeb2bcc5fa8eee15e4e28f7f2c249d31..0af451fea2caf7f157d0fcf58ff84463cb520454 100644 (file)
--- a/clsql-mysql.asd
+++ b/clsql-mysql.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg\r
 ;;;; Date Started:  Aug 2002\r
 ;;;;\r
 ;;;; Programmer:    Kevin M. Rosenberg\r
 ;;;; Date Started:  Aug 2002\r
 ;;;;\r

-;;;; $Id: clsql-mysql.asd,v 1.5 2002/09/06 10:56:13 kevin Exp $\r
+;;;; $Id: clsql-mysql.asd,v 1.6 2002/09/17 17:16:43 kevin Exp $\r

 ;;;;\r
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
 ;;;;\r
 ;;;;\r
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
 ;;;;\r


@@ -22,19 +22,17 @@
 \r
 ;;; System definition\r
 \r
 \r
 ;;; System definition\r
 \r

-(defsystem clsql-mysql\r
-    :pathname #.(format nil "~A:clsql-mysql;"\r
-                       #+common-lisp-controller "cl-library"\r
-                       #-common-lisp-controller "clsql")\r
-    :components ((:file "mysql-package")\r
-                (:file "mysql-loader" :depends-on ("mysql-package"))\r
-                (:file "mysql-api" :depends-on ("mysql-loader"))\r
-                (:file "mysql-sql" :depends-on ("mysql-api"))\r
-                (:file "mysql-usql" :depends-on ("mysql-sql")))\r
-    :depends-on (:uffi :clsql-base :clsql-uffi))\r
-\r
-\r
+(defsystem :clsql-mysql\r
+  :components\r
+  ((:module :mysql\r
+           :components\r
+           ((:file "mysql-package")\r
+            (:file "mysql-loader" :depends-on ("mysql-package"))\r
+            (:file "mysql-api" :depends-on ("mysql-loader"))\r
+            (:file "mysql-sql" :depends-on ("mysql-api"))\r
+            (:file "mysql-usql" :depends-on ("mysql-sql")))))\r
+  :depends-on (:uffi :clsql-base :clsql-uffi))\r
+   \r

 (defmethod source-file-type  ((c cl-source-file)\r
                              (s (eql (find-system 'clsql-mysql)))) \r
    "cl")\r
 (defmethod source-file-type  ((c cl-source-file)\r
                              (s (eql (find-system 'clsql-mysql)))) \r
    "cl")\r

-\r

diff --git a/clsql-mysql.system b/clsql-mysql.system
deleted file mode 100644 (file)
index 5bea359..0000000
--- a/clsql-mysql.system
+++ /dev/null
@@ -1,40 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
-;;;; *************************************************************************\r
-;;;; FILE IDENTIFICATION\r
-;;;;\r
-;;;; Name:          clsql-mysql.system\r
-;;;; Purpose:       Defsystem-3/4 definition file for CLSQL MySQL backend\r
-;;;; Programmer:    Kevin M. Rosenberg\r
-;;;; Date Started:  Feb 2002\r
-;;;;\r
-;;;; $Id: clsql-mysql.system,v 1.18 2002/09/06 10:56:13 kevin Exp $\r
-;;;;\r
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
-;;;;\r
-;;;; CLSQL users are granted the rights to distribute and use this software\r
-;;;; as governed by the terms of the Lisp Lesser GNU Public License\r
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.\r
-;;;; *************************************************************************\r
-\r
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))\r
-\r
-(in-package :make)\r
-\r
-;;; System definition\r
-\r
-(defsystem :clsql-mysql\r
-  :source-pathname #.(format nil "~A:clsql-mysql;"\r
-                            #+common-lisp-controller "cl-library"\r
-                            #-common-lisp-controller "clsql")\r
-  :source-extension "cl"\r
-  :components ((:file "mysql-package")\r
-              (:file "mysql-loader" :depends-on ("mysql-package"))\r
-              (:file "mysql-api" :depends-on ("mysql-loader"))\r
-              (:file "mysql-sql" :depends-on ("mysql-api"))\r
-              (:file "mysql-usql" :depends-on ("mysql-sql")))\r
-  :depends-on (:uffi :clsql-base :clsql-uffi))\r
-\r
-\r
-\r
-\r
-\r

diff --git a/clsql-oracle.asd b/clsql-oracle.asd
index b6947925d8d86e1205324145de1a94659a09bfc2..922772111e6e202995e695bea6d72797fa2dec7c 100644 (file)
--- a/clsql-oracle.asd
+++ b/clsql-oracle.asd
@@ -1,28 +1,25 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; This is copyrighted software.  See interfaces/oracle/* files for terms.
 ;;;; 
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; This is copyrighted software.  See interfaces/oracle/* files for terms.
 ;;;; 

-;;;; $Id: clsql-oracle.asd,v 1.5 2002/09/06 10:56:13 kevin Exp $
+;;;; $Id: clsql-oracle.asd,v 1.6 2002/09/17 17:16:43 kevin Exp $

 
 (in-package :asdf)
 
 ;;; System definition
 
 (defsystem :clsql-oracle
 
 (in-package :asdf)
 
 ;;; System definition
 
 (defsystem :clsql-oracle

-    :pathname #.(format nil "~A:clsql-oracle;"
-                       #+common-lisp-controller "cl-library"
-                       #-common-lisp-controller "clsql")
-    :pathname "cl-library:clsql-oracle"

     :components
     :components

-    ((:file "oracle-package")
-     (:file "oracle-loader" :depends-on ("oracle-package"))
-     (:file "alien-resources" :depends-on ("oracle-package"))
-     (:file "oracle-constants" :depends-on ("oracle-package"))
-     (:file "oracle" :depends-on ("oracle-constants" "oracle-loader"))
-     (:file "oracle-sql" :depends-on ("oracle" "alien-resources"))
-     (:file "oracle-objects" :depends-on ("oracle-sql")))
+    ((:module :clsql-oracle
+             :components
+             ((:file "oracle-package")
+              (:file "oracle-loader" :depends-on ("oracle-package"))
+              (:file "alien-resources" :depends-on ("oracle-package"))
+              (:file "oracle-constants" :depends-on ("oracle-package"))
+              (:file "oracle" :depends-on ("oracle-constants" "oracle-loader"))
+              (:file "oracle-sql" :depends-on ("oracle" "alien-resources"))
+              (:file "oracle-objects" :depends-on ("oracle-sql")))))

     :depends-on (:clsql-base))
 
     :depends-on (:clsql-base))
 

-

 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-oracle)))) 
    "cl")
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-oracle)))) 
    "cl")

diff --git a/clsql-oracle.system b/clsql-oracle.system
deleted file mode 100644 (file)
index c52957f..0000000
--- a/clsql-oracle.system
+++ /dev/null
@@ -1,27 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; This is copyrighted software.  See interfaces/oracle/* files for terms.
-;;;; 
-;;;; $Id: clsql-oracle.system,v 1.5 2002/09/06 10:56:13 kevin Exp $
-
-(in-package :make)
-
-;;; System definition
-
-(defsystem :clsql-oracle
-  :source-pathname #.(format nil "~A:clsql-oracle;"
-                            #+common-lisp-controller "cl-library"
-                            #-common-lisp-controller "clsql")
-  :source-extension "cl"
-  :components
-  ((:file "oracle-package")
-   (:file "oracle-loader" :depends-on ("oracle-package"))
-   (:file "alien-resources" :depends-on ("oracle-package"))
-   (:file "oracle-constants" :depends-on ("oracle-package"))
-     (:file "oracle" :depends-on ("oracle-constants" "oracle-loader"))
-     (:file "oracle-sql" :depends-on ("oracle" "alien-resources"))
-     (:file "oracle-objects" :depends-on ("oracle-sql")))
-  :depends-on (:clsql-base))
-
-
-
-

diff --git a/clsql-postgresql-socket.asd b/clsql-postgresql-socket.asd
index 74b631f7bbee265a9d44f7094e4204143489143a..7c80ab295f568aed300b70bf52108bff9513d1c4 100644 (file)
--- a/clsql-postgresql-socket.asd
+++ b/clsql-postgresql-socket.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg\r
 ;;;; Date Started:  Aug 2002\r
 ;;;;\r
 ;;;; Programmer:    Kevin M. Rosenberg\r
 ;;;; Date Started:  Aug 2002\r
 ;;;;\r

-;;;; $Id: clsql-postgresql-socket.asd,v 1.5 2002/09/06 10:56:13 kevin Exp $\r
+;;;; $Id: clsql-postgresql-socket.asd,v 1.6 2002/09/17 17:16:43 kevin Exp $\r

 ;;;;\r
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
 ;;;;\r
 ;;;;\r
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
 ;;;;\r


@@ -22,15 +22,15 @@
 ;;; System definition\r
 \r
 (defsystem clsql-postgresql-socket\r
 ;;; System definition\r
 \r
 (defsystem clsql-postgresql-socket\r

-    :pathname #.(format nil "~A:clsql-postgresql-socket;"\r
-                       #+common-lisp-controller "cl-library"\r
-                       #-common-lisp-controller "clsql")\r
-    :components ((:file "postgresql-socket-package")\r
-                (:file "postgresql-socket-api"\r
-                       :depends-on ("postgresql-socket-package"))\r
-                (:file "postgresql-socket-sql"\r
-                       :depends-on ("postgresql-socket-api")))\r
-    :depends-on (:clsql-base :uffi))\r
+  :components\r
+  ((:module :clsql-postgresql-socket\r
+           :components\r
+           ((:file "postgresql-socket-package")\r
+            (:file "postgresql-socket-api"\r
+                   :depends-on ("postgresql-socket-package"))\r
+            (:file "postgresql-socket-sql"\r
+                   :depends-on ("postgresql-socket-api")))))\r
+  :depends-on (:clsql-base :uffi))\r

 \r
 (defmethod source-file-type  ((c cl-source-file)\r
                              (s (eql (find-system 'clsql-postgresql-socket)))) \r
 \r
 (defmethod source-file-type  ((c cl-source-file)\r
                              (s (eql (find-system 'clsql-postgresql-socket)))) \r

diff --git a/clsql-postgresql-socket.system b/clsql-postgresql-socket.system
deleted file mode 100644 (file)
index e4ee7b0..0000000
--- a/clsql-postgresql-socket.system
+++ /dev/null
@@ -1,34 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
-;;;; *************************************************************************\r
-;;;; FILE IDENTIFICATION\r
-;;;;\r
-;;;; Name:          clsql-postgresql.system\r
-;;;; Purpose:       Defsystem-3/4 file for CLSQL PostgresSQL socket backend\r
-;;;; Programmer:    Kevin M. Rosenberg\r
-;;;; Date Started:  Feb 2002\r
-;;;;\r
-;;;; $Id: clsql-postgresql-socket.system,v 1.12 2002/09/06 10:56:13 kevin Exp $\r
-;;;;\r
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
-;;;;\r
-;;;; CLSQL users are granted the rights to distribute and use this software\r
-;;;; as governed by the terms of the Lisp Lesser GNU Public License\r
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.\r
-;;;; *************************************************************************\r
-\r
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))\r
-(in-package :make)\r
-\r
-;;; System definition\r
-\r
-(defsystem :clsql-postgresql-socket\r
-  :source-pathname #.(format nil "~A:clsql-postgresql-socket;"\r
-                            #+common-lisp-controller "cl-library"\r
-                            #-common-lisp-controller "clsql")\r
-  :source-extension "cl"\r
-  :components ((:file "postgresql-socket-package")\r
-              (:file "postgresql-socket-api"\r
-                     :depends-on ("postgresql-socket-package"))\r
-              (:file "postgresql-socket-sql"\r
-                     :depends-on ("postgresql-socket-api")))\r
-  :depends-on (:clsql-base :uffi))\r

diff --git a/clsql-postgresql.asd b/clsql-postgresql.asd
index 46b26e6c7e556f47ce4114b293efe382afe6cca9..bc4b2bfa127b3991502e4a6146beafc57ff9320c 100644 (file)
--- a/clsql-postgresql.asd
+++ b/clsql-postgresql.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg\r
 ;;;; Date Started:  Aug 2002\r
 ;;;;\r
 ;;;; Programmer:    Kevin M. Rosenberg\r
 ;;;; Date Started:  Aug 2002\r
 ;;;;\r

-;;;; $Id: clsql-postgresql.asd,v 1.5 2002/09/06 10:56:13 kevin Exp $\r
+;;;; $Id: clsql-postgresql.asd,v 1.6 2002/09/17 17:16:43 kevin Exp $\r

 ;;;;\r
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
 ;;;;\r
 ;;;;\r
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
 ;;;;\r


@@ -19,17 +19,16 @@
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))\r
 (in-package :asdf)\r
 \r
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))\r
 (in-package :asdf)\r
 \r

-(defsystem clsql-postgresql\r
-    :pathname #.(format nil "~A:clsql-postgresql;"\r
-                       #+common-lisp-controller "cl-library"\r
-                       #-common-lisp-controller "clsql")\r
-    :components ((:file "postgresql-package")\r
-                (:file "postgresql-loader" :depends-on ("postgresql-package"))\r
-                (:file "postgresql-api" :depends-on ("postgresql-loader"))\r
-                (:file "postgresql-sql" :depends-on ("postgresql-api"))\r
-                (:file "postgresql-usql" :depends-on ("postgresql-sql")))\r
-    :depends-on (:uffi :clsql-base :clsql-uffi))\r
-\r
+(defsystem :clsql-postgresql\r
+  :components\r
+  ((:module :clsql-postgresql\r
+           :components\r
+           ((:file "postgresql-package")\r
+            (:file "postgresql-loader" :depends-on ("postgresql-package"))\r
+            (:file "postgresql-api" :depends-on ("postgresql-loader"))\r
+            (:file "postgresql-sql" :depends-on ("postgresql-api"))\r
+            (:file "postgresql-usql" :depends-on ("postgresql-sql")))))\r
+  :depends-on (:uffi :clsql-base :clsql-uffi))\r

 \r
 (defmethod source-file-type  ((c cl-source-file)\r
                              (s (eql (find-system 'clsql-postgresql)))) \r
 \r
 (defmethod source-file-type  ((c cl-source-file)\r
                              (s (eql (find-system 'clsql-postgresql)))) \r

diff --git a/clsql-postgresql.system b/clsql-postgresql.system
deleted file mode 100644 (file)
index 5d4ecea..0000000
--- a/clsql-postgresql.system
+++ /dev/null
@@ -1,33 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
-;;;; *************************************************************************\r
-;;;; FILE IDENTIFICATION\r
-;;;;\r
-;;;; Name:          clsql-postgresql.system\r
-;;;; Purpose:       Defsystem-3/4 file for CLSQL PostgresSQL backend\r
-;;;; Programmer:    Kevin M. Rosenberg\r
-;;;; Date Started:  Feb 2002\r
-;;;;\r
-;;;; $Id: clsql-postgresql.system,v 1.12 2002/09/06 10:56:13 kevin Exp $\r
-;;;;\r
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg\r
-;;;;\r
-;;;; CLSQL users are granted the rights to distribute and use this software\r
-;;;; as governed by the terms of the Lisp Lesser GNU Public License\r
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.\r
-;;;; *************************************************************************\r
-\r
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))\r
-(in-package :make)\r
-\r
-(defsystem :clsql-postgresql\r
-  :source-pathname #.(format nil "~A:clsql-postgresql;"\r
-                            #+common-lisp-controller "cl-library"\r
-                            #-common-lisp-controller "clsql")\r
-  :source-extension "cl"\r
-  :components ((:file "postgresql-package")\r
-              (:file "postgresql-loader" :depends-on ("postgresql-package"))\r
-              (:file "postgresql-api" :depends-on ("postgresql-loader"))\r
-              (:file "postgresql-sql" :depends-on ("postgresql-api"))\r
-              (:file "postgresql-usql" :depends-on ("postgresql-sql")))\r
-  :depends-on (:uffi :clsql-base :clsql-uffi))\r
-\r

diff --git a/clsql-uffi.asd b/clsql-uffi.asd
index 8ecdc352cc8970769109ce797943682d455f3779..c45d31cf7e73330afbfb583a552eb69596aa5cf3 100644 (file)
--- a/clsql-uffi.asd
+++ b/clsql-uffi.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;

-;;;; $Id: clsql-uffi.asd,v 1.7 2002/09/06 10:56:13 kevin Exp $
+;;;; $Id: clsql-uffi.asd,v 1.8 2002/09/17 17:16:43 kevin Exp $

 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;


@@ -22,17 +22,16 @@
 
 ;;; System definition
 
 
 ;;; System definition
 

-(defsystem clsql-uffi
-  :pathname #.(format nil "~A:clsql-uffi;"
-      #+common-lisp-controller "cl-library"
-      #-common-lisp-controller "clsql")
-  :components ((:file "clsql-uffi-package")
-              (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package"))
-              (:file "clsql-uffi" :depends-on ("clsql-uffi-loader")))
+(defsystem :clsql-uffi
+  :components
+  ((:module :uffi
+           :components
+           ((:file "clsql-uffi-package")
+            (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package"))
+            (:file "clsql-uffi" :depends-on ("clsql-uffi-loader")))))

   :depends-on (:uffi :clsql-base))
 
 
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-uffi)))) 
    "cl")
   :depends-on (:uffi :clsql-base))
 
 
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql-uffi)))) 
    "cl")

-

diff --git a/clsql-uffi.system b/clsql-uffi.system
deleted file mode 100644 (file)
index cb820b8..0000000
--- a/clsql-uffi.system
+++ /dev/null
@@ -1,34 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          clsql-uffi.system
-;;;; Purpose:       Defsystem-3/4 definition file for CLSQL UFFI Helper package
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: clsql-uffi.system,v 1.9 2002/09/06 10:56:13 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-
-(in-package :make)
-
-;;; System definition
-
-(defsystem :clsql-uffi
-  :source-pathname #.(format nil "~A:clsql-uffi;"
-                            #+common-lisp-controller "cl-library"
-                            #-common-lisp-controller "clsql")
-  :source-extension "cl"
-  :components ((:file "clsql-uffi-package")
-              (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package"))
-              (:file "clsql-uffi" :depends-on ("clsql-uffi-loader")))
-  :depends-on (:uffi :clsql-base))
-

diff --git a/clsql.asd b/clsql.asd
index d588c91469fb1037f5eb8aba35cbd43fc49411ca..162520037dcc8fa2dff25e74a842302304dc96eb 100644 (file)
--- a/clsql.asd
+++ b/clsql.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;

-;;;; $Id: clsql.asd,v 1.6 2002/09/06 11:08:19 kevin Exp $
+;;;; $Id: clsql.asd,v 1.7 2002/09/17 17:16:43 kevin Exp $

 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;


@@ -16,36 +16,24 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 

-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-

 (in-package :asdf)
 
 (in-package :asdf)
 

-#-clsql-base
-(let ((path (make-pathname :name "clsql-base" :type "system"
-                                     :defaults *load-truename*)))
-  (when (probe-file path)
-    (load path)))
-
-;;; System definitions
-
-

 (defsystem clsql
 (defsystem clsql

-  :pathname #.(format nil "~A:clsql;"
-                     #+common-lisp-controller "cl-library"
-                     #-common-lisp-controller "clsql")

   :perform (load-op :after (op clsql)
                    (pushnew :clsql cl:*features*))
   :perform (load-op :after (op clsql)
                    (pushnew :clsql cl:*features*))

-  :components ((:file "package")
-              (:file "pool" :depends-on ("package"))
-              (:file "loop-extension")
-              (:file "sql" :depends-on ("pool"))
-              (:file "transactions" :depends-on ("sql"))
-              (:file "functional" :depends-on ("sql"))
-              (:file "usql" :depends-on ("sql")))
+  :components
+  ((:module :sql
+           :components
+           ((:file "package")
+            (:file "pool" :depends-on ("package"))
+            (:file "loop-extension")
+            (:file "sql" :depends-on ("pool"))
+            (:file "transactions" :depends-on ("sql"))
+            (:file "functional" :depends-on ("sql"))
+            (:file "usql" :depends-on ("sql")))))

   :depends-on (:clsql-base)
   )
 
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql)))) 
    "cl")
   :depends-on (:clsql-base)
   )
 
 (defmethod source-file-type  ((c cl-source-file)
                              (s (eql (find-system 'clsql)))) 
    "cl")

-

diff --git a/clsql.system b/clsql.system
deleted file mode 100644 (file)
index ef655b8..0000000
--- a/clsql.system
+++ /dev/null
@@ -1,45 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          clsql.system
-;;;; Purpose:       Defsystem-3/4 for CLSQL
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: clsql.system,v 1.20 2002/09/06 10:56:13 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :make)
-
-#-clsql-base
-(let ((path (make-pathname :name "clsql-base" :type "system"
-                                     :defaults *load-truename*)))
-  (when (probe-file path)
-    (load path)))
-
-;;; System definitions
-
-(defsystem :clsql
-  :source-pathname #.(format nil "~A:clsql;"
-                            #+common-lisp-controller "cl-library"
-                            #-common-lisp-controller "clsql")
-  :source-extension "cl"
-  :components ((:file "package")
-              (:file "pool" :depends-on ("package"))
-              (:file "loop-extension")
-              (:file "sql" :depends-on ("pool"))
-              (:file "transactions" :depends-on ("sql"))
-              (:file "functional" :depends-on ("sql"))
-              (:file "usql" :depends-on ("sql")))
-  :depends-on (:clsql-base)
-  :finally-do
-  (pushnew :clsql cl:*features*)
-  )

diff --git a/clsql/.cvsignore b/clsql/.cvsignore
deleted file mode 100755 (executable)
index ca8d09f..0000000
--- a/clsql/.cvsignore
+++ /dev/null
@@ -1 +0,0 @@
-.bin

diff --git a/clsql/Makefile b/clsql/Makefile
deleted file mode 100644 (file)
index 31dc910..0000000
--- a/clsql/Makefile
+++ /dev/null
@@ -1,6 +0,0 @@
-SUBDIRS                := 
-
-include ../Makefile.common
-
-.PHONY: distclean
-distclean: clean

diff --git a/clsql/functional.cl b/clsql/functional.cl
deleted file mode 100644 (file)
index 01d0590..0000000
--- a/clsql/functional.cl
+++ /dev/null
@@ -1,99 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          functional.cl
-;;;; Purpose:       Functional interface
-;;;; Programmer:    Pierre R. Mai
-;;;;
-;;;; Copyright (c) 1999-2001 Pierre R. Mai
-;;;;
-;;;; $Id: functional.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file is part of CLSQL. 
-;;;;
-;;;; CLSQL is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License (version 2) as
-;;;; published by the Free Software Foundation.
-;;;;
-;;;; CLSQL is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with CLSQL; if not, write to the Free Software Foundation, Inc.,
-;;;; 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-
-;;;; This file implements the more advanced functions of the
-;;;; functional SQL interface, which are just nicer layers above the
-;;;; basic SQL interface.
-
-(defun insert-records
-    (&key into attributes values av-pairs query (database *default-database*))
-  "Insert records into the given table according to the given options."
-  (cond
-    ((and av-pairs (or attributes values))
-     (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
-    ((and (or av-pairs values) query)
-     (error
-      "Supply either query or values/av-pairs to call of insert-records."))
-    ((and attributes (not query)
-          (or (not (listp values)) (/= (length attributes) (length values))))
-     (error "You must supply a matching values list when using attributes in call of insert-records."))
-    (query
-     (execute-command
-      (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
-      :database database))
-    (t
-     (execute-command
-      (multiple-value-bind (attributes values)
-          (if av-pairs
-              (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
-              (values attributes values))
-       (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
-               into attributes values))
-      :database database))))
-
-(defun delete-records (&key from where (database *default-database*))
-  "Delete the indicated records from the given database."
-  (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
-                   :database database))
-
-(defun update-records (table &key attributes values av-pairs where (database *default-database*))
-  "Update the specified records in the given database."
-  (cond
-    ((and av-pairs (or attributes values))
-     (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
-    ((and attributes
-          (or (not (listp values)) (/= (length attributes) (length values))))
-     (error "You must supply a matching values list when using attributes in call of update-records."))
-    ((or (and attributes (not values)) (and values (not attributes)))
-     (error "You must supply both values and attributes in call of update-records."))
-    (t
-     (execute-command
-      (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
-              table
-              (or av-pairs
-                  (mapcar #'list attributes values))
-              where)
-      :database database))))
-
-(defmacro with-database ((db-var connection-spec &rest connect-args) &body body)
-  "Evaluate the body in an environment, where `db-var' is bound to the
-database connection given by `connection-spec' and `connect-args'.
-The connection is automatically closed or released to the pool on exit from the body."
-  (let ((result (gensym "result-")))
-    (unless db-var (setf db-var '*default-database*))
-    `(let ((,db-var (connect ,connection-spec ,@connect-args))
-          (,result nil))
-      (unwind-protect
-          (let ((,db-var ,db-var))
-            (setf ,result (progn ,@body)))
-       (disconnect :database ,db-var))
-      ,result)))
\ No newline at end of file

diff --git a/clsql/loop-extension.cl b/clsql/loop-extension.cl
deleted file mode 100644 (file)
index a1651b9..0000000
--- a/clsql/loop-extension.cl
+++ /dev/null
@@ -1,98 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          loop-extension.cl
-;;;; Purpose:       Extensions to the Loop macro for CMUCL
-;;;; Programmer:    Pierre R. Mai
-;;;;
-;;;; Copyright (c) 1999-2001 Pierre R. Mai
-;;;;
-;;;; $Id: loop-extension.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; The functions in this file were orignally distributed in the
-;;;; MaiSQL package in the file sql/sql.cl
-;;;; *************************************************************************
-
-(in-package :cl-user)
-
-;;;; MIT-LOOP extension
-
-#+cmu
-(defun loop-record-iteration-path (variable data-type prep-phrases)
-  (let ((in-phrase nil)
-       (from-phrase nil))
-    (loop for (prep . rest) in prep-phrases
-         do
-         (case prep
-           ((:in :of)
-            (when in-phrase
-              (ansi-loop::loop-error
-               "Duplicate OF or IN iteration path: ~S." (cons prep rest)))
-            (setq in-phrase rest))
-           ((:from)
-            (when from-phrase
-              (ansi-loop::loop-error
-               "Duplicate FROM iteration path: ~S." (cons prep rest)))
-            (setq from-phrase rest))
-           (t
-            (ansi-loop::loop-error
-             "Unknown preposition: ~S." prep))))
-    (unless in-phrase
-      (ansi-loop::loop-error "Missing OF or IN iteration path."))
-    (unless from-phrase
-      (setq from-phrase '(*default-database*)))
-    (cond
-      ((consp variable)
-       (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
-            (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
-            (result-set-var (ansi-loop::loop-gentemp
-                             'loop-record-result-set-))
-            (step-var (ansi-loop::loop-gentemp 'loop-record-step-)))
-        (push `(when ,result-set-var
-                (database-dump-result-set ,result-set-var ,db-var))
-              ansi-loop::*loop-epilogue*)
-        `(((,variable nil ,data-type) (,query-var ,(first in-phrase))
-           (,db-var ,(first from-phrase))
-           (,result-set-var nil)
-           (,step-var nil))
-          ((multiple-value-bind (%rs %cols)
-               (database-query-result-set ,query-var ,db-var)
-             (setq ,result-set-var %rs ,step-var (make-list %cols))))
-          ()
-          ()
-          (not (database-store-next-row ,result-set-var ,db-var ,step-var))
-          (,variable ,step-var)
-          (not ,result-set-var)
-          ()
-          (not (database-store-next-row ,result-set-var ,db-var ,step-var))
-          (,variable ,step-var))))
-      (t
-       (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
-            (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
-            (result-set-var (ansi-loop::loop-gentemp
-                             'loop-record-result-set-)))
-        (push `(when ,result-set-var
-                (database-dump-result-set ,result-set-var ,db-var))
-              ansi-loop::*loop-epilogue*)
-        `(((,variable nil ,data-type) (,query-var ,(first in-phrase))
-           (,db-var ,(first from-phrase))
-           (,result-set-var nil))
-          ((multiple-value-bind (%rs %cols)
-               (database-query-result-set ,query-var ,db-var)
-             (setq ,result-set-var %rs ,variable (make-list %cols))))
-          ()
-          ()
-          (not (database-store-next-row ,result-set-var ,db-var ,variable))
-          ()
-          (not ,result-set-var)
-          ()
-          (not (database-store-next-row ,result-set-var ,db-var ,variable))
-          ()))))))
-
-#+cmu
-(ansi-loop::add-loop-path '(record records tuple tuples)
-                         'loop-record-iteration-path
-                         ansi-loop::*loop-ansi-universe*
-                         :preposition-groups '((:of :in) (:from))
-                         :inclusive-permitted nil)

diff --git a/clsql/package.cl b/clsql/package.cl
deleted file mode 100644 (file)
index bf4eb00..0000000
--- a/clsql/package.cl
+++ /dev/null
@@ -1,133 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          package.cl
-;;;; Purpose:       Package definition for CLSQL (high-level) interface
-;;;; Programmers:   Kevin M. Rosenberg based on
-;;;;                Original code by Pierre R. Mai 
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: package.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :cl-user)
-
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defpackage :clsql-sys
-    (:nicknames :clsql)
-    (:use :common-lisp :clsql-base-sys)
-    (:import-from 
-     :clsql-base
-     .
-     #1=(
-        #:clsql-condition
-        #:clsql-error
-        #:clsql-simple-error
-        #:clsql-warning
-        #:clsql-simple-warning
-        #:clsql-invalid-spec-error
-        #:clsql-invalid-spec-error-connection-spec
-        #:clsql-invalid-spec-error-database-type
-        #:clsql-invalid-spec-error-template
-        #:clsql-connect-error
-        #:clsql-connect-error-database-type
-        #:clsql-connect-error-connection-spec
-        #:clsql-connect-error-errno
-        #:clsql-connect-error-error
-        #:clsql-sql-error
-        #:clsql-sql-error-database
-        #:clsql-sql-error-expression
-        #:clsql-sql-error-errno
-        #:clsql-sql-error-error
-        #:clsql-database-warning
-        #:clsql-database-warning-database
-        #:clsql-database-warning-message
-        #:clsql-exists-condition
-        #:clsql-exists-condition-new-db
-        #:clsql-exists-condition-old-db
-        #:clsql-exists-warning
-        #:clsql-exists-error
-        #:clsql-closed-error
-        #:clsql-closed-error-database
-        
-        #:*loaded-database-types*
-        #:reload-database-types
-        #:*default-database-type*
-        #:*initialized-database-types*
-        #:initialize-database-type
-        
-        #:database
-        #:database-name
-        #:closed-database
-        #:database-name-from-spec
-        
-        ;; utils.cl
-        #:number-to-sql-string
-        #:float-to-sql-string
-        #:sql-escape-quotes
-        ))
-    (:export
-     ;; sql.cl
-     #:*connect-if-exists*
-     #:connected-databases
-     #:*default-database*
-     #:find-database
-     #:connect
-     #:disconnect
-     #:query
-     #:execute-command
-     #:map-query
-     #:do-query
-     
-     ;; functional.cl
-     #:insert-records
-     #:delete-records
-     #:update-records
-     #:with-database
-     
-     ;; For High-level UncommonSQL compatibility
-     #:sql-ident
-     #:list-tables
-     #:list-attributes
-     #:attribute-type
-     #:create-sequence 
-     #:drop-sequence
-     #:sequence-next
-     
-     ;; Pooled connections
-     #:disconnect-pooled
-     #:find-or-create-connection-pool
-     
-     ;; Transactions
-     #:with-transaction
-     #:commit-transaction
-     #:rollback-transaction
-     #:add-transaction-commit-hook
-     #:add-transaction-rollback-hook
-     
-     ;; Large objects (Marc B)
-     #:create-large-object
-     #:write-large-object
-     #:read-large-object
-     #:delete-large-object
-     
-     .
-     #1#
-     )
-    (:documentation "This is the INTERNAL SQL-Interface package of CLSQL."))
-  
-  )                                    ;eval-when
-
-(defpackage #:clsql-user
-  (:use #:common-lisp #:clsql)
-  (:documentation "This is the user package for experimenting with CLSQL."))

diff --git a/clsql/pool.cl b/clsql/pool.cl
deleted file mode 100644 (file)
index 3aa8d25..0000000
--- a/clsql/pool.cl
+++ /dev/null
@@ -1,79 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          pool.cl
-;;;; Purpose:       Support function for connection pool
-;;;; Programmers:   Kevin M. Rosenberg, Marc Battyani
-;;;; Date Started:  Apr 2002
-;;;;
-;;;; $Id: pool.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-(defvar *db-pool* (make-hash-table :test #'equal))
-
-(defclass conn-pool ()
-  ((connection-spec :accessor connection-spec :initarg :connection-spec)
-   (database-type :accessor database-type :initarg :database-type)
-   (free-connections :accessor free-connections
-                    :initform (make-array 5 :fill-pointer 0 :adjustable t))
-   (all-connections :accessor all-connections
-                   :initform (make-array 5 :fill-pointer 0 :adjustable t))))
-
-(defun acquire-from-conn-pool (pool)
-  (if (zerop (length (free-connections pool)))
-    (let ((conn (connect (connection-spec pool)
-                        :database-type (database-type pool) :if-exists :new)))
-      (vector-push-extend conn (all-connections pool))
-      (setf (conn-pool conn) pool)
-      conn)
-    (vector-pop (free-connections pool))))
-
-(defun release-to-conn-pool (conn)
-  (vector-push-extend conn (free-connections (conn-pool conn))))
-
-(defun clear-conn-pool (pool)
-  (loop for conn across (all-connections pool)
-       do (setf (conn-pool conn) nil)
-          (disconnect :database conn))
-  (setf (fill-pointer (free-connections pool)) 0)
-  (setf (fill-pointer (all-connections pool)) 0))
-
-(defun find-or-create-connection-pool (connection-spec database-type)
-  "Find connection pool in hash table, creates a new connection pool if not found"
-  (let* ((key (list connection-spec database-type))
-        (conn-pool (gethash key *db-pool*)))
-    (unless conn-pool
-      (setq conn-pool (make-instance 'conn-pool
-                                    :connection-spec connection-spec
-                                    :database-type database-type))
-      (setf (gethash key *db-pool*) conn-pool))
-    conn-pool))
-
-(defun acquire-from-pool (connection-spec database-type &optional pool)
-  (unless (typep pool 'conn-pool)
-    (setf pool (find-or-create-connection-pool connection-spec database-type)))
-  (acquire-from-conn-pool pool))
-
-(defun release-to-pool (database)
-  (release-to-conn-pool database))
-
-(defun disconnect-pooled (&optional clear)
-  "Disconnects all connections in the pool"
-  (maphash
-   #'(lambda (key conn-pool)
-       (declare (ignore key))
-       (clear-conn-pool conn-pool))
-   *db-pool*)
-  (when clear (clrhash *db-pool*))
-  t)
-

diff --git a/clsql/sql.cl b/clsql/sql.cl
deleted file mode 100644 (file)
index 1adedf7..0000000
--- a/clsql/sql.cl
+++ /dev/null
@@ -1,262 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          sql.cl
-;;;; Purpose:       High-level SQL interface
-;;;; Programmers:   Kevin M. Rosenberg based on
-;;;;                 Original code by Pierre R. Mai 
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: sql.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-;;; Modified by KMR 
-;;; - to use CMUCL-COMPAT library 
-;;; - fix format strings in error messages 
-;;; - use field types
-
-
-;;; Simple implementation of SQL along the lines of Harlequin's Common SQL
-
-
-;;; Database handling
-
-(defvar *connect-if-exists* :error
-  "Default value for the if-exists parameter of connect calls.")
-
-(defvar *connected-databases* nil
-  "List of active database objects.")
-
-(defun connected-databases ()
-  "Return the list of active database objects."
-  *connected-databases*)
-
-(defvar *default-database* nil
-  "Specifies the default database to be used.")
-
-(defun find-database (database &optional (errorp t))
-  (etypecase database
-    (database
-     ;; Return the database object itself
-     database)
-    (string
-     (or (find database (connected-databases)
-              :key #'database-name
-              :test #'string=)
-        (when errorp
-          (cerror "Return nil."
-                  'clsql-simple-error
-                  :format-control "There exists no database called ~A."
-                  :format-arguments (list database)))))))
-
-(defun connect (connection-spec
-               &key (if-exists *connect-if-exists*)
-               (database-type *default-database-type*)
-               (pool nil))
-  "Connects to a database of the given database-type, using the type-specific
-connection-spec.  if-exists is currently ignored.
-If pool is t the the connection will be taken from the general pool,
-if pool is a conn-pool object the connection will be taken from this pool.
-"
-  (if pool
-    (acquire-from-pool connection-spec database-type pool)
-    (let* ((db-name (database-name-from-spec connection-spec database-type))
-          (old-db (unless (eq if-exists :new) (find-database db-name nil)))
-          (result nil))
-      (if old-db
-       (case if-exists
-;          (:new
-;           (setq result
-;             (database-connect connection-spec database-type)))
-         (:warn-new
-          (setq result
-                (database-connect connection-spec database-type))
-          (warn 'clsql-exists-warning :old-db old-db :new-db result))
-         (:error
-          (restart-case
-                (error 'clsql-exists-error :old-db old-db)
-              (create-new ()
-                  :report "Create a new connection."
-                (setq result
-                  (database-connect connection-spec database-type)))
-              (use-old ()
-                  :report "Use the existing connection."
-                (setq result old-db))))
-         (:warn-old
-          (setq result old-db)
-          (warn 'clsql-exists-warning :old-db old-db :new-db old-db))
-         (:old
-          (setq result old-db)))
-       (setq result
-             (database-connect connection-spec database-type)))
-      (when result
-       (pushnew result *connected-databases*)
-       (setq *default-database* result)
-       result))))
-
-
-(defun disconnect (&key (database *default-database*))
-  "Closes the connection to database. Resets *default-database* if that
-database was disconnected and only one other connection exists.
-if the database is from a pool it will be released to this pool."
-  (if (conn-pool database)
-      (release-to-pool database)
-    (when (database-disconnect database)
-      (setq *connected-databases* (delete database *connected-databases*))
-      (when (eq database *default-database*)
-       (setq *default-database* (car *connected-databases*)))
-      (change-class database 'closed-database)
-      t)))
-
-;;; Basic operations on databases
-
-(defmethod query (query-expression &key (database *default-database*)  
-                 types)
-  "Execute the SQL query expression query-expression on the given database.
-Returns a list of lists of values of the result of that expression."
-  (database-query query-expression database types))
-
-
-
-(defmethod execute-command (sql-expression &key (database *default-database*))
-  "Execute the SQL command expression sql-expression on the given database.
-Returns true on success or nil on failure."
-  (database-execute-command sql-expression database))
-
-
-
-(defun map-query (output-type-spec function query-expression
-                 &key (database *default-database*)
-                 (types nil))
-  "Map the function over all tuples that are returned by the query in
-query-expression.  The results of the function are collected as
-specified in output-type-spec and returned like in MAP."
-  ;; DANGER Will Robinson: Parts of the code for implementing
-  ;; map-query (including the code below and the helper functions
-  ;; called) are highly CMU CL specific.
-  ;; KMR -- these have been replaced with cross-platform instructions above
-  (macrolet ((type-specifier-atom (type)
-              `(if (atom ,type) ,type (car ,type))))
-    (case (type-specifier-atom output-type-spec)
-      ((nil) 
-       (map-query-for-effect function query-expression database types))
-      (list 
-       (map-query-to-list function query-expression database types))
-      ((simple-vector simple-string vector string array simple-array
-       bit-vector simple-bit-vector base-string
-       simple-base-string)
-       (map-query-to-simple output-type-spec function query-expression database types))
-      (t
-       (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
-              function query-expression :database database :types types)))))
-
-(defun map-query-for-effect (function query-expression database types)
-  (multiple-value-bind (result-set columns)
-      (database-query-result-set query-expression database :full-set nil
-                                :types types)
-    (when result-set
-      (unwind-protect
-          (do ((row (make-list columns)))
-              ((not (database-store-next-row result-set database row))
-               nil)
-            (apply function row))
-       (database-dump-result-set result-set database)))))
-                    
-(defun map-query-to-list (function query-expression database types)
-  (multiple-value-bind (result-set columns)
-      (database-query-result-set query-expression database :full-set nil
-                                :types types)
-    (when result-set
-      (unwind-protect
-          (let ((result (list nil)))
-            (do ((row (make-list columns))
-                 (current-cons result (cdr current-cons)))
-                ((not (database-store-next-row result-set database row))
-                 (cdr result))
-              (rplacd current-cons (list (apply function row)))))
-       (database-dump-result-set result-set database)))))
-
-
-(defun map-query-to-simple (output-type-spec function query-expression database types)
-  (multiple-value-bind (result-set columns rows)
-      (database-query-result-set query-expression database :full-set t
-                                :types types)
-    (when result-set
-      (unwind-protect
-          (if rows
-              ;; We know the row count in advance, so we allocate once
-              (do ((result
-                    (cmucl-compat:make-sequence-of-type output-type-spec rows))
-                   (row (make-list columns))
-                   (index 0 (1+ index)))
-                  ((not (database-store-next-row result-set database row))
-                   result)
-                (declare (fixnum index))
-                (setf (aref result index)
-                      (apply function row)))
-              ;; Database can't report row count in advance, so we have
-              ;; to grow and shrink our vector dynamically
-              (do ((result
-                    (cmucl-compat:make-sequence-of-type output-type-spec 100))
-                   (allocated-length 100)
-                   (row (make-list columns))
-                   (index 0 (1+ index)))
-                  ((not (database-store-next-row result-set database row))
-                   (cmucl-compat:shrink-vector result index))
-                (declare (fixnum allocated-length index))
-                (when (>= index allocated-length)
-                  (setq allocated-length (* allocated-length 2)
-                        result (adjust-array result allocated-length)))
-                (setf (aref result index)
-                      (apply function row))))
-       (database-dump-result-set result-set database)))))
-
-(defmacro do-query (((&rest args) query-expression
-                    &key (database '*default-database*)
-                    (types nil))
-                   &body body)
-  (let ((result-set (gensym))
-       (columns (gensym))
-       (row (gensym))
-       (db (gensym)))
-    `(let ((,db ,database))
-       (multiple-value-bind (,result-set ,columns)
-          (database-query-result-set ,query-expression ,db
-                                     :full-set nil :types ,types)
-        (when ,result-set
-          (unwind-protect
-               (do ((,row (make-list ,columns)))
-                   ((not (database-store-next-row ,result-set ,db ,row))
-                    nil)
-                 (destructuring-bind ,args ,row
-                   ,@body))
-            (database-dump-result-set ,result-set ,db)))))))
-
-;;; Marc Battyani : Large objects support
-
-(defun create-large-object (&key (database *default-database*))
-  "Creates a new large object in the database and returns the object identifier"
-  (database-create-large-object database))
-
-(defun write-large-object (object-id data &key (database *default-database*))
-  "Writes data to the large object"
-  (database-write-large-object object-id data database))
-
-(defun read-large-object (object-id &key (database *default-database*))
-  "Reads the large object content"
-  (database-read-large-object object-id database))
-
-(defun delete-large-object (object-id &key (database *default-database*))
-  "Deletes the large object in the database"
-  (database-delete-large-object object-id database))

diff --git a/clsql/transactions.cl b/clsql/transactions.cl
deleted file mode 100644 (file)
index a7776ec..0000000
--- a/clsql/transactions.cl
+++ /dev/null
@@ -1,85 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          transactions.cl
-;;;; Purpose:       Transaction support
-;;;; Programmers:   Marc Battyani
-;;;; Date Started:  Apr 2002
-;;;;
-;;;; $Id: transactions.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-;; I removed the USQL transaction stuff to put a smaller, lighter one (MB)
-
-(defclass transaction ()
-  ((commit-hooks :initform () :accessor commit-hooks)
-   (rollback-hooks :initform () :accessor rollback-hooks)
-   (status :initform nil :accessor status))) ;can be nil :rolled-back or :commited
-
-(defmethod database-start-transaction ((database closed-database))
-  (error 'clsql-closed-database-error database))
-
-(defmethod database-start-transaction (database)
-  (unless (transaction database)
-    (setf (transaction database) (make-instance 'transaction)))
-  (when (= (incf (transaction-level database)) 1)
-    (let ((transaction (transaction database)))
-      (setf (commit-hooks transaction) nil
-           (rollback-hooks transaction) nil
-           (status transaction) nil)
-      (execute-command "BEGIN" :database database))))
-
-(defmethod database-end-transaction ((database closed-database))
-  (error 'clsql-closed-database-error database))
-
-(defmethod database-end-transaction (database)
-  (if (> (transaction-level database) 0)
-    (when (zerop (decf (transaction-level database)))
-      (let ((transaction (transaction database)))
-       (if (eq (status transaction) :commited)
-         (progn
-           (execute-command "COMMIT" :database database)
-           (map nil #'funcall (commit-hooks transaction)))
-         (unwind-protect ;status is not :commited
-              (execute-command "ROLLBACK" :database database)
-           (map nil #'funcall (rollback-hooks transaction))))))
-    (warn "Continue without commit."
-         'clsql-simple-error
-         :format-control "Cannot commit transaction against ~A because there is no transaction in progress."
-         :format-arguments (list database))))
-
-(defun rollback-transaction (database)
-  (when (and (transaction database)(not (status (transaction database))))
-    (setf (status (transaction database)) :rolled-back)))
-
-(defun commit-transaction (database)
-  (when (and (transaction database)(not (status (transaction database))))
-    (setf (status (transaction database)) :commited)))
-
-(defun add-transaction-commit-hook (database commit-hook)
-  (when (transaction database)
-    (push commit-hook (commit-hooks (transaction database)))))
-
-(defun add-transaction-rollback-hook (database rollback-hook)
-  (when (transaction database)
-    (push rollback-hook (rollback-hooks (transaction database)))))
-
-(defmacro with-transaction ((&key (database '*default-database*)) &rest body)
-  (let ((db (gensym "db-")))
-    `(let ((,db ,database))
-      (unwind-protect
-          (progn
-            (database-start-transaction ,db)
-            ,@body
-            (commit-transaction ,db))
-       (database-end-transaction ,db)))))

diff --git a/clsql/usql.cl b/clsql/usql.cl
deleted file mode 100644 (file)
index 0ccdece..0000000
--- a/clsql/usql.cl
+++ /dev/null
@@ -1,57 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          usql.cl
-;;;; Purpose:       High-level interface to SQL driver routines needed for
-;;;;                UncommonSQL
-;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc
-;;;; Date Started:  Mar 2002
-;;;;
-;;;; $Id: usql.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and 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.
-;;;; *************************************************************************
-
-
-;;; Minimal high-level routines to enable low-level interface for USQL
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-(defun list-tables (&key (database *default-database*)
-                         (system-tables nil))
-  "List all tables in *default-database*, or if the :database keyword arg
-is given, the specified database.  If the keyword arg :system-tables
-is true, then it will not filter out non-user tables.  Table names are
-given back as a list of strings."
-  (database-list-tables database :system-tables system-tables))
-
-
-(defun list-attributes (table &key (database *default-database*))
-  "List the attributes of TABLE in *default-database, or if the
-:database keyword is given, the specified database.  Attributes are
-returned as a list of strings."
-  (database-list-attributes table database))
-
-(defun attribute-type (attribute table &key (database *default-database*))
-  "Return the field type of the ATTRIBUTE in TABLE.  The optional
-keyword argument :database specifies the database to query, defaulting
-to *default-database*."
-  (database-attribute-type attribute table database))
-
-(defun create-sequence (name &key (database *default-database*))
-  (database-create-sequence name database))
-
-(defun drop-sequence (name &key (database *default-database*))
-  (database-drop-sequence name database))
-
-(defun sequence-next (name &key (database *default-database*))
-  (database-sequence-next name database))
-
-

diff --git a/set-logical.cl b/set-logical.cl
deleted file mode 100644 (file)
index e14fa1c..0000000
--- a/set-logical.cl
+++ /dev/null
@@ -1,90 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          set-logical.cl
-;;;; Purpose:       Sets a logical host for src/binaries based on a pathname.
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-
-;;; Setup logical pathname translaton with separate binary directories
-;;; for each implementation
-
-;; push allegro case sensitivity on *features*
-#+allegro
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (if (or (eq excl:*current-case-mode* :case-sensitive-lower)
-         (eq excl:*current-case-mode* :case-sensitive-upper))
-      (pushnew :case-sensitive cl:*features*)
-    (pushnew :case-insensitive cl:*features*)))
-
-(defconstant +set-logical-compiler-name+
-    #+(and allegro ics case-sensitive) "acl-modern"
-    #+(and allegro (not ics) case-sensitive) "acl-modern8"
-    #+(and allegro ics (not case-sensitive)) "acl-ansi"
-    #+(and allegro (not ics) (not case-sensitive)) "acl-ansi8"
-    #+lispworks "lispworks"
-    #+clisp "clisp"
-    #+cmu "cmucl"
-    #+sbcl "sbcl"
-    #+corman "corman"
-    #+mcl "mcl"
-    #+openmcl "openmcl"
-    #-(or allegro lispworks clisp cmu sbcl corman mcl openmcl) "unknown")
-
-(defun set-logical-host-for-pathname (host base-pathname)
-  (setf (logical-pathname-translations host)
-    `(("ROOT;" ,(make-pathname
-               :host (pathname-host base-pathname)
-               :device (pathname-device base-pathname)
-               :directory (pathname-directory base-pathname)))
-      ("**;*.cl.*" ,(merge-pathnames
-                   (make-pathname
-                    :name :wild
-                    :type :wild
-                    :directory '(:relative :wild-inferiors))
-                   base-pathname))
-      ("**;*.lisp.*" ,(merge-pathnames
-                   (make-pathname
-                    :name :wild
-                    :type :wild
-                    :directory '(:relative :wild-inferiors))
-                   base-pathname))
-      ("**;*.c.*" ,(merge-pathnames
-                   (make-pathname
-                    :name :wild
-                    :type :wild
-                    :directory '(:relative :wild-inferiors))
-                   base-pathname))
-      ("**;*.h.*" ,(merge-pathnames
-                   (make-pathname
-                    :name :wild
-                    :type :wild
-                    :directory '(:relative :wild-inferiors))
-                   base-pathname))
-      ("**;bin;*.*.*" ,(merge-pathnames
-                       (make-pathname 
-                        :name :wild
-                        :type :wild
-                        :directory 
-                        (append '(:relative :wild-inferiors
-                                            ".bin" #.+set-logical-compiler-name+)))
-                       base-pathname))
-      ;; default is to place in .bin/<compiler> directory
-      ("**;*.*.*" ,(merge-pathnames
-                   (make-pathname 
-                    :name :wild
-                    :type :wild
-                    :directory 
-                    (append '(:relative :wild-inferiors
-                                        ".bin" #.+set-logical-compiler-name+)))
-                   base-pathname)))))
-

diff --git a/sql/.cvsignore b/sql/.cvsignore
new file mode 100755 (executable)
index 0000000..ca8d09f
--- /dev/null
+++ b/sql/.cvsignore
@@ -0,0 +1 @@
+.bin

diff --git a/sql/Makefile b/sql/Makefile
new file mode 100644 (file)
index 0000000..31dc910
--- /dev/null
+++ b/sql/Makefile
@@ -0,0 +1,6 @@
+SUBDIRS                := 
+
+include ../Makefile.common
+
+.PHONY: distclean
+distclean: clean

diff --git a/sql/functional.cl b/sql/functional.cl
new file mode 100644 (file)
index 0000000..e283e5d
--- /dev/null
+++ b/sql/functional.cl
@@ -0,0 +1,99 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          functional.cl
+;;;; Purpose:       Functional interface
+;;;; Programmer:    Pierre R. Mai
+;;;;
+;;;; Copyright (c) 1999-2001 Pierre R. Mai
+;;;;
+;;;; $Id: functional.cl,v 1.8 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file is part of CLSQL. 
+;;;;
+;;;; CLSQL is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; CLSQL is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with CLSQL; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+
+;;;; This file implements the more advanced functions of the
+;;;; functional SQL interface, which are just nicer layers above the
+;;;; basic SQL interface.
+
+(defun insert-records
+    (&key into attributes values av-pairs query (database *default-database*))
+  "Insert records into the given table according to the given options."
+  (cond
+    ((and av-pairs (or attributes values))
+     (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
+    ((and (or av-pairs values) query)
+     (error
+      "Supply either query or values/av-pairs to call of insert-records."))
+    ((and attributes (not query)
+          (or (not (listp values)) (/= (length attributes) (length values))))
+     (error "You must supply a matching values list when using attributes in call of insert-records."))
+    (query
+     (execute-command
+      (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
+      :database database))
+    (t
+     (execute-command
+      (multiple-value-bind (attributes values)
+          (if av-pairs
+              (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
+              (values attributes values))
+       (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
+               into attributes values))
+      :database database))))
+
+(defun delete-records (&key from where (database *default-database*))
+  "Delete the indicated records from the given database."
+  (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
+                   :database database))
+
+(defun update-records (table &key attributes values av-pairs where (database *default-database*))
+  "Update the specified records in the given database."
+  (cond
+    ((and av-pairs (or attributes values))
+     (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
+    ((and attributes
+          (or (not (listp values)) (/= (length attributes) (length values))))
+     (error "You must supply a matching values list when using attributes in call of update-records."))
+    ((or (and attributes (not values)) (and values (not attributes)))
+     (error "You must supply both values and attributes in call of update-records."))
+    (t
+     (execute-command
+      (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
+              table
+              (or av-pairs
+                  (mapcar #'list attributes values))
+              where)
+      :database database))))
+
+(defmacro with-database ((db-var connection-spec &rest connect-args) &body body)
+  "Evaluate the body in an environment, where `db-var' is bound to the
+database connection given by `connection-spec' and `connect-args'.
+The connection is automatically closed or released to the pool on exit from the body."
+  (let ((result (gensym "result-")))
+    (unless db-var (setf db-var '*default-database*))
+    `(let ((,db-var (connect ,connection-spec ,@connect-args))
+          (,result nil))
+      (unwind-protect
+          (let ((,db-var ,db-var))
+            (setf ,result (progn ,@body)))
+       (disconnect :database ,db-var))
+      ,result)))
\ No newline at end of file

diff --git a/sql/loop-extension.cl b/sql/loop-extension.cl
new file mode 100644 (file)
index 0000000..6b59250
--- /dev/null
+++ b/sql/loop-extension.cl
@@ -0,0 +1,98 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          loop-extension.cl
+;;;; Purpose:       Extensions to the Loop macro for CMUCL
+;;;; Programmer:    Pierre R. Mai
+;;;;
+;;;; Copyright (c) 1999-2001 Pierre R. Mai
+;;;;
+;;;; $Id: loop-extension.cl,v 1.3 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; The functions in this file were orignally distributed in the
+;;;; MaiSQL package in the file sql/sql.cl
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+;;;; MIT-LOOP extension
+
+#+cmu
+(defun loop-record-iteration-path (variable data-type prep-phrases)
+  (let ((in-phrase nil)
+       (from-phrase nil))
+    (loop for (prep . rest) in prep-phrases
+         do
+         (case prep
+           ((:in :of)
+            (when in-phrase
+              (ansi-loop::loop-error
+               "Duplicate OF or IN iteration path: ~S." (cons prep rest)))
+            (setq in-phrase rest))
+           ((:from)
+            (when from-phrase
+              (ansi-loop::loop-error
+               "Duplicate FROM iteration path: ~S." (cons prep rest)))
+            (setq from-phrase rest))
+           (t
+            (ansi-loop::loop-error
+             "Unknown preposition: ~S." prep))))
+    (unless in-phrase
+      (ansi-loop::loop-error "Missing OF or IN iteration path."))
+    (unless from-phrase
+      (setq from-phrase '(*default-database*)))
+    (cond
+      ((consp variable)
+       (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
+            (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
+            (result-set-var (ansi-loop::loop-gentemp
+                             'loop-record-result-set-))
+            (step-var (ansi-loop::loop-gentemp 'loop-record-step-)))
+        (push `(when ,result-set-var
+                (database-dump-result-set ,result-set-var ,db-var))
+              ansi-loop::*loop-epilogue*)
+        `(((,variable nil ,data-type) (,query-var ,(first in-phrase))
+           (,db-var ,(first from-phrase))
+           (,result-set-var nil)
+           (,step-var nil))
+          ((multiple-value-bind (%rs %cols)
+               (database-query-result-set ,query-var ,db-var)
+             (setq ,result-set-var %rs ,step-var (make-list %cols))))
+          ()
+          ()
+          (not (database-store-next-row ,result-set-var ,db-var ,step-var))
+          (,variable ,step-var)
+          (not ,result-set-var)
+          ()
+          (not (database-store-next-row ,result-set-var ,db-var ,step-var))
+          (,variable ,step-var))))
+      (t
+       (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
+            (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
+            (result-set-var (ansi-loop::loop-gentemp
+                             'loop-record-result-set-)))
+        (push `(when ,result-set-var
+                (database-dump-result-set ,result-set-var ,db-var))
+              ansi-loop::*loop-epilogue*)
+        `(((,variable nil ,data-type) (,query-var ,(first in-phrase))
+           (,db-var ,(first from-phrase))
+           (,result-set-var nil))
+          ((multiple-value-bind (%rs %cols)
+               (database-query-result-set ,query-var ,db-var)
+             (setq ,result-set-var %rs ,variable (make-list %cols))))
+          ()
+          ()
+          (not (database-store-next-row ,result-set-var ,db-var ,variable))
+          ()
+          (not ,result-set-var)
+          ()
+          (not (database-store-next-row ,result-set-var ,db-var ,variable))
+          ()))))))
+
+#+cmu
+(ansi-loop::add-loop-path '(record records tuple tuples)
+                         'loop-record-iteration-path
+                         ansi-loop::*loop-ansi-universe*
+                         :preposition-groups '((:of :in) (:from))
+                         :inclusive-permitted nil)

diff --git a/sql/package.cl b/sql/package.cl
new file mode 100644 (file)
index 0000000..2bb0d8e
--- /dev/null
+++ b/sql/package.cl
@@ -0,0 +1,133 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          package.cl
+;;;; Purpose:       Package definition for CLSQL (high-level) interface
+;;;; Programmers:   Kevin M. Rosenberg based on
+;;;;                Original code by Pierre R. Mai 
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: package.cl,v 1.19 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defpackage :clsql-sys
+    (:nicknames :clsql)
+    (:use :common-lisp :clsql-base-sys)
+    (:import-from 
+     :clsql-base
+     .
+     #1=(
+        #:clsql-condition
+        #:clsql-error
+        #:clsql-simple-error
+        #:clsql-warning
+        #:clsql-simple-warning
+        #:clsql-invalid-spec-error
+        #:clsql-invalid-spec-error-connection-spec
+        #:clsql-invalid-spec-error-database-type
+        #:clsql-invalid-spec-error-template
+        #:clsql-connect-error
+        #:clsql-connect-error-database-type
+        #:clsql-connect-error-connection-spec
+        #:clsql-connect-error-errno
+        #:clsql-connect-error-error
+        #:clsql-sql-error
+        #:clsql-sql-error-database
+        #:clsql-sql-error-expression
+        #:clsql-sql-error-errno
+        #:clsql-sql-error-error
+        #:clsql-database-warning
+        #:clsql-database-warning-database
+        #:clsql-database-warning-message
+        #:clsql-exists-condition
+        #:clsql-exists-condition-new-db
+        #:clsql-exists-condition-old-db
+        #:clsql-exists-warning
+        #:clsql-exists-error
+        #:clsql-closed-error
+        #:clsql-closed-error-database
+        
+        #:*loaded-database-types*
+        #:reload-database-types
+        #:*default-database-type*
+        #:*initialized-database-types*
+        #:initialize-database-type
+        
+        #:database
+        #:database-name
+        #:closed-database
+        #:database-name-from-spec
+        
+        ;; utils.cl
+        #:number-to-sql-string
+        #:float-to-sql-string
+        #:sql-escape-quotes
+        ))
+    (:export
+     ;; sql.cl
+     #:*connect-if-exists*
+     #:connected-databases
+     #:*default-database*
+     #:find-database
+     #:connect
+     #:disconnect
+     #:query
+     #:execute-command
+     #:map-query
+     #:do-query
+     
+     ;; functional.cl
+     #:insert-records
+     #:delete-records
+     #:update-records
+     #:with-database
+     
+     ;; For High-level UncommonSQL compatibility
+     #:sql-ident
+     #:list-tables
+     #:list-attributes
+     #:attribute-type
+     #:create-sequence 
+     #:drop-sequence
+     #:sequence-next
+     
+     ;; Pooled connections
+     #:disconnect-pooled
+     #:find-or-create-connection-pool
+     
+     ;; Transactions
+     #:with-transaction
+     #:commit-transaction
+     #:rollback-transaction
+     #:add-transaction-commit-hook
+     #:add-transaction-rollback-hook
+     
+     ;; Large objects (Marc B)
+     #:create-large-object
+     #:write-large-object
+     #:read-large-object
+     #:delete-large-object
+     
+     .
+     #1#
+     )
+    (:documentation "This is the INTERNAL SQL-Interface package of CLSQL."))
+  
+  )                                    ;eval-when
+
+(defpackage #:clsql-user
+  (:use #:common-lisp #:clsql)
+  (:documentation "This is the user package for experimenting with CLSQL."))

diff --git a/sql/pool.cl b/sql/pool.cl
new file mode 100644 (file)
index 0000000..f4d965c
--- /dev/null
+++ b/sql/pool.cl
@@ -0,0 +1,79 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          pool.cl
+;;;; Purpose:       Support function for connection pool
+;;;; Programmers:   Kevin M. Rosenberg, Marc Battyani
+;;;; Date Started:  Apr 2002
+;;;;
+;;;; $Id: pool.cl,v 1.8 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+(defvar *db-pool* (make-hash-table :test #'equal))
+
+(defclass conn-pool ()
+  ((connection-spec :accessor connection-spec :initarg :connection-spec)
+   (database-type :accessor database-type :initarg :database-type)
+   (free-connections :accessor free-connections
+                    :initform (make-array 5 :fill-pointer 0 :adjustable t))
+   (all-connections :accessor all-connections
+                   :initform (make-array 5 :fill-pointer 0 :adjustable t))))
+
+(defun acquire-from-conn-pool (pool)
+  (if (zerop (length (free-connections pool)))
+    (let ((conn (connect (connection-spec pool)
+                        :database-type (database-type pool) :if-exists :new)))
+      (vector-push-extend conn (all-connections pool))
+      (setf (conn-pool conn) pool)
+      conn)
+    (vector-pop (free-connections pool))))
+
+(defun release-to-conn-pool (conn)
+  (vector-push-extend conn (free-connections (conn-pool conn))))
+
+(defun clear-conn-pool (pool)
+  (loop for conn across (all-connections pool)
+       do (setf (conn-pool conn) nil)
+          (disconnect :database conn))
+  (setf (fill-pointer (free-connections pool)) 0)
+  (setf (fill-pointer (all-connections pool)) 0))
+
+(defun find-or-create-connection-pool (connection-spec database-type)
+  "Find connection pool in hash table, creates a new connection pool if not found"
+  (let* ((key (list connection-spec database-type))
+        (conn-pool (gethash key *db-pool*)))
+    (unless conn-pool
+      (setq conn-pool (make-instance 'conn-pool
+                                    :connection-spec connection-spec
+                                    :database-type database-type))
+      (setf (gethash key *db-pool*) conn-pool))
+    conn-pool))
+
+(defun acquire-from-pool (connection-spec database-type &optional pool)
+  (unless (typep pool 'conn-pool)
+    (setf pool (find-or-create-connection-pool connection-spec database-type)))
+  (acquire-from-conn-pool pool))
+
+(defun release-to-pool (database)
+  (release-to-conn-pool database))
+
+(defun disconnect-pooled (&optional clear)
+  "Disconnects all connections in the pool"
+  (maphash
+   #'(lambda (key conn-pool)
+       (declare (ignore key))
+       (clear-conn-pool conn-pool))
+   *db-pool*)
+  (when clear (clrhash *db-pool*))
+  t)
+

diff --git a/sql/sql.cl b/sql/sql.cl
new file mode 100644 (file)
index 0000000..101d30f
--- /dev/null
+++ b/sql/sql.cl
@@ -0,0 +1,262 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          sql.cl
+;;;; Purpose:       High-level SQL interface
+;;;; Programmers:   Kevin M. Rosenberg based on
+;;;;                 Original code by Pierre R. Mai 
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: sql.cl,v 1.19 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+;;; Modified by KMR 
+;;; - to use CMUCL-COMPAT library 
+;;; - fix format strings in error messages 
+;;; - use field types
+
+
+;;; Simple implementation of SQL along the lines of Harlequin's Common SQL
+
+
+;;; Database handling
+
+(defvar *connect-if-exists* :error
+  "Default value for the if-exists parameter of connect calls.")
+
+(defvar *connected-databases* nil
+  "List of active database objects.")
+
+(defun connected-databases ()
+  "Return the list of active database objects."
+  *connected-databases*)
+
+(defvar *default-database* nil
+  "Specifies the default database to be used.")
+
+(defun find-database (database &optional (errorp t))
+  (etypecase database
+    (database
+     ;; Return the database object itself
+     database)
+    (string
+     (or (find database (connected-databases)
+              :key #'database-name
+              :test #'string=)
+        (when errorp
+          (cerror "Return nil."
+                  'clsql-simple-error
+                  :format-control "There exists no database called ~A."
+                  :format-arguments (list database)))))))
+
+(defun connect (connection-spec
+               &key (if-exists *connect-if-exists*)
+               (database-type *default-database-type*)
+               (pool nil))
+  "Connects to a database of the given database-type, using the type-specific
+connection-spec.  if-exists is currently ignored.
+If pool is t the the connection will be taken from the general pool,
+if pool is a conn-pool object the connection will be taken from this pool.
+"
+  (if pool
+    (acquire-from-pool connection-spec database-type pool)
+    (let* ((db-name (database-name-from-spec connection-spec database-type))
+          (old-db (unless (eq if-exists :new) (find-database db-name nil)))
+          (result nil))
+      (if old-db
+       (case if-exists
+;          (:new
+;           (setq result
+;             (database-connect connection-spec database-type)))
+         (:warn-new
+          (setq result
+                (database-connect connection-spec database-type))
+          (warn 'clsql-exists-warning :old-db old-db :new-db result))
+         (:error
+          (restart-case
+                (error 'clsql-exists-error :old-db old-db)
+              (create-new ()
+                  :report "Create a new connection."
+                (setq result
+                  (database-connect connection-spec database-type)))
+              (use-old ()
+                  :report "Use the existing connection."
+                (setq result old-db))))
+         (:warn-old
+          (setq result old-db)
+          (warn 'clsql-exists-warning :old-db old-db :new-db old-db))
+         (:old
+          (setq result old-db)))
+       (setq result
+             (database-connect connection-spec database-type)))
+      (when result
+       (pushnew result *connected-databases*)
+       (setq *default-database* result)
+       result))))
+
+
+(defun disconnect (&key (database *default-database*))
+  "Closes the connection to database. Resets *default-database* if that
+database was disconnected and only one other connection exists.
+if the database is from a pool it will be released to this pool."
+  (if (conn-pool database)
+      (release-to-pool database)
+    (when (database-disconnect database)
+      (setq *connected-databases* (delete database *connected-databases*))
+      (when (eq database *default-database*)
+       (setq *default-database* (car *connected-databases*)))
+      (change-class database 'closed-database)
+      t)))
+
+;;; Basic operations on databases
+
+(defmethod query (query-expression &key (database *default-database*)  
+                 types)
+  "Execute the SQL query expression query-expression on the given database.
+Returns a list of lists of values of the result of that expression."
+  (database-query query-expression database types))
+
+
+
+(defmethod execute-command (sql-expression &key (database *default-database*))
+  "Execute the SQL command expression sql-expression on the given database.
+Returns true on success or nil on failure."
+  (database-execute-command sql-expression database))
+
+
+
+(defun map-query (output-type-spec function query-expression
+                 &key (database *default-database*)
+                 (types nil))
+  "Map the function over all tuples that are returned by the query in
+query-expression.  The results of the function are collected as
+specified in output-type-spec and returned like in MAP."
+  ;; DANGER Will Robinson: Parts of the code for implementing
+  ;; map-query (including the code below and the helper functions
+  ;; called) are highly CMU CL specific.
+  ;; KMR -- these have been replaced with cross-platform instructions above
+  (macrolet ((type-specifier-atom (type)
+              `(if (atom ,type) ,type (car ,type))))
+    (case (type-specifier-atom output-type-spec)
+      ((nil) 
+       (map-query-for-effect function query-expression database types))
+      (list 
+       (map-query-to-list function query-expression database types))
+      ((simple-vector simple-string vector string array simple-array
+       bit-vector simple-bit-vector base-string
+       simple-base-string)
+       (map-query-to-simple output-type-spec function query-expression database types))
+      (t
+       (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
+              function query-expression :database database :types types)))))
+
+(defun map-query-for-effect (function query-expression database types)
+  (multiple-value-bind (result-set columns)
+      (database-query-result-set query-expression database :full-set nil
+                                :types types)
+    (when result-set
+      (unwind-protect
+          (do ((row (make-list columns)))
+              ((not (database-store-next-row result-set database row))
+               nil)
+            (apply function row))
+       (database-dump-result-set result-set database)))))
+                    
+(defun map-query-to-list (function query-expression database types)
+  (multiple-value-bind (result-set columns)
+      (database-query-result-set query-expression database :full-set nil
+                                :types types)
+    (when result-set
+      (unwind-protect
+          (let ((result (list nil)))
+            (do ((row (make-list columns))
+                 (current-cons result (cdr current-cons)))
+                ((not (database-store-next-row result-set database row))
+                 (cdr result))
+              (rplacd current-cons (list (apply function row)))))
+       (database-dump-result-set result-set database)))))
+
+
+(defun map-query-to-simple (output-type-spec function query-expression database types)
+  (multiple-value-bind (result-set columns rows)
+      (database-query-result-set query-expression database :full-set t
+                                :types types)
+    (when result-set
+      (unwind-protect
+          (if rows
+              ;; We know the row count in advance, so we allocate once
+              (do ((result
+                    (cmucl-compat:make-sequence-of-type output-type-spec rows))
+                   (row (make-list columns))
+                   (index 0 (1+ index)))
+                  ((not (database-store-next-row result-set database row))
+                   result)
+                (declare (fixnum index))
+                (setf (aref result index)
+                      (apply function row)))
+              ;; Database can't report row count in advance, so we have
+              ;; to grow and shrink our vector dynamically
+              (do ((result
+                    (cmucl-compat:make-sequence-of-type output-type-spec 100))
+                   (allocated-length 100)
+                   (row (make-list columns))
+                   (index 0 (1+ index)))
+                  ((not (database-store-next-row result-set database row))
+                   (cmucl-compat:shrink-vector result index))
+                (declare (fixnum allocated-length index))
+                (when (>= index allocated-length)
+                  (setq allocated-length (* allocated-length 2)
+                        result (adjust-array result allocated-length)))
+                (setf (aref result index)
+                      (apply function row))))
+       (database-dump-result-set result-set database)))))
+
+(defmacro do-query (((&rest args) query-expression
+                    &key (database '*default-database*)
+                    (types nil))
+                   &body body)
+  (let ((result-set (gensym))
+       (columns (gensym))
+       (row (gensym))
+       (db (gensym)))
+    `(let ((,db ,database))
+       (multiple-value-bind (,result-set ,columns)
+          (database-query-result-set ,query-expression ,db
+                                     :full-set nil :types ,types)
+        (when ,result-set
+          (unwind-protect
+               (do ((,row (make-list ,columns)))
+                   ((not (database-store-next-row ,result-set ,db ,row))
+                    nil)
+                 (destructuring-bind ,args ,row
+                   ,@body))
+            (database-dump-result-set ,result-set ,db)))))))
+
+;;; Marc Battyani : Large objects support
+
+(defun create-large-object (&key (database *default-database*))
+  "Creates a new large object in the database and returns the object identifier"
+  (database-create-large-object database))
+
+(defun write-large-object (object-id data &key (database *default-database*))
+  "Writes data to the large object"
+  (database-write-large-object object-id data database))
+
+(defun read-large-object (object-id &key (database *default-database*))
+  "Reads the large object content"
+  (database-read-large-object object-id database))
+
+(defun delete-large-object (object-id &key (database *default-database*))
+  "Deletes the large object in the database"
+  (database-delete-large-object object-id database))

diff --git a/sql/transactions.cl b/sql/transactions.cl
new file mode 100644 (file)
index 0000000..c95e8c3
--- /dev/null
+++ b/sql/transactions.cl
@@ -0,0 +1,85 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          transactions.cl
+;;;; Purpose:       Transaction support
+;;;; Programmers:   Marc Battyani
+;;;; Date Started:  Apr 2002
+;;;;
+;;;; $Id: transactions.cl,v 1.7 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+;; I removed the USQL transaction stuff to put a smaller, lighter one (MB)
+
+(defclass transaction ()
+  ((commit-hooks :initform () :accessor commit-hooks)
+   (rollback-hooks :initform () :accessor rollback-hooks)
+   (status :initform nil :accessor status))) ;can be nil :rolled-back or :commited
+
+(defmethod database-start-transaction ((database closed-database))
+  (error 'clsql-closed-database-error database))
+
+(defmethod database-start-transaction (database)
+  (unless (transaction database)
+    (setf (transaction database) (make-instance 'transaction)))
+  (when (= (incf (transaction-level database)) 1)
+    (let ((transaction (transaction database)))
+      (setf (commit-hooks transaction) nil
+           (rollback-hooks transaction) nil
+           (status transaction) nil)
+      (execute-command "BEGIN" :database database))))
+
+(defmethod database-end-transaction ((database closed-database))
+  (error 'clsql-closed-database-error database))
+
+(defmethod database-end-transaction (database)
+  (if (> (transaction-level database) 0)
+    (when (zerop (decf (transaction-level database)))
+      (let ((transaction (transaction database)))
+       (if (eq (status transaction) :commited)
+         (progn
+           (execute-command "COMMIT" :database database)
+           (map nil #'funcall (commit-hooks transaction)))
+         (unwind-protect ;status is not :commited
+              (execute-command "ROLLBACK" :database database)
+           (map nil #'funcall (rollback-hooks transaction))))))
+    (warn "Continue without commit."
+         'clsql-simple-error
+         :format-control "Cannot commit transaction against ~A because there is no transaction in progress."
+         :format-arguments (list database))))
+
+(defun rollback-transaction (database)
+  (when (and (transaction database)(not (status (transaction database))))
+    (setf (status (transaction database)) :rolled-back)))
+
+(defun commit-transaction (database)
+  (when (and (transaction database)(not (status (transaction database))))
+    (setf (status (transaction database)) :commited)))
+
+(defun add-transaction-commit-hook (database commit-hook)
+  (when (transaction database)
+    (push commit-hook (commit-hooks (transaction database)))))
+
+(defun add-transaction-rollback-hook (database rollback-hook)
+  (when (transaction database)
+    (push rollback-hook (rollback-hooks (transaction database)))))
+
+(defmacro with-transaction ((&key (database '*default-database*)) &rest body)
+  (let ((db (gensym "db-")))
+    `(let ((,db ,database))
+      (unwind-protect
+          (progn
+            (database-start-transaction ,db)
+            ,@body
+            (commit-transaction ,db))
+       (database-end-transaction ,db)))))

diff --git a/sql/usql.cl b/sql/usql.cl
new file mode 100644 (file)
index 0000000..1141dc0
--- /dev/null
+++ b/sql/usql.cl
@@ -0,0 +1,57 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          usql.cl
+;;;; Purpose:       High-level interface to SQL driver routines needed for
+;;;;                UncommonSQL
+;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc
+;;;; Date Started:  Mar 2002
+;;;;
+;;;; $Id: usql.cl,v 1.11 2002/09/17 17:16:43 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and 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.
+;;;; *************************************************************************
+
+
+;;; Minimal high-level routines to enable low-level interface for USQL
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+(defun list-tables (&key (database *default-database*)
+                         (system-tables nil))
+  "List all tables in *default-database*, or if the :database keyword arg
+is given, the specified database.  If the keyword arg :system-tables
+is true, then it will not filter out non-user tables.  Table names are
+given back as a list of strings."
+  (database-list-tables database :system-tables system-tables))
+
+
+(defun list-attributes (table &key (database *default-database*))
+  "List the attributes of TABLE in *default-database, or if the
+:database keyword is given, the specified database.  Attributes are
+returned as a list of strings."
+  (database-list-attributes table database))
+
+(defun attribute-type (attribute table &key (database *default-database*))
+  "Return the field type of the ATTRIBUTE in TABLE.  The optional
+keyword argument :database specifies the database to query, defaulting
+to *default-database*."
+  (database-attribute-type attribute table database))
+
+(defun create-sequence (name &key (database *default-database*))
+  (database-create-sequence name database))
+
+(defun drop-sequence (name &key (database *default-database*))
+  (database-drop-sequence name database))
+
+(defun sequence-next (name &key (database *default-database*))
+  (database-sequence-next name database))
+
+