X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fgeneric-postgresql.lisp;h=13d4f7714d1445c10be31cdf5b267b9310f73de3;hp=ecf6ddfde7ca2f404147c08aca113c95ec8e5e9a;hb=0b35694f3659e5ee739ea72ce74d798c3f0ddb73;hpb=f1d668746523a72a6893a46380468a9e033545e4 diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp index ecf6ddf..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) @@ -274,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 @@ -294,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)))