X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fgeneric-postgresql.lisp;h=4c726da68d5be6b83fff7decd8e9feeec6aa1004;hb=30186614582039bdc3d3f86bc5165ef300c5d3e0;hp=1d1fbf07d62d8cb16a8862d35e0e5cde4a157f76;hpb=dc107d34212597ed1272cfa21138d384e71b00d2;p=clsql.git diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp index 1d1fbf0..4c726da 100644 --- a/sql/generic-postgresql.lisp +++ b/sql/generic-postgresql.lisp @@ -140,10 +140,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 +167,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 +181,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 +224,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 +233,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 +241,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))