r10858: 23 Dec 2005 Kevin Rosenberg <kevin@rosenberg.net>

[clsql.git] / sql / generic-postgresql.lisp

diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp
index ac01e7ba073ecdfe4d2dcb91039c12796f8d3706..983af78b767025a496968f2e272e0e5c41b9563b 100644 (file)
--- a/sql/generic-postgresql.lisp
+++ b/sql/generic-postgresql.lisp
@@ -49,6 +49,16 @@
   (declare (ignore args database))
   "TIMESTAMP WITHOUT TIME ZONE")
 
+(defmethod database-get-type-specifier ((type (eql 'number)) args database
+                                        (db-type (eql :postgresql)))
+  (declare (ignore database db-type))
+  (cond
+   ((and (consp args) (= (length args) 2))
+    (format nil "NUMERIC(~D,~D)" (first args) (second args)))
+   ((and (consp args) (= (length args) 1))
+    (format nil "NUMERIC(~D)" (first args)))
+   (t
+    "NUMERIC")))
 
 ;;; Backend functions
 
@@ -140,15 +150,29 @@
                           (owner-clause owner))
                   database nil nil))))
     (when row
-      (values
-       (ensure-keyword (first row))
-       (if (string= "-1" (second row))
-          (- (parse-integer (third row) :junk-allowed t) 4)
-        (parse-integer (second row)))
-       nil
-       (if (string-equal "f" (fourth row))
-          1
-        0)))))
+      (destructuring-bind (typname attlen atttypmod attnull) row
+
+        (setf attlen (parse-integer attlen :junk-allowed t)
+              atttypmod (parse-integer atttypmod :junk-allowed t))
+              
+        (let ((coltype (ensure-keyword typname))
+              (colnull (if (string-equal "f" attnull) 1 0))
+              collen
+              colprec)
+           (setf (values collen colprec)
+                 (case coltype
+                   ((:numeric :decimal)
+                    (if (= -1 atttypmod)
+                        (values nil nil)
+                        (values (ash (- atttypmod 4) -16)
+                                (boole boole-and (- atttypmod 4) #xffff))))
+                   (otherwise
+                    (values
+                     (cond ((and (= -1 attlen) (= -1 atttypmod)) nil)
+                           ((= -1 attlen) (- atttypmod 4))
+                           (t attlen))
+                     nil))))
+           (values coltype collen colprec colnull))))))
 
 (defmethod database-create-sequence (sequence-name
                                     (database generic-postgresql-database))