(defclass standard-db-access-class (db-access-class)
())
+(defmethod ensure-class-using-class :around ((class standard-db-access-class) name &rest args &key direct-slots &allow-other-keys)
+ (let ((direct-slots (loop for slot in direct-slots
+ collect (let* ((sname (getf slot :name))
+ (readers (getf slot :readers))
+ (writers (getf slot :writers)))
+ (setf (getf slot :readers)
+ (cons (intern (format nil "~A.~A"
+ name sname)) readers))
+ (setf (getf slot :writers)
+ (cons `(setf ,(intern (format nil "~A.~A"
+ name sname))) writers))
+ slot))))
+
+
+ (apply #'call-next-method class name :direct-slots direct-slots args)))
+
(defun dao-id-column-name (class)
(slot-definition-column-name
(or (class-id-slot-definition class)
(%select-objects type #'select query))
(defun select-only-n-objects (n type &rest query)
- (let ((results (%query `(:limit ,(cons :select
- (intern (format nil "*"))
- (if (string-equal (first query) :from)
- query
- (append `(:from ,type) query))) ,n))))
+ (let ((fields (if (eq :fields (car query))
+ (loop
+ :for cons :on (cdr query)
+ :if (not (keywordp (car cons)))
+ :collect (car cons) into fields
+ :else :do
+ (setf query cons)
+ (return (nreverse (print fields)))
+ :finally
+ (setf query cons)
+ (return (nreverse (print fields))))
+
+ (list (intern "*")))))
+ (let ((results
+ (%query
+ (print `(:limit (:select
+ ,@fields
+ ,@(if (string-equal (first query) :from)
+ (print query)
+ (append `(:from ,type) query)))
+ ,n)))))
(if (eql 1 n)
(make-object-from-plist type (first results))
- (mapcar (curry 'make-object-from-plist type) results))))
+ (mapcar (curry 'make-object-from-plist type) results)))))
(defun make-object-from-plist (type plist)
(let* ((class (find-class type))