meta-model enhancements

Added update-joins to sync-instance
Added explode-has-many

darcs-hash:20050620175700-39164-157674167756d5e36c73d0443a4754be5c6639b7.gz

diff --git a/src/backend/clsql.lisp b/src/backend/clsql.lisp
index 0295d6e..815653e 100644 (file)
--- a/src/backend/clsql.lisp
+++ b/src/backend/clsql.lisp
@@ -14,7 +14,11 @@
   (labels ((sym->sql (sym) (string-downcase (substitute #\_ #\- (string sym))))
            (get-def (slot) (caar (query
                                   (format nil                                                             "SELECT DISTINCT adsrc from pg_attrdef join pg_attribute on attnum = adnum where adrelid = (select oid from pg_class where relname = '~A') and attname = '~A'" (sym->sql (class-name (class-of view))) (sym->sql slot)))))
   (labels ((sym->sql (sym) (string-downcase (substitute #\_ #\- (string sym))))
            (get-def (slot) (caar (query
                                   (format nil                                                             "SELECT DISTINCT adsrc from pg_attrdef join pg_attribute on attnum = adnum where adrelid = (select oid from pg_class where relname = '~A') and attname = '~A'" (sym->sql (class-name (class-of view))) (sym->sql slot)))))

-           (get-default-value (slot) (caar (query (format nil "SELECT ~A" (get-def slot))))))
+           (get-default-value (slot) 
+            (let ((def (get-def slot)))
+              (if def
+                  (caar (query (format nil "SELECT ~A" def)))
+                  (error "No default value for primary key : ~A" slot)))))

 
     (dolist (slot (list-slots view))
       (when (and (primary-key-p view slot)
 
     (dolist (slot (list-slots view))
       (when (and (primary-key-p view slot)


@@ -22,7 +26,8 @@
                      (equal (slot-value view slot) nil)))
         (setf (slot-value view slot) (get-default-value slot)))))
   (update-records-from-instance view :database database)
                      (equal (slot-value view slot) nil)))
         (setf (slot-value view slot) (get-default-value slot)))))
   (update-records-from-instance view :database database)

-  (update-instance-from-records view :database database))
+  (update-instance-from-records view :database database)
+  (update-objects-joins (list view)))

 
 
 
 
 
 

diff --git a/src/meta-model.lisp b/src/meta-model.lisp
index 9ea1d3c..9065071 100644 (file)
--- a/src/meta-model.lisp
+++ b/src/meta-model.lisp
@@ -177,5 +177,13 @@
   "returns the SLOT in the foreign VIEW-CLASS that joins with FOREIGN-KEY"
   (car (list-relations-helper view (find-join-helper foreign-key) :return-key :foreign-key)))
 
   "returns the SLOT in the foreign VIEW-CLASS that joins with FOREIGN-KEY"
   (car (list-relations-helper view (find-join-helper foreign-key) :return-key :foreign-key)))
 

+(defmethod explode-has-many ((view t) join-slot)
+  "returns the class of the join as the primary value, the second and third value is the home key and the foreign key"
+  (let ((att (assoc join-slot (list-join-attributes view))))
+    (values (getf (cdr att) :join-class) 
+           (getf (cdr att) :home-key) 
+           (getf (cdr att) :foreign-key))))
+  
+

 
 
 
 

diff --git a/src/mewa/mewa.lisp b/src/mewa/mewa.lisp
index 0164802..e384f74 100644 (file)
--- a/src/mewa/mewa.lisp
+++ b/src/mewa/mewa.lisp
@@ -85,6 +85,7 @@ attributes is an alist keyed on the attribute nreeame."
 
 
 (defmethod default-attributes ((model t))
 
 
 (defmethod default-attributes ((model t))

+  "return the default attributes for a given model using the meta-model's meta-data"

   (append (mapcar #'(lambda (s) 
                      (cons (car s) 
                            (gen-pslot 
   (append (mapcar #'(lambda (s) 
                      (cons (car s) 
                            (gen-pslot