X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fgeneric-postgresql.lisp;h=983af78b767025a496968f2e272e0e5c41b9563b;hb=159a4ba88b6ed66a27968df60d91c6b284401d2b;hp=c387f19c41117b2e6af10d06a904fe72775aea3c;hpb=635fd6df23f5cdc0247ec93dfdb04e1be670412e;p=clsql.git diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp index c387f19..983af78 100644 --- a/sql/generic-postgresql.lisp +++ b/sql/generic-postgresql.lisp @@ -32,13 +32,33 @@ (declare (ignore database)) (if args (format nil "CHAR(~A)" (car args)) - "VARCHAR")) + "VARCHAR")) + +(defmethod database-get-type-specifier ((type (eql 'tinyint)) args database + (db-type (eql :postgresql))) + (declare (ignore args database)) + "INT2") + +(defmethod database-get-type-specifier ((type (eql 'smallint)) args database + (db-type (eql :postgresql))) + (declare (ignore args database)) + "INT2") (defmethod database-get-type-specifier ((type (eql 'wall-time)) args database (db-type (eql :postgresql))) (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 @@ -105,7 +125,7 @@ (result (mapcar #'car (database-query - (format nil "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'~A" + (format nil "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND attisdropped = FALSE AND relname='~A'~A" (string-downcase table) owner-clause) database nil nil)))) @@ -130,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)) @@ -178,7 +212,7 @@ (parse-integer (caar (database-query - (concatenate 'string "SELECT LAST_VALUE ('" sequence-name "')") + (concatenate 'string "SELECT LAST_VALUE FROM " sequence-name) database nil nil))))) (defun postgresql-database-list (connection-spec type) @@ -201,8 +235,12 @@ (defmethod database-list (connection-spec (type (eql :postgresql-socket))) (postgresql-database-list connection-spec type)) - +#+nil (defmethod database-describe-table ((database generic-postgresql-database) table) + ;; MTP: LIST-ATTRIBUTE-TYPES currently executes separate queries for + ;; each attribute. It would be more efficient to have a single SQL + ;; query return the type data for all attributes. This code is + ;; retained as an example of how to do this for PostgreSQL. (database-query (format nil "select a.attname, t.typname from pg_class c, pg_attribute a, pg_type t