Re: [patch] Updated Patch for fault-join-target-slot and update-objects-joins

Hi,

After a bunch of attempts, I got this, which seems to work.

1. fault-join-target-slot, based on Drew's solution, now using join to get join
instances, too.

(defun fault-join-target-slot (class object slot-def)
  (let* ((dbi (view-class-slot-db-info slot-def))
	 (ts (gethash :target-slot dbi))
	 (jc  (gethash :join-class dbi))
	 (jc-view-table (view-table (find-class jc)))
	 (tdbi (view-class-slot-db-info
		(find ts (class-slots (find-class jc))
		      :key #'slot-definition-name)))
	 (tsc (gethash :join-class tdbi))
	 (ts-view-table (view-table (find-class tsc)))
	 (jq (join-qualifier class object slot-def)))
    (when jq
      (let ((res
	     (find-all (list tsc jc)
		       :fjts t
		       :inner-join (sql-expression :table jc-view-table)
		       :on (sql-operation
			    '==
			    (sql-expression
			     :attribute (gethash :foreign-key tdbi)
			     :table ts-view-table)
			    (sql-expression
			     :attribute (gethash :home-key tdbi)
			     :table jc-view-table))
		       :where jq
		       :result-types :auto
		       :database (view-database object))))
	res))))

2. Modifications to find-all, based on the fjts key above (so that the
semantics of find-all is affected iff it is called from
fault-join-target-slot).

905c888
<                     instances)
---
>                     instances fjts)
937a921,939
>          (fullsels
>           (if fjts
>               (remove-duplicates
>                fullsels
>                :from-end t
>                :test #'(lambda (p1 p2)
>                          (and (eq (slot-value (cdr p1) 'qualifier)
>                                   (slot-value (cdr p2) 'qualifier))
>                               (eq (slot-value (cdr p1) 'name)
>                                   (slot-value (cdr p2) 'name)))))
>               fullsels))
>          (vtables (mapcar #'view-table sclasses))
>          (fullsels
>           (if fjts
>               (remove-if-not
>                #'(lambda (p)
>                    (member (slot-value (cdr p) 'qualifier) vtables))
>                fullsels)
>               fullsels))
939,948c941,953
<          (tables (remove-if #'null
<                             (remove-duplicates
<                              (append (mapcar #'table-sql-expr sclasses)
<                                      (mapcan #'(lambda (jc-list)
<                                                  (mapcar
<                                                   #'(lambda (jc) (when jc
(table-sql-expr jc)))
<                                                   jc-list))
<                                              immediate-join-classes)
<                                      sel-tables)
<                              :test #'tables-equal)))
---
>          (tables (if fjts
>                      (list (table-sql-expr (car sclasses)))
>                      (remove-if
>                       #'null
>                       (remove-duplicates
>                        (append (mapcar #'table-sql-expr sclasses)
>                                (mapcan #'(lambda (jc-list)
>                                            (mapcar
>                                             #'(lambda (jc) (when jc
(table-sql-expr jc)))
>                                             jc-list))
>                                        immediate-join-classes)
>                                sel-tables)
>                        :test #'tables-equal))))

Alex

__________________________________________________
Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around 
http://mail.yahoo.com