X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fgeneric-postgresql.lisp;h=feeaced389b125c371f40475cfd8bb0ba79e021a;hp=7716eb209e719c143c96f6b36217b1860530ff7b;hb=4972b90bab0ee31300e49c0c06b472de747cbbb6;hpb=ef93cbe09e01bb540651e6719eb4e8fe7ebeefd0 diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp index 7716eb2..feeaced 100644 --- a/sql/generic-postgresql.lisp +++ b/sql/generic-postgresql.lisp @@ -22,7 +22,8 @@ (defmethod database-get-type-specifier (type args database (db-type (eql :postgresql))) - (declare (ignore type args database)) + (warn "Could not determine a valid :postgresqlsql type specifier for ~A ~A ~A, defaulting to VARCHAR " + type args database) "VARCHAR") (defmethod database-get-type-specifier ((type (eql 'string)) args database @@ -127,8 +128,8 @@ (database-query (format nil - "select indexrelid from pg_index where indrelid=(select relfilenode from pg_class where relname='~A'~A)" - (string-downcase table) + "select indexrelid from pg_index where indrelid=(select relfilenode from pg_class where LOWER(relname)='~A'~A)" + (string-downcase (unescaped-database-identifier table)) (owner-clause owner)) database :auto nil)) (result nil)) @@ -140,10 +141,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 +168,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,39 +182,41 @@ 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)) - (database-execute-command - (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name)) - database)) + (let ((cmd (concatenate + 'string "CREATE SEQUENCE " (escaped-database-identifier sequence-name database)))) + (database-execute-command cmd database))) (defmethod database-drop-sequence (sequence-name (database generic-postgresql-database)) (database-execute-command - (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database)) + (concatenate 'string "DROP SEQUENCE " (escaped-database-identifier sequence-name database)) + database)) (defmethod database-list-sequences ((database generic-postgresql-database) &key (owner nil)) @@ -218,76 +225,82 @@ (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)" name position) + (format nil "SELECT SETVAL ('~A', ~A)" (escaped-database-identifier name) position) database nil nil))))) (defmethod database-sequence-next (sequence-name (database generic-postgresql-database)) (values - (parse-integer + (%get-int (caar (database-query - (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')") + (concatenate 'string "SELECT NEXTVAL ('" (escaped-database-identifier sequence-name) "')") database nil nil))))) (defmethod database-sequence-last (sequence-name (database generic-postgresql-database)) (values - (parse-integer + (%get-int (caar (database-query - (concatenate 'string "SELECT LAST_VALUE FROM " sequence-name) + (concatenate 'string "SELECT LAST_VALUE FROM " (escaped-database-identifier sequence-name)) database nil nil))))) +(defmethod auto-increment-sequence-name (table column (database generic-postgresql-database)) + (let* ((sequence-name (or (database-identifier (slot-value column 'autoincrement-sequence)) + (combine-database-identifiers + (list table column 'seq) + database)))) + (when (search "'" (escaped-database-identifier sequence-name) + :test #'string-equal) + (signal-database-too-strange + "PG Sequence names shouldnt contain single quotes for the sake of sanity")) + sequence-name)) + (defmethod database-last-auto-increment-id ((database generic-postgresql-database) table column) - (let (column-helper seq-name) - (typecase table - (sql-ident (setf table (slot-value table 'name))) - (standard-db-class (setf table (view-table table)))) - (typecase column - (sql-ident (setf column-helper (slot-value column 'name))) - (view-class-slot-definition-mixin - (setf column-helper (view-class-slot-column column)))) - (setq seq-name (or (view-class-slot-autoincrement-sequence column) - (convert-to-db-default-case (format nil "~a_~a_seq" table column-helper) database))) - (first (clsql:query (format nil "SELECT currval ('~a')" seq-name) + (let ((seq-name (auto-increment-sequence-name table column database))) + (first (clsql:query (format nil "SELECT currval ('~a')" + (escaped-database-identifier seq-name)) :flatp t :database database :result-types '(:int))))) -(defmethod database-generate-column-definition (class slotdef (database generic-postgresql-database)) - ; handle autoincr slots special - (when (or (and (listp (view-class-slot-db-constraints slotdef)) - (member :auto-increment (view-class-slot-db-constraints slotdef))) - (eql :auto-increment (view-class-slot-db-constraints slotdef)) - (slot-value slotdef 'autoincrement-sequence)) - (let ((sequence-name (database-make-autoincrement-sequence class slotdef database))) - (setf (view-class-slot-autoincrement-sequence slotdef) sequence-name) - (cond ((listp (view-class-slot-db-constraints slotdef)) - (setf (view-class-slot-db-constraints slotdef) - (remove :auto-increment - (view-class-slot-db-constraints slotdef))) - (unless (member :default (view-class-slot-db-constraints slotdef)) - (setf (view-class-slot-db-constraints slotdef) - (append - (list :default (format nil "nextval('~a')" sequence-name)) - (view-class-slot-db-constraints slotdef))))) - (t - (setf (view-class-slot-db-constraints slotdef) - (list :default (format nil "nextval('~a')" sequence-name))))))) - (call-next-method class slotdef database)) - -(defmethod database-make-autoincrement-sequence (table column (database generic-postgresql-database)) - (let* ((table-name (view-table table)) - (column-name (view-class-slot-column column)) - (sequence-name (or (slot-value column 'autoincrement-sequence) - (convert-to-db-default-case - (format nil "~a_~a_SEQ" table-name column-name) database)))) - (unless (sequence-exists-p sequence-name :database database) - (database-create-sequence sequence-name database)) - sequence-name)) +(defmethod database-generate-column-definition + (class slotdef (database generic-postgresql-database)) + (when (member (view-class-slot-db-kind slotdef) '(:base :key)) + (let ((cdef + (list (sql-expression :attribute (database-identifier slotdef database)) + (specified-type slotdef) + (view-class-slot-db-type slotdef))) + (const (listify (view-class-slot-db-constraints slotdef))) + (seq (auto-increment-sequence-name class slotdef database))) + (when seq + (setf const (remove :auto-increment const)) + (unless (member :default const) + (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 (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 + (not (sequence-exists-p sequence-name :database database))) + (create-sequence sequence-name :database database)))))) + +(defmethod database-remove-autoincrement-sequence + ((table standard-db-class) + (database generic-postgresql-database)) + (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))) + (when sequence-name (drop-sequence sequence-name)))))) (defun postgresql-database-list (connection-spec type) (destructuring-bind (host name &rest other-args) connection-spec @@ -428,3 +441,5 @@ (defmethod db-type-has-prepared-stmt? ((db-type (eql :postgresql-socket))) t) +(defmethod db-type-has-auto-increment? ((db-type (eql :postgresql))) + t)