X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/b7657b86f85f575d5776dc6b626b1dc258d1fa47..2548f0540da69973512f1827b2bfd2360470bb27:/src/rofl.lisp

diff --git a/src/rofl.lisp b/src/rofl.lisp
index 3d73725..d26843f 100644
--- a/src/rofl.lisp
+++ b/src/rofl.lisp
@@ -19,6 +19,9 @@
 
 
 ;;;; now the rofl code itself
+
+(defvar *row-reader* 'symbol-plist-row-reader)
+
 (defun %query (query)
   (cl-postgres:exec-query *database* (sql-compile query) 'symbol-plist-row-reader))
 
@@ -150,6 +153,22 @@ inheritance and does not create any tables for it."))
 (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)
@@ -197,14 +216,30 @@ inheritance and does not create any tables for it."))
   (%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))