From: Kevin M. Rosenberg Date: Mon, 13 May 2002 16:22:08 +0000 (+0000) Subject: r2024: moved files to separate base interface X-Git-Tag: v3.8.6~1086 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=43d545f166cd4eb23ba835aa92685d5bd6d23d01 r2024: moved files to separate base interface --- diff --git a/base/classes.cl b/base/classes.cl new file mode 100644 index 0000000..0a91a16 --- /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.1 2002/05/13 16:22:08 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) + + +(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) + "") + 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) + "") + stream))) + diff --git a/base/conditions.cl b/base/conditions.cl new file mode 100644 index 0000000..5785653 --- /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.1 2002/05/13 16:22:08 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) + +;;; 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 index 0000000..f779159 --- /dev/null +++ b/base/db-interface.cl @@ -0,0 +1,182 @@ +;;;; -*- 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/05/13 16:22:08 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-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-type) + (:documentation + "Returns database type") + (:method (database-type) + (declare (ignore database-type)) + (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/package.cl b/base/package.cl new file mode 100644 index 0000000..71aa24e --- /dev/null +++ b/base/package.cl @@ -0,0 +1,160 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: package.cl +;;;; Purpose: Package definition for high-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/05/13 16:22:08 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-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 + + . + #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 + #:connect + #:disconnect + #:query + #:execute-command + #:map-query + #:do-query + + ;; functional.cl + #:insert-records + #:delete-records + #:update-records + #:with-database + + ;; utils.cl + #:number-to-sql-string + #:float-to-sql-string + #:sql-escape-quotes + + ;; For UncommonSQL support + #:sql-ident + #:list-tables + #:list-attributes + #:attribute-type + #:create-sequence + #:drop-sequence + #:sequence-next + + ;; Pooled connections + #:disconnect-pooled + + ;; 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 + )) + (:documentation "This is the INTERNAL SQL-Interface package of CLSQL.")) + +(defpackage #:clsql + (:import-from #:clsql-sys . #1#) + (:export . #1#) + (:documentation "This is the 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-base.system b/clsql-base.system index 7f82393..80f359c 100644 --- a/clsql-base.system +++ b/clsql-base.system @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: clsql-base.system,v 1.2 2002/05/13 05:24:57 kevin Exp $ +;;;; $Id: clsql-base.system,v 1.3 2002/05/13 16:22:08 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -28,9 +28,9 @@ ;;; System definitions (mk:defsystem :clsql-base - :source-pathname "CL-LIBRARY:clsql;sql;" + :source-pathname "CL-LIBRARY:clsql;base;" :source-extension "cl" - :binary-pathname "CL-LIBRARY:clsql;sql;bin;" + :binary-pathname "CL-LIBRARY:clsql;base;bin;" :components ((:file "package") (:file "classes" :depends-on ("package")) (:file "conditions" :depends-on ("classes")) diff --git a/debian/cl-sql-base.dirs b/debian/cl-sql-base.dirs index 7133f9e..44f8191 100644 --- a/debian/cl-sql-base.dirs +++ b/debian/cl-sql-base.dirs @@ -5,7 +5,7 @@ usr/share/common-lisp/systems usr/share/common-lisp/source usr/share/common-lisp/repositories usr/share/common-lisp/repositories/clsql -usr/share/common-lisp/repositories/clsql/sql +usr/share/common-lisp/repositories/clsql/base usr/share/common-lisp/repositories/clsql/interfaces usr/share/common-lisp/repositories/clsql/interfaces/clsql-uffi diff --git a/debian/rules b/debian/rules index 30dc211..17c2791 100755 --- a/debian/rules +++ b/debian/rules @@ -24,9 +24,9 @@ prefix-pg-socket := debian/$(pkg-pg-socket) prefix-aodbc := debian/$(pkg-aodbc) ## Lisp sources -srcs := sql/pool.cl sql/sql.cl sql/transactions.cl sql/utils.cl sql/functional.cl sql/usql.cl -srcs-cmucl-compat := $(wildcard cmucl-compat/*.cl) -srcs-base := sql/package.cl sql/db-interface.cl sql/classes.cl sql/conditions.cl +srcs := $(wildcard sql/*.cl) +srcs-cmucl-compat:= $(wildcard cmucl-compat/*.cl) +srcs-base := $(wildcard base/*.cl) srcs-base-uffi := $(wildcard interfaces/clsql-uffi/*.cl) $(wildcard interfaces/clsql-uffi/*.so) srcs-mysql := $(wildcard interfaces/mysql/*.cl) $(wildcard interfaces/mysql/*.so) srcs-pg := $(wildcard interfaces/postgresql/*.cl) @@ -78,14 +78,15 @@ install: build $(INSTALL) $(INSTALLFLAGS) $(srcs-cmucl-compat) $(prefix)/$(clc-repos)/clsql/cmucl-compat # Base - $(INSTALL) $(INSTALLFLAGS) $(srcs-base) $(prefix-base)/$(clc-repos)/clsql/sql + $(INSTALL) $(INSTALLFLAGS) $(srcs-base) $(prefix-base)/$(clc-repos)/clsql/base $(INSTALL) $(INSTALLFLAGS) $(srcs-base-uffi) $(prefix-base)/$(clc-repos)/clsql/interfaces/clsql-uffi + chmod +x $(wildcard $(prefix-base)/$(clc-repos)/clsql/interfaces/clsql-uffi/*.so) $(INSTALL) $(INSTALLFLAGS) $(srcs-mysql) $(prefix-mysql)/$(clc-repos)/clsql/interfaces/mysql + chmod +x $(wildcard $(prefix-mysql)/$(clc-repos)/clsql/interfaces/mysql/*.so) $(INSTALL) $(INSTALLFLAGS) $(srcs-pg) $(prefix-pg)/$(clc-repos)/clsql/interfaces/postgresql $(INSTALL) $(INSTALLFLAGS) $(srcs-pg-socket) $(prefix-pg-socket)/$(clc-repos)/clsql/interfaces/postgresql-socket $(INSTALL) $(INSTALLFLAGS) $(srcs-aodbc) $(prefix-aodbc)/$(clc-repos)/clsql/interfaces/aodbc - chmod +x `find debian -type f -name \*.so` # CLC Systems $(INSTALL) $(INSTALLFLAGS) clsql.system $(prefix)/$(clc-systems)/ diff --git a/sql/classes.cl b/sql/classes.cl deleted file mode 100644 index 4cb643a..0000000 --- a/sql/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.6 2002/05/07 10:19:13 marc.battyani 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) - - -(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) - "") - 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) - "") - stream))) - diff --git a/sql/conditions.cl b/sql/conditions.cl deleted file mode 100644 index c669cdd..0000000 --- a/sql/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.2 2002/03/29 08:12:16 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) - -;;; 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/sql/db-interface.cl b/sql/db-interface.cl deleted file mode 100644 index b2dd41e..0000000 --- a/sql/db-interface.cl +++ /dev/null @@ -1,182 +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.7 2002/04/27 20:58:11 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-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-type) - (:documentation - "Returns database type") - (:method (database-type) - (declare (ignore database-type)) - (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/sql/package.cl b/sql/package.cl deleted file mode 100644 index ec93e1e..0000000 --- a/sql/package.cl +++ /dev/null @@ -1,160 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: package.cl -;;;; Purpose: Package definition for high-level SQL interface -;;;; Programmers: Kevin M. Rosenberg based on -;;;; Original code by Pierre R. Mai -;;;; Date Started: Feb 2002 -;;;; -;;;; $Id: package.cl,v 1.14 2002/05/11 22:37:46 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-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 - - . - #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 - #:connect - #:disconnect - #:query - #:execute-command - #:map-query - #:do-query - - ;; functional.cl - #:insert-records - #:delete-records - #:update-records - #:with-database - - ;; utils.cl - #:number-to-sql-string - #:float-to-sql-string - #:sql-escape-quotes - - ;; For UncommonSQL support - #:sql-ident - #:list-tables - #:list-attributes - #:attribute-type - #:create-sequence - #:drop-sequence - #:sequence-next - - ;; Pooled connections - #:disconnect-pooled - - ;; 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 - )) - (:documentation "This is the INTERNAL SQL-Interface package of CLSQL.")) - -(defpackage #:clsql - (:import-from #:clsql-sys . #1#) - (:export . #1#) - (:documentation "This is the SQL-Interface package of CLSQL.")) -);eval-when - -(defpackage #:clsql-user - (:use #:common-lisp #:clsql) - (:documentation "This is the user package for experimenting with CLSQL."))