diff --git a/src/pgsql/pgsql-ddl.lisp b/src/pgsql/pgsql-ddl.lisp index 6ad5930..fd573d7 100644 --- a/src/pgsql/pgsql-ddl.lisp +++ b/src/pgsql/pgsql-ddl.lisp @@ -8,12 +8,12 @@ ;;; Schemas ;;; (defmethod format-create-sql ((schema schema) &key (stream nil) if-not-exists) - (format stream "CREATE SCHEMA~@[~IF NOT EXISTS~] ~s;" + (format stream "CREATE SCHEMA~@[~IF NOT EXISTS~] ~a;" if-not-exists (schema-name schema))) (defmethod format-drop-sql ((schema schema) &key (stream nil) cascade if-exists) - (format stream "DROP SCHEMA~@[ IF EXISTS~] ~s~@[ CASCADE~];" + (format stream "DROP SCHEMA~@[ IF EXISTS~] ~a~@[ CASCADE~];" if-exists (schema-name schema) cascade)) @@ -29,7 +29,7 @@ (sqltype-extra sqltype))))) (defmethod format-drop-sql ((sqltype sqltype) &key (stream nil) cascade if-exists) - (format stream "DROP TYPE~:[~; IF EXISTS~] ~s~@[ CASCADE~];" + (format stream "DROP TYPE~:[~; IF EXISTS~] ~a~@[ CASCADE~];" if-exists (sqltype-name sqltype) cascade)) @@ -194,7 +194,7 @@ ;; comes from one source only, the PostgreSQL database catalogs, ;; so don't question it, quote it. (format stream - "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~s~@[ CASCADE~];" + "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~a~@[ CASCADE~];" (format-table-name (index-table index)) if-exists (index-conname index) @@ -211,12 +211,12 @@ (defmethod format-create-sql ((fk fkey) &key (stream nil) if-not-exists) (declare (ignore if-not-exists)) (if (and (fkey-name fk) (fkey-condef fk)) - (format stream "ALTER TABLE ~a ADD CONSTRAINT ~s ~a" + (format stream "ALTER TABLE ~a ADD CONSTRAINT ~a ~a" (format-table-name (fkey-table fk)) (fkey-name fk) (fkey-condef fk)) (format stream - "ALTER TABLE ~a ADD ~@[CONSTRAINT ~s ~]FOREIGN KEY(~{~a~^,~}) REFERENCES ~a(~{~a~^,~})~:[~*~; ON UPDATE ~a~]~:[~*~; ON DELETE ~a~]" + "ALTER TABLE ~a ADD ~@[CONSTRAINT ~a ~]FOREIGN KEY(~{~a~^,~}) REFERENCES ~a(~{~a~^,~})~:[~*~; ON UPDATE ~a~]~:[~*~; ON DELETE ~a~]" (format-table-name (fkey-table fk)) (fkey-name fk) ; constraint name (fkey-columns fk) @@ -230,7 +230,7 @@ (defmethod format-drop-sql ((fk fkey) &key (stream nil) cascade if-exists) (let* ((constraint-name (fkey-name fk)) (table-name (format-table-name (fkey-table fk)))) - (format stream "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~s~@[ CASCADE~];" + (format stream "ALTER TABLE ~a DROP CONSTRAINT~:[~; IF EXISTS~] ~a~@[ CASCADE~];" table-name if-exists constraint-name cascade))) diff --git a/src/sources/mysql/mysql-cast-rules.lisp b/src/sources/mysql/mysql-cast-rules.lisp index fc5262c..e81c48f 100644 --- a/src/sources/mysql/mysql-cast-rules.lisp +++ b/src/sources/mysql/mysql-cast-rules.lisp @@ -6,7 +6,8 @@ (defun enum-or-set-name (table-name column-name type ctype typemod) (declare (ignore type ctype typemod)) - (string-downcase (format nil "~a_~a" table-name column-name))) + (apply-identifier-case + (format nil "~a_~a" (unquote table-name #\") (unquote column-name #\")))) ;;; ;;; The default MySQL Type Casting Rules @@ -194,12 +195,12 @@ ;; extra triggers ;; - ;; See the generic function `post-process-catalog' for the next step. + ;; See src/pgsql/pgsql-trigger.lisp ;; (when (string= extra "on update CURRENT_TIMESTAMP") (let* ((pro-name (format nil "on_update_current_timestamp_~a" - (column-name pgcol)))) + (unquote (column-name pgcol) #\")))) (setf (column-extra pgcol) (make-trigger :name :on-update-current-timestamp :action "BEFORE UPDATE" diff --git a/src/utils/quoting.lisp b/src/utils/quoting.lisp index f4f6364..8a85f5c 100644 --- a/src/utils/quoting.lisp +++ b/src/utils/quoting.lisp @@ -43,6 +43,6 @@ (ecase *identifier-case* (:downcase lowercase-identifier) - (:quote (format nil "\"~a\"" + (:quote (format nil "~s" (cl-ppcre:regex-replace-all "\"" identifier "\"\""))) (:none identifier)))) diff --git a/src/utils/utils.lisp b/src/utils/utils.lisp index b95c3da..1c8572a 100644 --- a/src/utils/utils.lisp +++ b/src/utils/utils.lisp @@ -25,14 +25,22 @@ ;;; ;;; Unquote SQLite default values, might be useful elsewhere ;;; -(defun unquote (string &optional (quote #\')) +(defun unquote (string &optional (quote #\') (escape #\\)) "Given '0', returns 0." (declare (type (or null simple-string) string)) (when string (let ((l (length string))) - (if (char= quote (aref string 0) (aref string (1- l))) - (subseq string 1 (1- l)) - string)))) + (cond ((and (<= 2 l) ; "string" + (char= quote (aref string 0) (aref string (1- l)))) + (subseq string 1 (1- l))) + + ((and (<= 4 l) ; \"string\" + (char= escape (aref string 0) (aref string (- l 2))) + (char= quote (aref string 1) (aref string (- l 1)))) + (subseq string 2 (- l 2))) + + (t + string))))) ;;; ;;; Process ~/ references at run-time (not at compile time!)