X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fgeneric-postgresql.lisp;h=13d4f7714d1445c10be31cdf5b267b9310f73de3;hp=1d1fbf07d62d8cb16a8862d35e0e5cde4a157f76;hb=HEAD;hpb=dc107d34212597ed1272cfa21138d384e71b00d2 diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp index 1d1fbf0..13d4f77 100644 --- a/sql/generic-postgresql.lisp +++ b/sql/generic-postgresql.lisp @@ -20,43 +20,28 @@ ;; Object functions -(defmethod database-get-type-specifier (type args database +(defmethod database-get-type-specifier ((type symbol) args database (db-type (eql :postgresql))) - (declare (ignore type args database)) - "VARCHAR") - -(defmethod database-get-type-specifier ((type (eql 'string)) args database - (db-type (eql :postgresql))) - (declare (ignore database)) - (if args - (format nil "CHAR(~A)" (car args)) - "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)) - (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"))) + "Special database types for POSTGRESQL backends" + (declare (ignore database db-type)) + (case type + (wall-time ;; TODO: why is this WITHOUT... + "TIMESTAMP WITHOUT TIME ZONE") + (string + ;; TODO: the default to CHAR here seems specious as the PG docs claim + ;; that char is slower than varchar + (if args + (format nil "CHAR(~A)" (car args)) + "VARCHAR")) + (number + (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"))) + ((tinyint smallint) "INT2") + (t (call-next-method)))) ;;; Backend functions @@ -140,10 +125,11 @@ database nil nil)) result)))) -(defmethod database-list-attributes ((table string) +(defmethod database-list-attributes ((table %database-identifier) (database generic-postgresql-database) &key (owner nil)) - (let* ((owner-clause + (let* ((table (unescaped-database-identifier table)) + (owner-clause (cond ((stringp owner) (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner)) ((null owner) " AND (not (relowner=1))") @@ -166,9 +152,12 @@ "tableoid") :test #'equal)) result)))) -(defmethod database-attribute-type (attribute (table string) +(defmethod database-attribute-type ((attribute %database-identifier) + (table %database-identifier) (database generic-postgresql-database) - &key (owner nil)) + &key (owner nil) + &aux (table (unescaped-database-identifier table)) + (attribute (unescaped-database-identifier attribute))) (let ((row (car (database-query (format nil "SELECT pg_type.typname,pg_attribute.attlen,pg_attribute.atttypmod,pg_attribute.attnotnull FROM pg_type,pg_class,pg_attribute WHERE pg_class.oid=pg_attribute.attrelid AND pg_class.relname='~A' AND pg_attribute.attname='~A' AND pg_attribute.atttypid=pg_type.oid~A" (string-downcase table) @@ -177,28 +166,29 @@ database nil nil)))) (when row (destructuring-bind (typname attlen atttypmod attnull) row - - (setf attlen (parse-integer attlen :junk-allowed t) - atttypmod (parse-integer atttypmod :junk-allowed t)) - + (setf attlen (%get-int attlen) + atttypmod (%get-int atttypmod)) (let ((coltype (ensure-keyword typname)) - (colnull (if (string-equal "f" attnull) 1 0)) + (colnull (typecase attnull + (string (if (string-equal "f" attnull) 1 0)) + (null 1) + (T 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)))))) + (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)) @@ -219,7 +209,7 @@ (defmethod database-set-sequence-position (name (position integer) (database generic-postgresql-database)) (values - (parse-integer + (%get-int (caar (database-query (format nil "SELECT SETVAL ('~A', ~A)" (escaped-database-identifier name) position) @@ -228,7 +218,7 @@ (defmethod database-sequence-next (sequence-name (database generic-postgresql-database)) (values - (parse-integer + (%get-int (caar (database-query (concatenate 'string "SELECT NEXTVAL ('" (escaped-database-identifier sequence-name) "')") @@ -236,7 +226,7 @@ (defmethod database-sequence-last (sequence-name (database generic-postgresql-database)) (values - (parse-integer + (%get-int (caar (database-query (concatenate 'string "SELECT LAST_VALUE FROM " (escaped-database-identifier sequence-name)) @@ -273,17 +263,14 @@ (when seq (setf const (remove :auto-increment const)) (unless (member :default const) - (let* ((next (format nil "nextval('~a')" (escaped-database-identifier seq)))) + (let* ((next (format nil " nextval('~a')" (escaped-database-identifier seq)))) (setf const (append const (list :default next)))))) (append cdef const)))) (defmethod database-add-autoincrement-sequence ((self standard-db-class) (database generic-postgresql-database)) - (let ((ordered-slots (if (normalizedp self) - (ordered-class-direct-slots self) - (ordered-class-slots self)))) + (let ((ordered-slots (slots-for-possibly-normalized-class self))) (dolist (slotdef ordered-slots) - ;; ensure that referenceed sequences actually exist before referencing them (let ((sequence-name (auto-increment-sequence-name self slotdef database))) (when (and sequence-name @@ -293,10 +280,7 @@ (defmethod database-remove-autoincrement-sequence ((table standard-db-class) (database generic-postgresql-database)) - (let ((ordered-slots - (if (normalizedp table) - (ordered-class-direct-slots table) - (ordered-class-slots table)))) + (let ((ordered-slots (slots-for-possibly-normalized-class table))) (dolist (slotdef ordered-slots) ;; ensure that referenceed sequences are dropped with the table (let ((sequence-name (auto-increment-sequence-name table slotdef database)))