X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fsql.lisp;h=0a0d2f3fef16dc5c4663f6a1c3e2d51d2ff2cd1d;hb=8c6c643e3debe875bd14408cc3129d8148dfd125;hp=0a733aa81035c787e3a12d2c51bf0eb010b4f5a2;hpb=aad71482a312cf287e2f6e3e926cf671cd382ec7;p=clsql.git

diff --git a/sql/sql.lisp b/sql/sql.lisp
index 0a733aa..0a0d2f3 100644
--- a/sql/sql.lisp
+++ b/sql/sql.lisp
@@ -120,7 +120,7 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*."
 			    (av-pairs nil)
 			    (subquery nil))
   (unless into
-      (error 'clsql-sql-syntax-error :reason ":into keyword not supplied"))
+      (error 'sql-user-error :message ":into keyword not supplied"))
   (let ((insert (make-instance 'sql-insert :into into)))
     (with-slots (attributes values query)
       insert
@@ -138,8 +138,8 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*."
 	     (setf attributes attrs)
 	     (setf query subquery))
 	    (t
-	     (error 'clsql-sql-syntax-error
-                    :reason "bad or ambiguous keyword combination.")))
+	     (error 'sql-user-error
+                    :message "bad or ambiguous keyword combination.")))
       insert)))
     
 (defun delete-records (&key (from nil)
@@ -361,62 +361,85 @@ MAP."
   (multiple-value-bind (result-set columns)
       (database-query-result-set query-expression database :full-set nil
 				 :result-types result-types)
-    (when result-set
-      (unwind-protect
-	   (do ((row (make-list columns)))
-	       ((not (database-store-next-row result-set database row))
-		nil)
-	     (apply function row))
-	(database-dump-result-set result-set database)))))
+    (let ((flatp (and (= columns 1) 
+                      (typecase query-expression 
+                        (string t) 
+                        (sql-query 
+                         (slot-value query-expression 'flatp))))))
+      (when result-set
+        (unwind-protect
+             (do ((row (make-list columns)))
+                 ((not (database-store-next-row result-set database row))
+                  nil)
+               (if flatp
+                   (apply function row)
+                   (funcall function row)))
+          (database-dump-result-set result-set database))))))
 		     
 (defun map-query-to-list (function query-expression database result-types)
   (multiple-value-bind (result-set columns)
       (database-query-result-set query-expression database :full-set nil
 				 :result-types result-types)
-    (when result-set
-      (unwind-protect
-	   (let ((result (list nil)))
-	     (do ((row (make-list columns))
-		  (current-cons result (cdr current-cons)))
-		 ((not (database-store-next-row result-set database row))
-		  (cdr result))
-	       (rplacd current-cons (list (apply function row)))))
-	(database-dump-result-set result-set database)))))
-
+    (let ((flatp (and (= columns 1) 
+                      (typecase query-expression 
+                        (string t) 
+                        (sql-query 
+                         (slot-value query-expression 'flatp))))))
+      (when result-set
+        (unwind-protect
+             (let ((result (list nil)))
+               (do ((row (make-list columns))
+                    (current-cons result (cdr current-cons)))
+                   ((not (database-store-next-row result-set database row))
+                    (cdr result))
+                 (rplacd current-cons 
+                         (list (if flatp 
+                                   (apply function row)
+                                   (funcall function (copy-list row)))))))
+          (database-dump-result-set result-set database))))))
 
 (defun map-query-to-simple (output-type-spec function query-expression database result-types)
   (multiple-value-bind (result-set columns rows)
       (database-query-result-set query-expression database :full-set t
 				 :result-types result-types)
-    (when result-set
-      (unwind-protect
-	   (if rows
-	       ;; We know the row count in advance, so we allocate once
-	       (do ((result
-		     (cmucl-compat:make-sequence-of-type output-type-spec rows))
-		    (row (make-list columns))
-		    (index 0 (1+ index)))
-		   ((not (database-store-next-row result-set database row))
-		    result)
-		 (declare (fixnum index))
-		 (setf (aref result index)
-		       (apply function row)))
-	       ;; Database can't report row count in advance, so we have
-	       ;; to grow and shrink our vector dynamically
-	       (do ((result
-		     (cmucl-compat:make-sequence-of-type output-type-spec 100))
-		    (allocated-length 100)
-		    (row (make-list columns))
-		    (index 0 (1+ index)))
-		   ((not (database-store-next-row result-set database row))
-		    (cmucl-compat:shrink-vector result index))
-		 (declare (fixnum allocated-length index))
-		 (when (>= index allocated-length)
-		   (setq allocated-length (* allocated-length 2)
-			 result (adjust-array result allocated-length)))
-		 (setf (aref result index)
-		       (apply function row))))
-	(database-dump-result-set result-set database)))))
+    (let ((flatp (and (= columns 1) 
+                      (typecase query-expression 
+                        (string t) 
+                        (sql-query
+                         (slot-value query-expression 'flatp))))))
+      (when result-set
+        (unwind-protect
+             (if rows
+                 ;; We know the row count in advance, so we allocate once
+                 (do ((result
+                       (cmucl-compat:make-sequence-of-type output-type-spec rows))
+                      (row (make-list columns))
+                      (index 0 (1+ index)))
+                     ((not (database-store-next-row result-set database row))
+                      result)
+                   (declare (fixnum index))
+                   (setf (aref result index)
+                         (if flatp 
+                             (apply function row)
+                             (funcall function (copy-list row)))))
+                 ;; Database can't report row count in advance, so we have
+                 ;; to grow and shrink our vector dynamically
+                 (do ((result
+                       (cmucl-compat:make-sequence-of-type output-type-spec 100))
+                      (allocated-length 100)
+                      (row (make-list columns))
+                      (index 0 (1+ index)))
+                     ((not (database-store-next-row result-set database row))
+                      (cmucl-compat:shrink-vector result index))
+                   (declare (fixnum allocated-length index))
+                   (when (>= index allocated-length)
+                     (setq allocated-length (* allocated-length 2)
+                           result (adjust-array result allocated-length)))
+                   (setf (aref result index)
+                         (if flatp 
+                             (apply function row)
+                             (funcall function (copy-list row))))))
+          (database-dump-result-set result-set database))))))
 
 ;;; Row processing macro from CLSQL