From: Kevin M. Rosenberg Date: Fri, 29 Mar 2002 07:45:34 +0000 (+0000) Subject: r1696: *** empty log message *** X-Git-Tag: v3.8.6~1189 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=30656549f102f19d3cedba9e2b6e30fc763ea20d r1696: *** empty log message *** --- diff --git a/ChangeLog b/ChangeLog index 73b1e12..b9839d8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,6 @@ +29 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net) + * Separated db-interface and conditions from sql/sql.cl + 27 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net) * interfaces/postgresql-socket/postgresql-socket-api.cl: Fixes to read-double-from-socket. Added 64-bit integer support. diff --git a/clsql.system b/clsql.system index 33b819d..52c55fd 100644 --- a/clsql.system +++ b/clsql.system @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: clsql.system,v 1.2 2002/03/26 14:12:12 kevin Exp $ +;;;; $Id: clsql.system,v 1.3 2002/03/29 07:42:10 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -37,7 +37,9 @@ :source-extension "cl" :binary-pathname "CLSQL:sql;bin;" :components ((:file "package") - (:file "sql" :depends-on ("package")) + (:file "conditions" :depends-on ("package")) + (:file "db-interface" :depends-on ("conditions")) + (:file "sql" :depends-on ("db-interface")) (:file "utils" :depends-on ("package")) (:file "functional" :depends-on ("sql"))) :depends-on (:cmucl-compat) diff --git a/sql/conditions.cl b/sql/conditions.cl new file mode 100644 index 0000000..af6822c --- /dev/null +++ b/sql/conditions.cl @@ -0,0 +1,140 @@ +;;;; -*- 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/03/29 07:42:10 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))))) + diff --git a/sql/db-interface.cl b/sql/db-interface.cl new file mode 100644 index 0000000..5f4f805 --- /dev/null +++ b/sql/db-interface.cl @@ -0,0 +1,100 @@ +;;;; -*- 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 +;;;; Date Started: Feb 2002 +;;;; +;;;; $Id: db-interface.cl,v 1.1 2002/03/29 07:42:10 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) + + +(defgeneric database-type-load-foreign (database-type) + (:documentation + "The internal generic implementation of reload-database-types.") + (:method :after (database-type) + (pushnew database-type *loaded-database-types*))) + +(defgeneric database-type-library-loaded (database-type) + (:documentation + "The internal generic implementation for checking if +database type library loaded successfully.")) + +(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)) + (: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)) + (: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)) + (: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)) + (: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)) + (: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)) + (:documentation + "Returns t and stores the next row in the result set in list or +returns nil when result-set is finished.")) diff --git a/sql/sql.cl b/sql/sql.cl index a0fc833..2d8ab3f 100644 --- a/sql/sql.cl +++ b/sql/sql.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: sql.cl,v 1.7 2002/03/26 14:11:59 kevin Exp $ +;;;; $Id: sql.cl,v 1.8 2002/03/29 07:42:10 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -29,122 +29,6 @@ ;;; Simple implementation of SQL along the lines of Harlequin's Common SQL -;;; 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))))) ;;; Database Types @@ -155,16 +39,6 @@ although there is an existing connection (~A)." "Reloads any foreign code for the loaded database types after a dump." (mapc #'database-type-load-foreign *loaded-database-types*)) -(defgeneric database-type-load-foreign (database-type) - (:documentation - "The internal generic implementation of reload-database-types.") - (:method :after (database-type) - (pushnew database-type *loaded-database-types*))) - -(defgeneric database-type-library-loaded (database-type) - (:documentation - "The internal generic implementation for checking if -database type library loaded successfully.")) (defvar *default-database-type* nil "Specifies the default type of database. Currently only :mysql is @@ -183,9 +57,6 @@ initialized, as indicated by `*initialized-database-types*'." (push database-type *initialized-database-types*) t))) -(defgeneric database-initialize-database-type (database-type) - (:documentation - "The internal generic implementation of initialize-database-type.")) ;;; Database handling @@ -286,13 +157,7 @@ connection-spec. if-exists is currently ignored." (setq *default-database* result) result))) -(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.")) (defun disconnect (&key (database *default-database*)) "Closes the connection to database. Resets *default-database* if that @@ -304,10 +169,7 @@ database was disconnected and only one other connection exists." (change-class database 'closed-database) t)) -(defgeneric database-disconnect (database) - (:method ((database closed-database)) - (signal-closed-database-error database)) - (:documentation "Internal generic implementation of disconnect.")) + ;;; Basic operations on databases @@ -317,59 +179,13 @@ database was disconnected and only one other connection exists." Returns a list of lists of values of the result of that expression." (database-query query-expression database types)) -(defgeneric database-query (query-expression database types) - (:method (query-expression (database closed-database) types) - (declare (ignore query-expression types)) - (signal-closed-database-error database)) - (:documentation "Internal generic implementation of query.")) + (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)) -(defgeneric database-execute-command (sql-expression database) - (:method (sql-expression (database closed-database)) - (declare (ignore sql-expression)) - (signal-closed-database-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)) - (: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)) - (: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)) - (:documentation - "Returns t and stores the next row in the result set in list or -returns nil when result-set is finished.")) - (defun map-query (output-type-spec function query-expression