--- /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.1 2002/05/13 16:22:08 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+
+(defclass database ()
+ ((name :initform nil :initarg :name :reader database-name)
+ (connection-spec :initform nil :initarg :connection-spec :reader connection-spec
+ :documentation "Require to use connection pool")
+ (transaction-level :initform 0 :accessor transaction-level)
+ (transaction :initform nil :accessor transaction)
+ (conn-pool :initform nil :initarg :conn-pool :accessor conn-pool))
+ (:documentation
+ "This class is the supertype of all databases handled by CLSQL."))
+
+(defmethod print-object ((object database) stream)
+ (print-unreadable-object (object stream :type t :identity t)
+ (write-string (if (slot-boundp object 'name)
+ (database-name object)
+ "<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: conditions.cl
+;;;; Purpose: Error conditions for high-level SQL interface
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: conditions.cl,v 1.1 2002/05/13 16:22:08 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+;;; Conditions
+(define-condition clsql-condition ()
+ ())
+
+(define-condition clsql-error (error clsql-condition)
+ ())
+
+(define-condition clsql-simple-error (simple-condition clsql-error)
+ ())
+
+(define-condition clsql-warning (warning clsql-condition)
+ ())
+
+(define-condition clsql-simple-warning (simple-condition clsql-warning)
+ ())
+
+(define-condition clsql-invalid-spec-error (clsql-error)
+ ((connection-spec :initarg :connection-spec
+ :reader clsql-invalid-spec-error-connection-spec)
+ (database-type :initarg :database-type
+ :reader clsql-invalid-spec-error-database-type)
+ (template :initarg :template
+ :reader clsql-invalid-spec-error-template))
+ (:report (lambda (c stream)
+ (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
+ (clsql-invalid-spec-error-connection-spec c)
+ (clsql-invalid-spec-error-database-type c)
+ (clsql-invalid-spec-error-template c)))))
+
+(defmacro check-connection-spec (connection-spec database-type template)
+ "Check the connection specification against the provided template,
+and signal an clsql-invalid-spec-error if they don't match."
+ `(handler-case
+ (destructuring-bind ,template ,connection-spec
+ (declare (ignore ,@template))
+ t)
+ (error () (error 'clsql-invalid-spec-error
+ :connection-spec ,connection-spec
+ :database-type ,database-type
+ :template (quote ,template)))))
+
+(define-condition clsql-connect-error (clsql-error)
+ ((database-type :initarg :database-type
+ :reader clsql-connect-error-database-type)
+ (connection-spec :initarg :connection-spec
+ :reader clsql-connect-error-connection-spec)
+ (errno :initarg :errno :reader clsql-connect-error-errno)
+ (error :initarg :error :reader clsql-connect-error-error))
+ (:report (lambda (c stream)
+ (format stream "While trying to connect to database ~A~% using database-type ~A:~% Error ~D / ~A~% has occurred."
+ (database-name-from-spec
+ (clsql-connect-error-connection-spec c)
+ (clsql-connect-error-database-type c))
+ (clsql-connect-error-database-type c)
+ (clsql-connect-error-errno c)
+ (clsql-connect-error-error c)))))
+
+(define-condition clsql-sql-error (clsql-error)
+ ((database :initarg :database :reader clsql-sql-error-database)
+ (expression :initarg :expression :reader clsql-sql-error-expression)
+ (errno :initarg :errno :reader clsql-sql-error-errno)
+ (error :initarg :error :reader clsql-sql-error-error))
+ (:report (lambda (c stream)
+ (format stream "While accessing database ~A~% with expression ~S:~% Error ~D / ~A~% has occurred."
+ (clsql-sql-error-database c)
+ (clsql-sql-error-expression c)
+ (clsql-sql-error-errno c)
+ (clsql-sql-error-error c)))))
+
+(define-condition clsql-database-warning (clsql-warning)
+ ((database :initarg :database :reader clsql-database-warning-database)
+ (message :initarg :message :reader clsql-database-warning-message))
+ (:report (lambda (c stream)
+ (format stream "While accessing database ~A~% Warning: ~A~% has occurred."
+ (clsql-database-warning-database c)
+ (clsql-database-warning-message c)))))
+
+(define-condition clsql-exists-condition (clsql-condition)
+ ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
+ (new-db :initarg :new-db :reader clsql-exists-condition-new-db
+ :initform nil))
+ (:report (lambda (c stream)
+ (format stream "In call to ~S:~%" 'connect)
+ (cond
+ ((null (clsql-exists-condition-new-db c))
+ (format stream
+ " There is an existing connection ~A to database ~A."
+ (clsql-exists-condition-old-db c)
+ (database-name (clsql-exists-condition-old-db c))))
+ ((eq (clsql-exists-condition-new-db c)
+ (clsql-exists-condition-old-db c))
+ (format stream
+ " Using existing connection ~A to database ~A."
+ (clsql-exists-condition-old-db c)
+ (database-name (clsql-exists-condition-old-db c))))
+ (t
+ (format stream
+ " Created new connection ~A to database ~A~% ~
+although there is an existing connection (~A)."
+ (clsql-exists-condition-new-db c)
+ (database-name (clsql-exists-condition-new-db c))
+ (clsql-exists-condition-old-db c)))))))
+
+(define-condition clsql-exists-warning (clsql-exists-condition
+ clsql-warning)
+ ())
+
+(define-condition clsql-exists-error (clsql-exists-condition
+ clsql-error)
+ ())
+
+(define-condition clsql-closed-error (clsql-error)
+ ((database :initarg :database :reader clsql-closed-error-database))
+ (:report (lambda (c stream)
+ (format stream "The database ~A has already been closed."
+ (clsql-closed-error-database c)))))
+
+(define-condition clsql-nodb-error (clsql-error)
+ ((database :initarg :database :reader clsql-nodb-error-database))
+ (:report (lambda (c stream)
+ (format stream "No such database ~S is open."
+ (clsql-nodb-error-database c)))))
+
+
+;; Signal conditions
+
+
+(defun signal-closed-database-error (database)
+ (cerror "Ignore this error and return nil."
+ 'clsql-closed-error
+ :database database))
+
+(defun signal-nodb-error (database)
+ (cerror "Ignore this error and return nil."
+ 'clsql-nodb-error
+ :database database))
+
--- /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.1 2002/05/13 16:22:08 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai, and onShoreD
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-sys)
+
+(defgeneric database-type-load-foreign (database-type)
+ (:documentation
+ "The internal generic implementation of reload-database-types."))
+
+(defgeneric database-type-library-loaded (database-type)
+ (:documentation
+ "The internal generic implementation for checking if
+database type library loaded successfully."))
+
+(defgeneric database-type (database-type)
+ (:documentation
+ "Returns database type")
+ (:method (database-type)
+ (declare (ignore database-type))
+ (signal-nodb-error database)))
+
+
+(defgeneric database-initialize-database-type (database-type)
+ (:documentation
+ "The internal generic implementation of initialize-database-type."))
+
+(defgeneric database-name-from-spec (connection-spec database-type)
+ (:documentation
+ "Returns the name of the database that would be created if connect
+was called with the connection-spec."))
+
+(defgeneric database-connect (connection-spec database-type)
+ (:documentation "Internal generic implementation of connect."))
+
+(defgeneric database-disconnect (database)
+ (:method ((database closed-database))
+ (signal-closed-database-error database))
+ (:method ((database t))
+ (signal-nodb-error database))
+ (:documentation "Internal generic implementation of disconnect."))
+
+(defgeneric database-query (query-expression database types)
+ (:method (query-expression (database closed-database) types)
+ (declare (ignore query-expression types))
+ (signal-closed-database-error database))
+ (:method (query-expression (database t) types)
+ (declare (ignore query-expression types))
+ (signal-nodb-error database))
+ (:documentation "Internal generic implementation of query."))
+
+
+(defgeneric database-execute-command (sql-expression database)
+ (:method (sql-expression (database closed-database))
+ (declare (ignore sql-expression))
+ (signal-closed-database-error database))
+ (:method (sql-expression (database t))
+ (declare (ignore sql-expression))
+ (signal-nodb-error database))
+ (:documentation "Internal generic implementation of execute-command."))
+
+;;; Mapping and iteration
+(defgeneric database-query-result-set
+ (query-expression database &key full-set types)
+ (:method (query-expression (database closed-database) &key full-set types)
+ (declare (ignore query-expression full-set types))
+ (signal-closed-database-error database)
+ (values nil nil nil))
+ (:method (query-expression (database t) &key full-set types)
+ (declare (ignore query-expression full-set types))
+ (signal-nodb-error database)
+ (values nil nil nil))
+ (:documentation
+ "Internal generic implementation of query mapping. Starts the
+query specified by query-expression on the given database and returns
+a result-set to be used with database-store-next-row and
+database-dump-result-set to access the returned data. The second
+value is the number of columns in the result-set, if there are any.
+If full-set is true, the number of rows in the result-set is returned
+as a third value, if this is possible (otherwise nil is returned for
+the third value). This might have memory and resource usage
+implications, since many databases will require the query to be
+executed in full to answer this question. If the query produced no
+results then nil is returned for all values that would have been
+returned otherwise. If an error occurs during query execution, the
+function should signal a clsql-sql-error."))
+
+(defgeneric database-dump-result-set (result-set database)
+ (:method (result-set (database closed-database))
+ (declare (ignore result-set))
+ (signal-closed-database-error database))
+ (:method (result-set (database t))
+ (declare (ignore result-set))
+ (signal-nodb-error database))
+ (:documentation "Dumps the received result-set."))
+
+(defgeneric database-store-next-row (result-set database list)
+ (:method (result-set (database closed-database) list)
+ (declare (ignore result-set list))
+ (signal-closed-database-error database))
+ (:method (result-set (database t) list)
+ (declare (ignore result-set list))
+ (signal-nodb-error database))
+ (:documentation
+ "Returns t and stores the next row in the result set in list or
+returns nil when result-set is finished."))
+
+
+;; Interfaces to support UncommonSQL
+
+(defgeneric database-create-sequence (name database)
+ (:documentation "Create a sequence in DATABASE."))
+
+(defgeneric database-drop-sequence (name database)
+ (:documentation "Drop a sequence from DATABASE."))
+
+(defgeneric database-sequence-next (name database)
+ (:documentation "Increment a sequence in DATABASE."))
+
+(defgeneric database-start-transaction (database)
+ (:documentation "Start a transaction in DATABASE."))
+
+(defgeneric database-commit-transaction (database)
+ (:documentation "Commit current transaction in DATABASE."))
+
+(defgeneric database-abort-transaction (database)
+ (:documentation "Abort current transaction in DATABASE."))
+
+(defgeneric database-get-type-specifier (type args database)
+ (:documentation "Return the type SQL type specifier as a string, for
+the given lisp type and parameters."))
+
+(defgeneric database-list-tables (database &key (system-tables nil))
+ (:documentation "List all tables in the given database"))
+
+(defgeneric database-list-attributes (table database)
+ (:documentation "List all attributes in TABLE."))
+
+(defgeneric database-attribute-type (attribute table database)
+ (:documentation "Return the type of ATTRIBUTE in TABLE."))
+
+(defgeneric database-add-attribute (table attribute database)
+ (:documentation "Add the attribute to the table."))
+
+(defgeneric database-rename-attribute (table oldatt newname database)
+ (:documentation "Rename the attribute in the table to NEWNAME."))
+
+(defgeneric oid (object)
+ (:documentation "Return the unique ID of a database object."))
+
+
+;;; Large objects support (Marc Battyani)
+
+(defgeneric database-create-large-object (database)
+ (:documentation "Creates a new large object in the database and returns the object identifier"))
+
+(defgeneric database-write-large-object (object-id (data string) database)
+ (:documentation "Writes data to the large object"))
+
+(defgeneric database-read-large-object (object-id database)
+ (:documentation "Reads the large object content"))
+
+(defgeneric database-delete-large-object (object-id database)
+ (:documentation "Deletes the large object in the database"))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: package.cl
+;;;; Purpose: Package definition for high-level SQL interface
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: package.cl,v 1.1 2002/05/13 16:22:08 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+;;;; This file makes the required package definitions for CLSQL's
+;;;; core packages.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+(defpackage :clsql-sys
+ (:use :common-lisp)
+ (:export
+ ;; "Private" exports for use by interface packages
+ #:check-connection-spec
+ #:database-type-load-foreign
+ #:database-type-library-loaded ;; KMR - Tests if foreign library okay
+ #:database-initialize-database-type
+ #:database-connect
+ #:database-disconnect
+ #:database-query
+ #:database-execute-command
+ #:database-query-result-set
+ #:database-dump-result-set
+ #:database-store-next-row
+
+ ;; For UncommonSQL support
+ #:database-list-tables
+ #:database-list-attributes
+ #:database-attribute-type
+ #:database-create-sequence
+ #:database-drop-sequence
+ #:database-sequence-next
+ #:sql-escape
+
+ ;; Support for pooled connections
+ #:database-type
+
+ ;; Large objects (Marc B)
+ #:database-create-large-object
+ #:database-write-large-object
+ #:database-read-large-object
+ #:database-delete-large-object
+
+ ;; Shared exports for re-export by CLSQL
+
+ .
+ #1=(#:clsql-condition
+ #:clsql-error
+ #:clsql-simple-error
+ #:clsql-warning
+ #:clsql-simple-warning
+ #:clsql-invalid-spec-error
+ #:clsql-invalid-spec-error-connection-spec
+ #:clsql-invalid-spec-error-database-type
+ #:clsql-invalid-spec-error-template
+ #:clsql-connect-error
+ #:clsql-connect-error-database-type
+ #:clsql-connect-error-connection-spec
+ #:clsql-connect-error-errno
+ #:clsql-connect-error-error
+ #:clsql-sql-error
+ #:clsql-sql-error-database
+ #:clsql-sql-error-expression
+ #:clsql-sql-error-errno
+ #:clsql-sql-error-error
+ #:clsql-database-warning
+ #:clsql-database-warning-database
+ #:clsql-database-warning-message
+ #:clsql-exists-condition
+ #:clsql-exists-condition-new-db
+ #:clsql-exists-condition-old-db
+ #:clsql-exists-warning
+ #:clsql-exists-error
+ #:clsql-closed-error
+ #:clsql-closed-error-database
+ #:*loaded-database-types*
+ #:reload-database-types
+ #:*default-database-type*
+ #:*initialized-database-types*
+ #:initialize-database-type
+ #:*connect-if-exists*
+ #:*default-database*
+ #:connected-databases
+ #:database
+ #:database-name
+ #:closed-database
+ #:find-database
+ #:database-name-from-spec
+ #:connect
+ #:disconnect
+ #:query
+ #:execute-command
+ #:map-query
+ #:do-query
+
+ ;; functional.cl
+ #:insert-records
+ #:delete-records
+ #:update-records
+ #:with-database
+
+ ;; utils.cl
+ #:number-to-sql-string
+ #:float-to-sql-string
+ #:sql-escape-quotes
+
+ ;; For UncommonSQL support
+ #:sql-ident
+ #:list-tables
+ #:list-attributes
+ #:attribute-type
+ #:create-sequence
+ #:drop-sequence
+ #:sequence-next
+
+ ;; Pooled connections
+ #:disconnect-pooled
+
+ ;; Transactions
+ #:with-transaction
+ #:commit-transaction
+ #:rollback-transaction
+ #:add-transaction-commit-hook
+ #:add-transaction-rollback-hook
+
+ ;; Large objects (Marc B)
+ #:create-large-object
+ #:write-large-object
+ #:read-large-object
+ #:delete-large-object
+ ))
+ (:documentation "This is the INTERNAL SQL-Interface package of CLSQL."))
+
+(defpackage #:clsql
+ (:import-from #:clsql-sys . #1#)
+ (:export . #1#)
+ (:documentation "This is the SQL-Interface package of CLSQL."))
+);eval-when
+
+(defpackage #:clsql-user
+ (:use #:common-lisp #:clsql)
+ (:documentation "This is the user package for experimenting with CLSQL."))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: clsql-base.system,v 1.2 2002/05/13 05:24:57 kevin Exp $
+;;;; $Id: clsql-base.system,v 1.3 2002/05/13 16:22:08 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;; System definitions
(mk:defsystem :clsql-base
- :source-pathname "CL-LIBRARY:clsql;sql;"
+ :source-pathname "CL-LIBRARY:clsql;base;"
:source-extension "cl"
- :binary-pathname "CL-LIBRARY:clsql;sql;bin;"
+ :binary-pathname "CL-LIBRARY:clsql;base;bin;"
:components ((:file "package")
(:file "classes" :depends-on ("package"))
(:file "conditions" :depends-on ("classes"))
usr/share/common-lisp/source
usr/share/common-lisp/repositories
usr/share/common-lisp/repositories/clsql
-usr/share/common-lisp/repositories/clsql/sql
+usr/share/common-lisp/repositories/clsql/base
usr/share/common-lisp/repositories/clsql/interfaces
usr/share/common-lisp/repositories/clsql/interfaces/clsql-uffi
prefix-aodbc := debian/$(pkg-aodbc)
## Lisp sources
-srcs := sql/pool.cl sql/sql.cl sql/transactions.cl sql/utils.cl sql/functional.cl sql/usql.cl
-srcs-cmucl-compat := $(wildcard cmucl-compat/*.cl)
-srcs-base := sql/package.cl sql/db-interface.cl sql/classes.cl sql/conditions.cl
+srcs := $(wildcard sql/*.cl)
+srcs-cmucl-compat:= $(wildcard cmucl-compat/*.cl)
+srcs-base := $(wildcard base/*.cl)
srcs-base-uffi := $(wildcard interfaces/clsql-uffi/*.cl) $(wildcard interfaces/clsql-uffi/*.so)
srcs-mysql := $(wildcard interfaces/mysql/*.cl) $(wildcard interfaces/mysql/*.so)
srcs-pg := $(wildcard interfaces/postgresql/*.cl)
$(INSTALL) $(INSTALLFLAGS) $(srcs-cmucl-compat) $(prefix)/$(clc-repos)/clsql/cmucl-compat
# Base
- $(INSTALL) $(INSTALLFLAGS) $(srcs-base) $(prefix-base)/$(clc-repos)/clsql/sql
+ $(INSTALL) $(INSTALLFLAGS) $(srcs-base) $(prefix-base)/$(clc-repos)/clsql/base
$(INSTALL) $(INSTALLFLAGS) $(srcs-base-uffi) $(prefix-base)/$(clc-repos)/clsql/interfaces/clsql-uffi
+ chmod +x $(wildcard $(prefix-base)/$(clc-repos)/clsql/interfaces/clsql-uffi/*.so)
$(INSTALL) $(INSTALLFLAGS) $(srcs-mysql) $(prefix-mysql)/$(clc-repos)/clsql/interfaces/mysql
+ chmod +x $(wildcard $(prefix-mysql)/$(clc-repos)/clsql/interfaces/mysql/*.so)
$(INSTALL) $(INSTALLFLAGS) $(srcs-pg) $(prefix-pg)/$(clc-repos)/clsql/interfaces/postgresql
$(INSTALL) $(INSTALLFLAGS) $(srcs-pg-socket) $(prefix-pg-socket)/$(clc-repos)/clsql/interfaces/postgresql-socket
$(INSTALL) $(INSTALLFLAGS) $(srcs-aodbc) $(prefix-aodbc)/$(clc-repos)/clsql/interfaces/aodbc
- chmod +x `find debian -type f -name \*.so`
# CLC Systems
$(INSTALL) $(INSTALLFLAGS) clsql.system $(prefix)/$(clc-systems)/
+++ /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.6 2002/05/07 10:19:13 marc.battyani Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; CLSQL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-
-(defclass database ()
- ((name :initform nil :initarg :name :reader database-name)
- (connection-spec :initform nil :initarg :connection-spec :reader connection-spec
- :documentation "Require to use connection pool")
- (transaction-level :initform 0 :accessor transaction-level)
- (transaction :initform nil :accessor transaction)
- (conn-pool :initform nil :initarg :conn-pool :accessor conn-pool))
- (:documentation
- "This class is the supertype of all databases handled by CLSQL."))
-
-(defmethod print-object ((object database) stream)
- (print-unreadable-object (object stream :type t :identity t)
- (write-string (if (slot-boundp object 'name)
- (database-name object)
- "<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: conditions.cl
-;;;; Purpose: Error conditions for high-level SQL interface
-;;;; Programmers: Kevin M. Rosenberg based on
-;;;; Original code by Pierre R. Mai
-;;;; Date Started: Feb 2002
-;;;;
-;;;; $Id: conditions.cl,v 1.2 2002/03/29 08:12:16 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; CLSQL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-;;; Conditions
-(define-condition clsql-condition ()
- ())
-
-(define-condition clsql-error (error clsql-condition)
- ())
-
-(define-condition clsql-simple-error (simple-condition clsql-error)
- ())
-
-(define-condition clsql-warning (warning clsql-condition)
- ())
-
-(define-condition clsql-simple-warning (simple-condition clsql-warning)
- ())
-
-(define-condition clsql-invalid-spec-error (clsql-error)
- ((connection-spec :initarg :connection-spec
- :reader clsql-invalid-spec-error-connection-spec)
- (database-type :initarg :database-type
- :reader clsql-invalid-spec-error-database-type)
- (template :initarg :template
- :reader clsql-invalid-spec-error-template))
- (:report (lambda (c stream)
- (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
- (clsql-invalid-spec-error-connection-spec c)
- (clsql-invalid-spec-error-database-type c)
- (clsql-invalid-spec-error-template c)))))
-
-(defmacro check-connection-spec (connection-spec database-type template)
- "Check the connection specification against the provided template,
-and signal an clsql-invalid-spec-error if they don't match."
- `(handler-case
- (destructuring-bind ,template ,connection-spec
- (declare (ignore ,@template))
- t)
- (error () (error 'clsql-invalid-spec-error
- :connection-spec ,connection-spec
- :database-type ,database-type
- :template (quote ,template)))))
-
-(define-condition clsql-connect-error (clsql-error)
- ((database-type :initarg :database-type
- :reader clsql-connect-error-database-type)
- (connection-spec :initarg :connection-spec
- :reader clsql-connect-error-connection-spec)
- (errno :initarg :errno :reader clsql-connect-error-errno)
- (error :initarg :error :reader clsql-connect-error-error))
- (:report (lambda (c stream)
- (format stream "While trying to connect to database ~A~% using database-type ~A:~% Error ~D / ~A~% has occurred."
- (database-name-from-spec
- (clsql-connect-error-connection-spec c)
- (clsql-connect-error-database-type c))
- (clsql-connect-error-database-type c)
- (clsql-connect-error-errno c)
- (clsql-connect-error-error c)))))
-
-(define-condition clsql-sql-error (clsql-error)
- ((database :initarg :database :reader clsql-sql-error-database)
- (expression :initarg :expression :reader clsql-sql-error-expression)
- (errno :initarg :errno :reader clsql-sql-error-errno)
- (error :initarg :error :reader clsql-sql-error-error))
- (:report (lambda (c stream)
- (format stream "While accessing database ~A~% with expression ~S:~% Error ~D / ~A~% has occurred."
- (clsql-sql-error-database c)
- (clsql-sql-error-expression c)
- (clsql-sql-error-errno c)
- (clsql-sql-error-error c)))))
-
-(define-condition clsql-database-warning (clsql-warning)
- ((database :initarg :database :reader clsql-database-warning-database)
- (message :initarg :message :reader clsql-database-warning-message))
- (:report (lambda (c stream)
- (format stream "While accessing database ~A~% Warning: ~A~% has occurred."
- (clsql-database-warning-database c)
- (clsql-database-warning-message c)))))
-
-(define-condition clsql-exists-condition (clsql-condition)
- ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
- (new-db :initarg :new-db :reader clsql-exists-condition-new-db
- :initform nil))
- (:report (lambda (c stream)
- (format stream "In call to ~S:~%" 'connect)
- (cond
- ((null (clsql-exists-condition-new-db c))
- (format stream
- " There is an existing connection ~A to database ~A."
- (clsql-exists-condition-old-db c)
- (database-name (clsql-exists-condition-old-db c))))
- ((eq (clsql-exists-condition-new-db c)
- (clsql-exists-condition-old-db c))
- (format stream
- " Using existing connection ~A to database ~A."
- (clsql-exists-condition-old-db c)
- (database-name (clsql-exists-condition-old-db c))))
- (t
- (format stream
- " Created new connection ~A to database ~A~% ~
-although there is an existing connection (~A)."
- (clsql-exists-condition-new-db c)
- (database-name (clsql-exists-condition-new-db c))
- (clsql-exists-condition-old-db c)))))))
-
-(define-condition clsql-exists-warning (clsql-exists-condition
- clsql-warning)
- ())
-
-(define-condition clsql-exists-error (clsql-exists-condition
- clsql-error)
- ())
-
-(define-condition clsql-closed-error (clsql-error)
- ((database :initarg :database :reader clsql-closed-error-database))
- (:report (lambda (c stream)
- (format stream "The database ~A has already been closed."
- (clsql-closed-error-database c)))))
-
-(define-condition clsql-nodb-error (clsql-error)
- ((database :initarg :database :reader clsql-nodb-error-database))
- (:report (lambda (c stream)
- (format stream "No such database ~S is open."
- (clsql-nodb-error-database c)))))
-
-
-;; Signal conditions
-
-
-(defun signal-closed-database-error (database)
- (cerror "Ignore this error and return nil."
- 'clsql-closed-error
- :database database))
-
-(defun signal-nodb-error (database)
- (cerror "Ignore this error and return nil."
- 'clsql-nodb-error
- :database database))
-
+++ /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.7 2002/04/27 20:58:11 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai, and onShoreD
-;;;;
-;;;; CLSQL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :clsql-sys)
-
-(defgeneric database-type-load-foreign (database-type)
- (:documentation
- "The internal generic implementation of reload-database-types."))
-
-(defgeneric database-type-library-loaded (database-type)
- (:documentation
- "The internal generic implementation for checking if
-database type library loaded successfully."))
-
-(defgeneric database-type (database-type)
- (:documentation
- "Returns database type")
- (:method (database-type)
- (declare (ignore database-type))
- (signal-nodb-error database)))
-
-
-(defgeneric database-initialize-database-type (database-type)
- (:documentation
- "The internal generic implementation of initialize-database-type."))
-
-(defgeneric database-name-from-spec (connection-spec database-type)
- (:documentation
- "Returns the name of the database that would be created if connect
-was called with the connection-spec."))
-
-(defgeneric database-connect (connection-spec database-type)
- (:documentation "Internal generic implementation of connect."))
-
-(defgeneric database-disconnect (database)
- (:method ((database closed-database))
- (signal-closed-database-error database))
- (:method ((database t))
- (signal-nodb-error database))
- (:documentation "Internal generic implementation of disconnect."))
-
-(defgeneric database-query (query-expression database types)
- (:method (query-expression (database closed-database) types)
- (declare (ignore query-expression types))
- (signal-closed-database-error database))
- (:method (query-expression (database t) types)
- (declare (ignore query-expression types))
- (signal-nodb-error database))
- (:documentation "Internal generic implementation of query."))
-
-
-(defgeneric database-execute-command (sql-expression database)
- (:method (sql-expression (database closed-database))
- (declare (ignore sql-expression))
- (signal-closed-database-error database))
- (:method (sql-expression (database t))
- (declare (ignore sql-expression))
- (signal-nodb-error database))
- (:documentation "Internal generic implementation of execute-command."))
-
-;;; Mapping and iteration
-(defgeneric database-query-result-set
- (query-expression database &key full-set types)
- (:method (query-expression (database closed-database) &key full-set types)
- (declare (ignore query-expression full-set types))
- (signal-closed-database-error database)
- (values nil nil nil))
- (:method (query-expression (database t) &key full-set types)
- (declare (ignore query-expression full-set types))
- (signal-nodb-error database)
- (values nil nil nil))
- (:documentation
- "Internal generic implementation of query mapping. Starts the
-query specified by query-expression on the given database and returns
-a result-set to be used with database-store-next-row and
-database-dump-result-set to access the returned data. The second
-value is the number of columns in the result-set, if there are any.
-If full-set is true, the number of rows in the result-set is returned
-as a third value, if this is possible (otherwise nil is returned for
-the third value). This might have memory and resource usage
-implications, since many databases will require the query to be
-executed in full to answer this question. If the query produced no
-results then nil is returned for all values that would have been
-returned otherwise. If an error occurs during query execution, the
-function should signal a clsql-sql-error."))
-
-(defgeneric database-dump-result-set (result-set database)
- (:method (result-set (database closed-database))
- (declare (ignore result-set))
- (signal-closed-database-error database))
- (:method (result-set (database t))
- (declare (ignore result-set))
- (signal-nodb-error database))
- (:documentation "Dumps the received result-set."))
-
-(defgeneric database-store-next-row (result-set database list)
- (:method (result-set (database closed-database) list)
- (declare (ignore result-set list))
- (signal-closed-database-error database))
- (:method (result-set (database t) list)
- (declare (ignore result-set list))
- (signal-nodb-error database))
- (:documentation
- "Returns t and stores the next row in the result set in list or
-returns nil when result-set is finished."))
-
-
-;; Interfaces to support UncommonSQL
-
-(defgeneric database-create-sequence (name database)
- (:documentation "Create a sequence in DATABASE."))
-
-(defgeneric database-drop-sequence (name database)
- (:documentation "Drop a sequence from DATABASE."))
-
-(defgeneric database-sequence-next (name database)
- (:documentation "Increment a sequence in DATABASE."))
-
-(defgeneric database-start-transaction (database)
- (:documentation "Start a transaction in DATABASE."))
-
-(defgeneric database-commit-transaction (database)
- (:documentation "Commit current transaction in DATABASE."))
-
-(defgeneric database-abort-transaction (database)
- (:documentation "Abort current transaction in DATABASE."))
-
-(defgeneric database-get-type-specifier (type args database)
- (:documentation "Return the type SQL type specifier as a string, for
-the given lisp type and parameters."))
-
-(defgeneric database-list-tables (database &key (system-tables nil))
- (:documentation "List all tables in the given database"))
-
-(defgeneric database-list-attributes (table database)
- (:documentation "List all attributes in TABLE."))
-
-(defgeneric database-attribute-type (attribute table database)
- (:documentation "Return the type of ATTRIBUTE in TABLE."))
-
-(defgeneric database-add-attribute (table attribute database)
- (:documentation "Add the attribute to the table."))
-
-(defgeneric database-rename-attribute (table oldatt newname database)
- (:documentation "Rename the attribute in the table to NEWNAME."))
-
-(defgeneric oid (object)
- (:documentation "Return the unique ID of a database object."))
-
-
-;;; Large objects support (Marc Battyani)
-
-(defgeneric database-create-large-object (database)
- (:documentation "Creates a new large object in the database and returns the object identifier"))
-
-(defgeneric database-write-large-object (object-id (data string) database)
- (:documentation "Writes data to the large object"))
-
-(defgeneric database-read-large-object (object-id database)
- (:documentation "Reads the large object content"))
-
-(defgeneric database-delete-large-object (object-id database)
- (:documentation "Deletes the large object in the database"))
+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: package.cl
-;;;; Purpose: Package definition for high-level SQL interface
-;;;; Programmers: Kevin M. Rosenberg based on
-;;;; Original code by Pierre R. Mai
-;;;; Date Started: Feb 2002
-;;;;
-;;;; $Id: package.cl,v 1.14 2002/05/11 22:37:46 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
-;;;;
-;;;; CLSQL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :cl-user)
-
-;;;; This file makes the required package definitions for CLSQL's
-;;;; core packages.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defpackage :clsql-sys
- (:use :common-lisp)
- (:export
- ;; "Private" exports for use by interface packages
- #:check-connection-spec
- #:database-type-load-foreign
- #:database-type-library-loaded ;; KMR - Tests if foreign library okay
- #:database-initialize-database-type
- #:database-connect
- #:database-disconnect
- #:database-query
- #:database-execute-command
- #:database-query-result-set
- #:database-dump-result-set
- #:database-store-next-row
-
- ;; For UncommonSQL support
- #:database-list-tables
- #:database-list-attributes
- #:database-attribute-type
- #:database-create-sequence
- #:database-drop-sequence
- #:database-sequence-next
- #:sql-escape
-
- ;; Support for pooled connections
- #:database-type
-
- ;; Large objects (Marc B)
- #:database-create-large-object
- #:database-write-large-object
- #:database-read-large-object
- #:database-delete-large-object
-
- ;; Shared exports for re-export by CLSQL
-
- .
- #1=(#:clsql-condition
- #:clsql-error
- #:clsql-simple-error
- #:clsql-warning
- #:clsql-simple-warning
- #:clsql-invalid-spec-error
- #:clsql-invalid-spec-error-connection-spec
- #:clsql-invalid-spec-error-database-type
- #:clsql-invalid-spec-error-template
- #:clsql-connect-error
- #:clsql-connect-error-database-type
- #:clsql-connect-error-connection-spec
- #:clsql-connect-error-errno
- #:clsql-connect-error-error
- #:clsql-sql-error
- #:clsql-sql-error-database
- #:clsql-sql-error-expression
- #:clsql-sql-error-errno
- #:clsql-sql-error-error
- #:clsql-database-warning
- #:clsql-database-warning-database
- #:clsql-database-warning-message
- #:clsql-exists-condition
- #:clsql-exists-condition-new-db
- #:clsql-exists-condition-old-db
- #:clsql-exists-warning
- #:clsql-exists-error
- #:clsql-closed-error
- #:clsql-closed-error-database
- #:*loaded-database-types*
- #:reload-database-types
- #:*default-database-type*
- #:*initialized-database-types*
- #:initialize-database-type
- #:*connect-if-exists*
- #:*default-database*
- #:connected-databases
- #:database
- #:database-name
- #:closed-database
- #:find-database
- #:database-name-from-spec
- #:connect
- #:disconnect
- #:query
- #:execute-command
- #:map-query
- #:do-query
-
- ;; functional.cl
- #:insert-records
- #:delete-records
- #:update-records
- #:with-database
-
- ;; utils.cl
- #:number-to-sql-string
- #:float-to-sql-string
- #:sql-escape-quotes
-
- ;; For UncommonSQL support
- #:sql-ident
- #:list-tables
- #:list-attributes
- #:attribute-type
- #:create-sequence
- #:drop-sequence
- #:sequence-next
-
- ;; Pooled connections
- #:disconnect-pooled
-
- ;; Transactions
- #:with-transaction
- #:commit-transaction
- #:rollback-transaction
- #:add-transaction-commit-hook
- #:add-transaction-rollback-hook
-
- ;; Large objects (Marc B)
- #:create-large-object
- #:write-large-object
- #:read-large-object
- #:delete-large-object
- ))
- (:documentation "This is the INTERNAL SQL-Interface package of CLSQL."))
-
-(defpackage #:clsql
- (:import-from #:clsql-sys . #1#)
- (:export . #1#)
- (:documentation "This is the SQL-Interface package of CLSQL."))
-);eval-when
-
-(defpackage #:clsql-user
- (:use #:common-lisp #:clsql)
- (:documentation "This is the user package for experimenting with CLSQL."))
projects / clsql.git / commitdiff