X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fsql.cl;h=101d30f128619f28d6577920ff5df267ea58abd2;hp=2d8ab3f239e6aac3035173992c0ab426b9d2f77e;hb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7;hpb=30656549f102f19d3cedba9e2b6e30fc763ea20d diff --git a/sql/sql.cl b/sql/sql.cl index 2d8ab3f..101d30f 100644 --- a/sql/sql.cl +++ b/sql/sql.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: sql.cl,v 1.8 2002/03/29 07:42:10 kevin Exp $ +;;;; $Id: sql.cl,v 1.19 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 @@ -30,34 +30,6 @@ ;;; Simple implementation of SQL along the lines of Harlequin's Common SQL -;;; Database Types - -(defvar *loaded-database-types* nil - "Contains a list of database types which have been defined/loaded.") - -(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))) - - ;;; Database handling (defvar *connect-if-exists* :error @@ -73,36 +45,6 @@ initialized, as indicated by `*initialized-database-types*'." (defvar *default-database* nil "Specifies the default database to be used.") -(defclass database () - ((name :initarg :name :reader database-name)) - (:documentation - "This class is the supertype of all databases handled by CLSQL.")) - -(defmethod print-object ((object database) stream) - (print-unreadable-object (object stream :type t :identity t) - (write-string (if (slot-boundp object 'name) - (database-name object) - "") - stream))) - -(defclass closed-database () - ((name :initarg :name :reader database-name)) - (:documentation - "This class represents all databases after they are closed via -`disconnect'.")) - -(defmethod print-object ((object closed-database) stream) - (print-unreadable-object (object stream :type t :identity t) - (write-string (if (slot-boundp object 'name) - (database-name object) - "") - stream))) - -(defun signal-closed-database-error (database) - (cerror "Ignore this error and return nil." - 'clsql-closed-error - :database database)) - (defun find-database (database &optional (errorp t)) (etypecase database (database @@ -120,31 +62,37 @@ initialized, as indicated by `*initialized-database-types*'." (defun connect (connection-spec &key (if-exists *connect-if-exists*) - (database-type *default-database-type*)) + (database-type *default-database-type*) + (pool nil)) "Connects to a database of the given database-type, using the type-specific -connection-spec. if-exists is currently ignored." - (let* ((db-name (database-name-from-spec connection-spec database-type)) - (old-db (find-database db-name nil)) - (result nil)) - (if old-db +connection-spec. if-exists is currently ignored. +If pool is t the the connection will be taken from the general pool, +if pool is a conn-pool object the connection will be taken from this pool. +" + (if pool + (acquire-from-pool connection-spec database-type pool) + (let* ((db-name (database-name-from-spec connection-spec database-type)) + (old-db (unless (eq if-exists :new) (find-database db-name nil))) + (result nil)) + (if old-db (case if-exists - (:new - (setq result - (database-connect connection-spec database-type))) +; (:new +; (setq result +; (database-connect connection-spec database-type))) (:warn-new (setq result (database-connect connection-spec database-type)) (warn 'clsql-exists-warning :old-db old-db :new-db result)) (:error (restart-case - (error 'clsql-exists-error :old-db old-db) - (create-new () - :report "Create a new connection." - (setq result - (database-connect connection-spec database-type))) - (use-old () - :report "Use the existing connection." - (setq result old-db)))) + (error 'clsql-exists-error :old-db old-db) + (create-new () + :report "Create a new connection." + (setq result + (database-connect connection-spec database-type))) + (use-old () + :report "Use the existing connection." + (setq result old-db)))) (:warn-old (setq result old-db) (warn 'clsql-exists-warning :old-db old-db :new-db old-db)) @@ -152,24 +100,24 @@ connection-spec. if-exists is currently ignored." (setq result old-db))) (setq result (database-connect connection-spec database-type))) - (when result - (pushnew result *connected-databases*) - (setq *default-database* result) - result))) - + (when result + (pushnew result *connected-databases*) + (setq *default-database* result) + result)))) (defun disconnect (&key (database *default-database*)) "Closes the connection to database. Resets *default-database* if that -database was disconnected and only one other connection exists." - (when (database-disconnect database) - (setq *connected-databases* (delete database *connected-databases*)) - (when (eq database *default-database*) - (setq *default-database* (car *connected-databases*))) - (change-class database 'closed-database) - t)) - - +database was disconnected and only one other connection exists. +if the database is from a pool it will be released to this pool." + (if (conn-pool database) + (release-to-pool database) + (when (database-disconnect database) + (setq *connected-databases* (delete database *connected-databases*)) + (when (eq database *default-database*) + (setq *default-database* (car *connected-databases*))) + (change-class database 'closed-database) + t))) ;;; Basic operations on databases @@ -295,5 +243,20 @@ specified in output-type-spec and returned like in MAP." ,@body)) (database-dump-result-set ,result-set ,db))))))) +;;; Marc Battyani : Large objects support + +(defun create-large-object (&key (database *default-database*)) + "Creates a new large object in the database and returns the object identifier" + (database-create-large-object database)) + +(defun write-large-object (object-id data &key (database *default-database*)) + "Writes data to the large object" + (database-write-large-object object-id data database)) +(defun read-large-object (object-id &key (database *default-database*)) + "Reads the large object content" + (database-read-large-object object-id database)) +(defun delete-large-object (object-id &key (database *default-database*)) + "Deletes the large object in the database" + (database-delete-large-object object-id database))