X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fsql.cl;h=101d30f128619f28d6577920ff5df267ea58abd2;hb=d9b90caa2f0450deffff461b70294bc741faae7f;hp=310001eb221defd1860adb513c293d640fd3ff81;hpb=b55c36d4d3835550407db78b1baa76a0bffdc5c1;p=clsql.git diff --git a/sql/sql.cl b/sql/sql.cl index 310001e..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.15 2002/05/03 20:50:18 marc.battyani 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 @@ -100,22 +69,22 @@ 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. " - (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 pool - (setq result (acquire-from-pool connection-spec database-type 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 + (case if-exists ; (: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 + (: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." @@ -124,17 +93,17 @@ if pool is a conn-pool object the connection will be taken from this pool. (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)) - (:old - (setq result old-db))) + (:warn-old + (setq result old-db) + (warn 'clsql-exists-warning :old-db old-db :new-db old-db)) + (:old + (setq result old-db))) (setq result - (database-connect connection-spec database-type)))) - (when result - (pushnew result *connected-databases*) - (setq *default-database* result) - result))) + (database-connect connection-spec database-type))) + (when result + (pushnew result *connected-databases*) + (setq *default-database* result) + result)))) (defun disconnect (&key (database *default-database*))