Added NULL description and added :when option for attribute active

[clinton/lisp-on-lines.git] / src / rofl.lisp

diff --git a/src/rofl.lisp b/src/rofl.lisp
index 3d73725..eb212fa 100644 (file)
--- a/src/rofl.lisp
+++ b/src/rofl.lisp
@@ -150,6 +150,22 @@ inheritance and does not create any tables for it."))
 (defclass standard-db-access-class (db-access-class)
   ())
 
 (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)
 (defun dao-id-column-name (class)
   (slot-definition-column-name
    (or (class-id-slot-definition class)


@@ -197,14 +213,30 @@ inheritance and does not create any tables for it."))
   (%select-objects type #'select query))
 
 (defun select-only-n-objects (n type &rest query)
   (%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))
     (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))
 
 (defun make-object-from-plist (type plist)
   (let* ((class (find-class type))