r8952: remove unused schema version table

diff --git a/base/pool.lisp b/base/pool.lisp
index 819a8981a7e8806b6f06a2b9404928fa9111f919..53730e3a462a87a267fd4faf99f4b107042f63eb 100644 (file)
--- 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 e935f1ca0e1ef585b8b68ebbe455a304ac9f8ed8..3953c8c279db097a67107bcee86a30a848bb8193 100644 (file)
--- 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 c633de9ba8c02f1bf968e4a95f7eb75ad27ca4c3..fc050cb944584d361f884079782c889513fd3b15 100644 (file)
--- 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 e4b0ca13c50c328d9035cc0a46899b04995ce983..3c6588f5540af9aa2e3d2723cac8b87f82ff1fd5 100644 (file)
--- 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 53fd5c75f02e83da9bf47bec2bd7131a2a5ed55b..ef79615b903f7e3edb9824f121ed82b2420bd7d3 100644 (file)
--- 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