X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fobjects.lisp;h=823df46069cd0ff6f5248db9859ee458798593f2;hb=e3f355aa2b125569097bd7108fbbd14daa23e7aa;hp=6a18fe51df2d44ac77f3112efcdf723de0ea16a9;hpb=a4449b6f1b9fb2471da255fc506bcad6f8feb220;p=clsql.git

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 6a18fe5..823df46 100644
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -1,14 +1,17 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; ======================================================================
-;;;; $Id: $
+;;;; *************************************************************************
 ;;;;
-;;;; Description ==========================================================
-;;;; ======================================================================
+;;;; $Id$
 ;;;;
-;;;; The CLSQL-USQL Object Oriented Data Definitional Language (OODDL)
+;;;; The CLSQL Object Oriented Data Definitional Language (OODDL)
 ;;;; and Object Oriented Data Manipulation Language (OODML).
 ;;;;
-;;;; ======================================================================
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
 
 (in-package #:clsql-sys)
 
@@ -17,8 +20,8 @@
     :initform nil
     :initarg :view-database
     :db-kind :virtual))
-  (:metaclass standard-db-class)
-  (:documentation "Superclass for all CLSQL-USQL View Classes."))
+  (:metaclass view-metaclass)
+  (:documentation "Superclass for all CLSQL View Classes."))
 
 (defmethod view-database ((self standard-db-object))
   (slot-value self 'view-database))
@@ -26,7 +29,7 @@
 (defvar *db-deserializing* nil)
 (defvar *db-initializing* nil)
 
-(defmethod slot-value-using-class ((class standard-db-class) instance slot)
+(defmethod slot-value-using-class ((class view-metaclass) instance slot)
   (declare (optimize (speed 3)))
   (unless *db-deserializing*
     (let ((slot-name (%slot-name slot))
@@ -40,7 +43,7 @@
               (setf (slot-value instance slot-name) nil))))))
   (call-next-method))
 
-(defmethod (setf slot-value-using-class) (new-value (class standard-db-class)
+(defmethod (setf slot-value-using-class) (new-value (class view-metaclass)
 					  instance slot)
   (declare (ignore new-value instance slot))
   (call-next-method))
@@ -89,7 +92,7 @@
 ;; Build the database tables required to store the given view class
 ;;
 
-(defmethod database-pkey-constraint ((class standard-db-class) database)
+(defmethod database-pkey-constraint ((class view-metaclass) database)
   (let ((keylist (mapcar #'view-class-slot-column (keyslots-for-class class))))
     (when keylist 
       (format nil "CONSTRAINT ~APK PRIMARY KEY~A"
@@ -100,10 +103,10 @@
 #.(locally-enable-sql-reader-syntax)
 
 (defun ensure-schema-version-table (database)
-  (unless (table-exists-p "usql_object_v" :database database)
-    (create-table [usql_object_v] '(([name] (string 32))
+  (unless (table-exists-p "clsql_object_v" :database database)
+    (create-table [clsql_object_v] '(([name] string)
                                     ([vers] integer)
-                                    ([def] (string 32)))
+                                    ([def] string))
                   :database database)))
 
 (defun update-schema-version-records (view-class-name
@@ -115,10 +118,10 @@
                                                       slotdef database)))
         (when res (setf schemadef (cons res schemadef)))))
     (when schemadef
-      (delete-records :from [usql_object_v]
+      (delete-records :from [clsql_object_v]
                       :where [= [name] (sql-escape (class-name tclass))]
                       :database database)
-      (insert-records :into [usql_object_v]
+      (insert-records :into [clsql_object_v]
                       :av-pairs `(([name] ,(sql-escape (class-name tclass)))
                                   ([vers] ,(car (object-version tclass)))
                                   ([def] ,(prin1-to-string
@@ -141,8 +144,8 @@ the view. The argument DATABASE has a default value of
         (error "Class ~s not found." view-class-name)))
   (values))
 
-(defmethod %install-class ((self standard-db-class) database &aux schemadef)
-  (dolist (slotdef (class-slots self))
+(defmethod %install-class ((self view-metaclass) database &aux schemadef)
+  (dolist (slotdef (ordered-class-slots self))
     (let ((res (database-generate-column-definition (class-name self)
                                                     slotdef database)))
       (when res 
@@ -169,7 +172,7 @@ which defines that view. The argument DATABASE has a default value of
     (if tclass
         (let ((*default-database* database))
           (%uninstall-class tclass)
-          (delete-records :from [usql_object_v]
+          (delete-records :from [clsql_object_v]
                           :where [= [name] (sql-escape view-class-name)]))
         (error "Class ~s not found." view-class-name)))
   (values))
@@ -215,7 +218,7 @@ SUPERS is nil then STANDARD-DB-OBJECT automatically becomes the
 superclass of the newly-defined View Class."
   `(progn
      (defclass ,class ,supers ,slots ,@options
-	       (:metaclass standard-db-class))
+	       (:metaclass view-metaclass))
      (finalize-inheritance (find-class ',class))))
 
 (defun keyslots-for-class (class)
@@ -259,7 +262,7 @@ superclass of the newly-defined View Class."
 
 (defun generate-selection-list (vclass)
   (let ((sels nil))
-    (dolist (slotdef (class-slots vclass))
+    (dolist (slotdef (ordered-class-slots vclass))
       (let ((res (generate-attribute-reference vclass slotdef)))
 	(when res
           (push (cons slotdef res) sels))))
@@ -294,11 +297,11 @@ superclass of the newly-defined View Class."
       list))
 
 (defun slot-type (slotdef)
-  (let ((slot-type (slot-definition-type slotdef)))
+  (let ((slot-type (specified-type slotdef)))
     (if (listp slot-type)
-        (cons (find-symbol (symbol-name (car slot-type)) :usql-sys)
+        (cons (find-symbol (symbol-name (car slot-type)) :clsql-sys)
               (cdr slot-type))
-        (find-symbol (symbol-name slot-type) :usql-sys))))
+        (find-symbol (symbol-name slot-type) :clsql-sys))))
 
 (defmethod update-slot-from-db ((instance standard-db-object) slotdef value)
   (declare (optimize (speed 3) #+cmu (extensions:inhibit-warnings 3)))
@@ -526,7 +529,7 @@ associated with that database."))
 		     (db-value-from-slot slot value database)))))
     (let* ((view-class (class-of obj))
 	   (view-class-table (view-table view-class))
-	   (slots (remove-if-not #'slot-storedp (class-slots view-class)))
+	   (slots (remove-if-not #'slot-storedp (ordered-class-slots view-class)))
 	   (record-values (mapcar #'slot-value-list slots)))
       (unless record-values
         (error "No settable slots."))
@@ -555,7 +558,7 @@ associated with that database."))
 		     (db-value-from-slot slot value database)))))
     (let* ((view-class (class-of obj))
 	   (view-class-table (view-table view-class))
-	   (slots (remove-if-not #'slot-storedp (class-slots view-class)))
+	   (slots (remove-if-not #'slot-storedp (ordered-class-slots view-class)))
 	   (record-values (mapcar #'slot-value-list slots)))
       (unless record-values
         (error "No settable slots."))
@@ -616,7 +619,7 @@ associated with that database."))
   (let* ((view-class (class-of instance))
 	 (joins (remove-if #'(lambda (sd)
 			       (not (equal (view-class-slot-db-kind sd) :join)))
-			   (class-slots view-class))))
+			   (ordered-class-slots view-class))))
     (dolist (slot joins)
       (let ((delete-rule (gethash :delete-rule (view-class-slot-db-info slot))))
 	(cond