From a6644385238aac1694af714e321c34456bea3441 Mon Sep 17 00:00:00 2001
From: drewc <drewc@tech.coop>
Date: Mon, 20 Jun 2005 10:57:00 -0700
Subject: [PATCH] meta-model enhancements

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

darcs-hash:20050620175700-39164-157674167756d5e36c73d0443a4754be5c6639b7.gz
---
 src/backend/clsql.lisp | 9 +++++++--
 src/meta-model.lisp    | 8 ++++++++
 src/mewa/mewa.lisp     | 1 +
 3 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/src/backend/clsql.lisp b/src/backend/clsql.lisp
index 0295d6e..815653e 100644
--- 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)))))
-           (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)
@@ -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)
-  (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
--- 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)))
 
+(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
--- 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))
+  "return the default attributes for a given model using the meta-model's meta-data"
   (append (mapcar #'(lambda (s) 
 		      (cons (car s) 
 			    (gen-pslot 
-- 
2.20.1