- (foreign-keys (gethash :foreign-key dbi))
- (home-keys (gethash :home-key dbi)))
- (when (every #'(lambda (slt)
- (and (slot-boundp object slt)
- (not (null (slot-value object slt)))))
- (if (listp home-keys) home-keys (list home-keys)))
- (let ((jc
- (mapcar #'(lambda (hk fk)
- (let ((fksd (slotdef-for-slot-with-class fk jc)))
- (sql-operation '==
- (typecase fk
- (symbol
- (sql-expression
- :attribute
- (database-identifier fksd nil)
- :table (database-identifier jc nil)))
- (t fk))
- (typecase hk
- (symbol
- (slot-value object hk))
- (t
- hk)))))
- (if (listp home-keys)
- home-keys
- (list home-keys))
- (if (listp foreign-keys)
- foreign-keys
- (list foreign-keys)))))
- (when jc
- (if (> (length jc) 1)
- (apply #'sql-and jc)
- jc))))))
+ (foreign-keys (listify (join-slot-info-value slot-def :foreign-key)))
+ (home-keys (listify (join-slot-info-value slot-def :home-key))))
+ (when (all-home-keys-have-values-p object slot-def)
+ (clsql-ands
+ (loop for hk in home-keys
+ for fk in foreign-keys
+ for fksd = (slotdef-for-slot-with-class fk jc)
+ for fk-sql = (typecase fk
+ (symbol
+ (sql-expression
+ :attribute (database-identifier fksd nil)
+ :table (database-identifier jc nil)))
+ (t fk))
+ for hk-val = (typecase hk
+ ((or symbol
+ view-class-effective-slot-definition
+ view-class-direct-slot-definition)
+ (easy-slot-value object hk))
+ (t hk))
+ collect (sql-operation '== fk-sql hk-val))))))