+++ /dev/null
-;;;; -*- 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)))
-
--- /dev/null
+;;;; -*- 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.lisp,v 1.1 2002/09/30 10:19:01 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)))
+
+++ /dev/null
-;;;; -*- 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))
--- /dev/null
+;;;; -*- 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.lisp,v 1.1 2002/09/30 10:19:01 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))
+++ /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.5 2002/09/30 06:13:05 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))
-
--- /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.lisp,v 1.1 2002/09/30 10:19:01 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))
+
+++ /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. Additions from
-;;;; onShoreD to support UncommonSQL front-end
-;;;; Date Started: Feb 2002
-;;;;
-;;;; $Id: db-interface.cl,v 1.6 2002/09/27 15:08:13 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)
- (: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 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"))
--- /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. Additions from
+;;;; onShoreD to support UncommonSQL front-end
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: db-interface.lisp,v 1.1 2002/09/30 10:19:01 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)
+ (: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 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"))
+++ /dev/null
-;;;; -*- 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)))
-
-
--- /dev/null
+;;;; -*- 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.lisp,v 1.1 2002/09/30 10:19:01 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)))
+
+
+++ /dev/null
-;;;; -*- 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
-
-
--- /dev/null
+;;;; -*- 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.lisp,v 1.1 2002/09/30 10:19:01 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
+
+
+++ /dev/null
-;;;; -*- 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.7 2002/09/30 01:57:32 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"
- (let ((str (write-to-string num :readably t)))
- (cond
- ((find #\f str)
- (substitute #\e #\f str))
- ((find #\d str)
- (substitute #\e #\d str))
- ((find #\F str)
- (substitute #\e #\F str))
- ((find #\D str)
- (substitute #\e #\D str))
- ((find #\S str)
- (substitute #\e #\S str))
- (t
- str))))
-
- (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)))
-
-
--- /dev/null
+;;;; -*- 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.lisp,v 1.1 2002/09/30 10:19:01 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"
+ (let ((str (write-to-string num :readably t)))
+ (cond
+ ((find #\f str)
+ (substitute #\e #\f str))
+ ((find #\d str)
+ (substitute #\e #\d str))
+ ((find #\F str)
+ (substitute #\e #\F str))
+ ((find #\D str)
+ (substitute #\e #\D str))
+ ((find #\S str)
+ (substitute #\e #\S str))
+ (t
+ str))))
+
+ (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)))
+
+
projects / clsql.git / commitdiff