+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.
;;;; 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
;;;;
: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)
--- /dev/null
+;;;; -*- 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)))))
+
--- /dev/null
+;;;; -*- 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."))
;;;; 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
;;; 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
"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
(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
(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
(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
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
projects / clsql.git / commitdiff