X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fsql.cl;h=101d30f128619f28d6577920ff5df267ea58abd2;hp=f0d5bee86d16865e8efefa2b9cc9e808266c649f;hb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7;hpb=be6778983c41d53e759eb6d84412dd43fd77ddb3 diff --git a/sql/sql.cl b/sql/sql.cl index f0d5bee..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.11 2002/03/29 08:34:44 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,37 +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.") - -(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))) - - ;;; Database handling (defvar *connect-if-exists* :error @@ -76,8 +45,6 @@ initialized, as indicated by `*initialized-database-types*'." (defvar *default-database* nil "Specifies the default database to be used.") - - (defun find-database (database &optional (errorp t)) (etypecase database (database @@ -95,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)) @@ -127,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 @@ -270,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))