From 5068697a98c10224f3a3e0a7125ba64cf3d3b4fb Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 11 Apr 2004 12:16:57 +0000 Subject: [PATCH] r8952: remove unused schema version table --- base/pool.lisp | 2 +- sql/kmr-mop.lisp | 11 ++++++ sql/new-objects.lisp | 81 +++++++++++--------------------------------- sql/objects.lisp | 56 +++--------------------------- tests/test-fddl.lisp | 2 +- 5 files changed, 37 insertions(+), 115 deletions(-) diff --git a/base/pool.lisp b/base/pool.lisp index 819a898..53730e3 100644 --- a/base/pool.lisp +++ b/base/pool.lisp @@ -20,7 +20,7 @@ (defun make-process-lock (name) #+allegro (mp:make-process-lock :name name) - #+cmu (mp:make-lock :name name) + #+cmu (mp:make-lock name) #+lispworks (mp:make-lock :name name) #+openmcl (ccl:make-lock :name name) #+sb-thread (sb-thread:make-mutex :name name) diff --git a/sql/kmr-mop.lisp b/sql/kmr-mop.lisp index e935f1c..3953c8c 100644 --- a/sql/kmr-mop.lisp +++ b/sql/kmr-mop.lisp @@ -49,3 +49,14 @@ (defun ordered-class-slots (class) #+(or cmu sbcl) (class-slots class) #-(or cmu sbcl) (reverse (class-slots class))) + +;; Lispworks has symbol for slot rather than the slot instance +(defun %svuc-slot-name (slot) + #+lispworks slot + #-lispworks (slot-definition-name slot)) + +(defun %svuc-slot-object (slot class) + (declare (ignorable class)) + #+lispworks (clos:find-slot-definition slot class) + #-lispworks slot) + diff --git a/sql/new-objects.lisp b/sql/new-objects.lisp index c633de9..fc050cb 100644 --- a/sql/new-objects.lisp +++ b/sql/new-objects.lisp @@ -15,8 +15,6 @@ (in-package #:clsql-sys) - - (defclass standard-db-object () ((stored :db-kind :virtual :initarg :stored @@ -24,49 +22,40 @@ (:metaclass standard-db-class) (:documentation "Superclass for all CLSQL View Classes.")) -(defvar *deserializing* nil) -(defvar *initializing* nil) - -(defmethod initialize-instance :around ((object standard-db-object) - &rest all-keys &key &allow-other-keys) - (declare (ignore all-keys)) - (let ((*initializing* t)) - (call-next-method) - (unless *deserializing* - #+nil (created-object object) - (update-records-from-instance object)))) +(defvar *db-deserializing* nil) +(defvar *db-initializing* nil) (defmethod slot-value-using-class ((class standard-db-class) instance slot-def) (declare (optimize (speed 3))) - (unless *deserializing* - (let ((slot-name (%slot-def-name slot-def)) + (unless *db-deserializing* + (let ((slot-name (slot-defition-name-name slot-def)) (slot-kind (view-class-slot-db-kind slot-def))) (when (and (eql slot-kind :join) (not (slot-boundp instance slot-name))) - (let ((*deserializing* t)) + (let ((*db-deserializing* t)) (setf (slot-value instance slot-name) (fault-join-slot class instance slot-def)))))) (call-next-method)) (defmethod (setf slot-value-using-class) :around (new-value (class standard-db-class) instance slot-def) (declare (ignore new-value)) - (let* ((slot-name (%slot-def-name slot-def)) + (let* ((slot-name (slot-definition-name slot-def)) (slot-kind (view-class-slot-db-kind slot-def)) (no-update? (or (eql slot-kind :virtual) - *initializing* - *deserializing*))) + *db-initializing* + *db-deserializing*))) (call-next-method) (unless no-update? (update-record-from-slot instance slot-name)))) -(defun %slot-def-name (slot) - #+lispworks slot - #-lispworks (slot-definition-name slot)) - -(defun %slot-object (slot class) - (declare (ignorable class)) - #+lispworks (clos:find-slot-definition slot class) - #-lispworks slot) +(defmethod initialize-instance :around ((object standard-db-object) + &rest all-keys &key &allow-other-keys) + (declare (ignore all-keys)) + (let ((*db-initializing* t)) + (call-next-method) + (unless *db-deserializing* + #+nil (created-object object) + (update-records-from-instance object)))) (defun sequence-from-class (view-class-name) (sql-escape @@ -99,38 +88,6 @@ -#+noschema -(progn -#.(locally-enable-sql-reader-syntax) - -(defun ensure-schema-version-table (database) - (unless (table-exists-p "clsql_object_v" :database database) - (create-table [clsql_object_v] '(([name] string) - ([vers] integer) - ([def] string)) - :database database))) - -(defun update-schema-version-records (view-class-name - &key (database *default-database*)) - (let ((schemadef nil) - (tclass (find-class view-class-name))) - (dolist (slotdef (class-slots tclass)) - (let ((res (database-generate-column-definition view-class-name - slotdef database))) - (when res (setf schemadef (cons res schemadef))))) - (when schemadef - (delete-records :from [clsql_object_v] - :where [= [name] (sql-escape (class-name tclass))] - :database database) - (insert-records :into [clsql_object_v] - :av-pairs `(([name] ,(sql-escape (class-name tclass))) - ([vers] ,(car (object-version tclass))) - ([def] ,(prin1-to-string - (object-definition tclass)))) - :database database)))) - -#.(restore-sql-reader-syntax-state) -) (defun create-view-from-class (view-class-name &key (database *default-database*)) @@ -907,9 +864,9 @@ DATABASE-NULL-VALUE on the type of the slot.")) (optimize (debug 3) (speed 1))) ;; (cmsg "Args = ~s" args) (remf args :from) - (let* ((*deserializing* t) + (let* ((*db-deserializing* t) (*default-database* (or database - (error 'usql-nodb-error)))) + (error 'clsql-no-database-error nil)))) (flet ((table-sql-expr (table) (sql-expression :table (view-table table))) (ref-equal (ref1 ref2) @@ -959,7 +916,7 @@ DATABASE-NULL-VALUE on the type of the slot.")) (mapcar #'build-object res)))))) (defun %make-fresh-object (class-name slots values) - (let* ((*initializing* t) + (let* ((*db-initializing* t) (obj (make-instance class-name :stored t))) (setf obj (get-slot-values-from-view obj slots values)) diff --git a/sql/objects.lisp b/sql/objects.lisp index e4b0ca1..3c6588f 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -32,9 +32,10 @@ (defmethod slot-value-using-class ((class standard-db-class) instance slot) (declare (optimize (speed 3))) (unless *db-deserializing* - (let ((slot-name (%slot-name slot)) - (slot-object (%slot-object slot class))) - (when (and (eql (view-class-slot-db-kind slot-object) :join) + (let* ((slot-name (%svuc-slot-name slot)) + (slot-object (%svuc-slot-object slot class)) + (slot-kind (view-class-slot-db-kind slot-object))) + (when (and (eql slot-kind :join) (not (slot-boundp instance slot-name))) (let ((*db-deserializing* t)) (if (view-database instance) @@ -48,21 +49,6 @@ (declare (ignore new-value instance slot)) (call-next-method)) -;; JMM - Can't go around trying to slot-access a symbol! Guess in -;; CMUCL slot-name is the actual slot _object_, while in lispworks it -;; is a lowly symbol (the variable is called slot-name after all) so -;; the object (or in MOP terminology- the "slot definition") has to be -;; retrieved using find-slot-definition - -(defun %slot-name (slot) - #+lispworks slot - #-lispworks (slot-definition-name slot)) - -(defun %slot-object (slot class) - (declare (ignorable class)) - #+lispworks (clos:find-slot-definition slot class) - #-lispworks slot) - (defmethod initialize-instance :around ((class standard-db-object) &rest all-keys &key &allow-other-keys) @@ -100,36 +86,6 @@ (database-output-sql keylist database))))) -#.(locally-enable-sql-reader-syntax) - -(defun ensure-schema-version-table (database) - (unless (table-exists-p "clsql_object_v" :database database) - (create-table [clsql_object_v] '(([name] string) - ([vers] integer) - ([def] string)) - :database database))) - -(defun update-schema-version-records (view-class-name - &key (database *default-database*)) - (let ((schemadef nil) - (tclass (find-class view-class-name))) - (dolist (slotdef (class-slots tclass)) - (let ((res (database-generate-column-definition view-class-name - slotdef database))) - (when res (setf schemadef (cons res schemadef))))) - (when schemadef - (delete-records :from [clsql_object_v] - :where [= [name] (sql-escape (class-name tclass))] - :database database) - (insert-records :into [clsql_object_v] - :av-pairs `(([name] ,(sql-escape (class-name tclass))) - ([vers] ,(car (object-version tclass))) - ([def] ,(prin1-to-string - (object-definition tclass)))) - :database database)))) - -#.(restore-sql-reader-syntax-state) - (defun create-view-from-class (view-class-name &key (database *default-database*)) "Creates a view in DATABASE based on VIEW-CLASS-NAME which defines @@ -138,9 +94,7 @@ the view. The argument DATABASE has a default value of (let ((tclass (find-class view-class-name))) (if tclass (let ((*default-database* database)) - (%install-class tclass database) - (ensure-schema-version-table database) - (update-schema-version-records view-class-name :database database)) + (%install-class tclass database)) (error "Class ~s not found." view-class-name))) (values)) diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index 53fd5c7..ef79615 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -28,7 +28,7 @@ (sort (mapcar #'string-downcase (clsql:list-tables :owner *test-database-user*)) #'string>)) - "employee" "company" "clsql_object_v") + "employee" "company") ;; create a table, test for its existence, drop it and test again (deftest :fddl/table/2 -- 2.34.1