X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-sqlite%2Fsqlite-sql.lisp;h=703eb94928ded58f5e9a54162530c1cfa5782384;hb=f716bb1161cf9e89a96945c4a444244f9d303691;hp=9b7a8fceae594b08d404e4541d544fa0d1a23e6c;hpb=cc92d162f24648d65ad872098353305a5baf91d7;p=clsql.git

diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp
index 9b7a8fc..703eb94 100644
--- a/db-sqlite/sqlite-sql.lisp
+++ b/db-sqlite/sqlite-sql.lisp
@@ -75,30 +75,34 @@
 	     :error (sqlite:sqlite-error-message err))))
   t)
 
-(defmethod database-query (query-expression (database sqlite-database) result-types)
+(defmethod database-query (query-expression (database sqlite-database) result-types field-names)
   (declare (ignore result-types))		; SQLite is typeless!
   (handler-case
       (multiple-value-bind (data row-n col-n)
 	  (sqlite:sqlite-get-table (sqlite-db database) query-expression)
 	#-clisp (declare (type sqlite:sqlite-row-pointer-type data))
-	(if (= row-n 0)
-	    nil
-	    (prog1
-		;; The first col-n elements are column names.
-		(loop for i from col-n below (* (1+ row-n) col-n) by col-n
-		      collect (loop for j from 0 below col-n
-				    collect
-				    (#+clisp aref
-				     #-clisp sqlite:sqlite-aref
-				             data (+ i j))))
-	        #-clisp (sqlite:sqlite-free-table data))
-	      ))
+	(let ((rows
+	       (when (plusp row-n)
+		 (loop for i from col-n below (* (1+ row-n) col-n) by col-n
+		     collect (loop for j from 0 below col-n
+				 collect
+				   (#+clisp aref
+					    #-clisp sqlite:sqlite-aref
+					    data (+ i j))))))
+	      (names
+	       (when field-names
+		 (loop for j from 0 below col-n
+		     collect (#+clisp aref
+				      #-clisp sqlite:sqlite-aref
+				      data j)))))
+	  #-clisp (sqlite:sqlite-free-table data)
+	  (values rows names)))
     (sqlite:sqlite-error (err)
-      (error 'clsql-sql-error
-	     :database database
-	     :expression query-expression
-	     :errno (sqlite:sqlite-error-code err)
-	     :error (sqlite:sqlite-error-message err)))))
+                         (error 'clsql-sql-error
+                                :database database
+                                :expression query-expression
+                                :errno (sqlite:sqlite-error-code err)
+                                :error (sqlite:sqlite-error-message err)))))
 
 #-clisp
 (defstruct sqlite-result-set
@@ -188,24 +192,24 @@
   ;; Query is copied from .table command of sqlite comamnd line utility.
   (remove-if #'(lambda (s)
                  (and (>= (length s) 11)
-                      (string= (subseq s 0 11) "_CLSQL_SEQ_")))
+                      (string-equal (subseq s 0 11) "_CLSQL_SEQ_")))
              (mapcar #'car (database-query
                             "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name"
-                            database '()))))
+                            database nil nil))))
 
 (defmethod database-list-views ((database sqlite-database)
                                 &key (owner nil))
   (declare (ignore owner))
   (mapcar #'car (database-query
                  "SELECT name FROM sqlite_master WHERE type='view' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='view' ORDER BY name"
-                 database nil)))
+                 database nil nil)))
 
 (defmethod database-list-indexes ((database sqlite-database)
                                   &key (owner nil))
   (declare (ignore owner))
   (mapcar #'car (database-query
                  "SELECT name FROM sqlite_master WHERE type='index' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' ORDER BY name"
-                 database nil)))
+                 database nil nil)))
 
 (defmethod database-list-table-indexes (table (database sqlite-database)
 					&key (owner nil))
@@ -217,12 +221,12 @@
 	      nil
 	      "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='~A' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' AND tbl_name='~A' ORDER BY name"
 	      table table)
-	     database nil))))
+	     database nil nil))))
 
 (declaim (inline sqlite-table-info))
 (defun sqlite-table-info (table database)
   (database-query (format nil "PRAGMA table_info('~A')" table)
-			  database '()))
+		  database nil nil))
 
 (defmethod database-list-attributes (table (database sqlite-database)
                                            &key (owner nil))
@@ -235,8 +239,22 @@
                                     &key (owner nil))
   (declare (ignore owner))
   (loop for field-info in (sqlite-table-info table database)
-	when (string= attribute (second field-info))
-	return (third field-info)))
+      when (string= attribute (second field-info))
+      return 
+	(let* ((raw-type (third field-info))
+	       (start-length (position #\( raw-type))
+	       (type (if start-length
+			 (subseq raw-type 0 start-length)
+		       raw-type))
+	       (length (if start-length
+			   (parse-integer (subseq raw-type (1+ start-length))
+					  :junk-allowed t)
+			 nil)))
+	  (values (when type (ensure-keyword type)) 
+		  length
+		  nil
+		  (if (string-equal (fourth field-info) "0")
+		      1 0)))))
 
 (defun %sequence-name-to-table-name (sequence-name)
   (concatenate 'string "_CLSQL_SEQ_" (sql-escape sequence-name)))
@@ -273,7 +291,7 @@
                 (and sn (list sn))))
           (database-query
            "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name"
-           database '())))
+           database nil nil)))
 
 (defmethod database-sequence-next (sequence-name (database sqlite-database))
   (without-interrupts
@@ -282,8 +300,7 @@
 	   (car (database-query 
 		 (concatenate 'string "SELECT last_value,is_called FROM " 
 			      table-name)
-		 database
-		 :auto))))
+		 database :auto nil))))
      (cond
        ((char-equal (schar (second tuple) 0) #\f)
 	(database-execute-command
@@ -303,8 +320,7 @@
      (caar (database-query 
 	    (concatenate 'string "SELECT last_value FROM " 
 			 (%sequence-name-to-table-name sequence-name))
-	    database
-	    :auto)))))
+	    database :auto nil)))))
 
 (defmethod database-set-sequence-position (sequence-name
                                            (position integer)