From 4612e684356cf68ee06d29f27a77e08e08c7e191 Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Wed, 31 Jan 2018 15:17:05 +0100 Subject: [PATCH] Implement support for new casting rules guards and actions. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Namely the actions are “keep extra” and “drop extra” and the casting rule guard is “with extra on update current timestamp”. Having support for those elements in the casting rules allow such a definition as the following: type timestamp with extra on update current timestamp to "timestamp with time zone" drop extra The effect of such as cast rule would be to ignore the MySQL extra definition and then refrain pgloader from creating the PostgreSQL triggers that implement the same behavior. Fix #735. --- src/parsers/command-cast-rules.lisp | 28 +++++++++++++++++++----- src/parsers/command-keywords.lisp | 7 ++++++ src/pgsql/pgsql-create-schema.lisp | 1 + src/sources/common/casting-rules.lisp | 29 ++++++++++++++++++++----- src/sources/mysql/mysql-cast-rules.lisp | 13 +++++++++-- src/sources/mysql/mysql-schema.lisp | 3 ++- test/mysql/my.load | 5 ++++- 7 files changed, 70 insertions(+), 16 deletions(-) diff --git a/src/parsers/command-cast-rules.lisp b/src/parsers/command-cast-rules.lisp index 56dd384..1fdc10f 100644 --- a/src/parsers/command-cast-rules.lisp +++ b/src/parsers/command-cast-rules.lisp @@ -20,8 +20,11 @@ (alexandria:alist-plist guards))) ;; at the moment we only know about extra auto_increment -(defrule cast-source-extra (and kw-with kw-extra kw-auto-increment) - (:constant (list :auto-increment t))) +(defrule cast-source-extra (and kw-with kw-extra + (or kw-auto-increment + kw-on-update-current-timestamp)) + (:lambda (extra) + (list (third extra) t))) (defrule cast-source-type (and kw-type trimmed-name) (:destructure (kw name) (declare (ignore kw)) (list :type name))) @@ -40,18 +43,21 @@ (? cast-source-guards) ignore-whitespace) (:lambda (source) - (bind (((name-and-type opts guards _) source) + (bind (((name-and-type extra guards _) source) ((&key (default nil d-s-p) (typemod nil t-s-p) (unsigned nil u-s-p) &allow-other-keys) guards) ((&key (auto-increment nil ai-s-p) - &allow-other-keys) opts)) + (on-update-current-timestamp nil ouct-s-p) + &allow-other-keys) extra)) `(,@name-and-type ,@(when t-s-p (list :typemod typemod)) ,@(when d-s-p (list :default default)) ,@(when u-s-p (list :unsigned unsigned)) - ,@(when ai-s-p (list :auto-increment auto-increment)))))) + ,@(when ai-s-p (list :auto-increment auto-increment)) + ,@(when ouct-s-p (list :on-update-current-timestamp + on-update-current-timestamp)))))) (defrule cast-type-name (or double-quoted-namestring (and (alpha-char-p character) @@ -85,9 +91,17 @@ (defrule cast-set-not-null (and kw-set kw-not kw-null) (:constant (list :set-not-null t))) +(defrule cast-keep-extra (and kw-keep kw-extra) + (:constant (list :keep-extra t))) + +(defrule cast-drop-extra (and kw-drop kw-extra) + (:constant (list :drop-extra t))) + (defrule cast-def (+ (or cast-to-type cast-keep-default cast-drop-default + cast-keep-extra + cast-drop-extra cast-keep-typemod cast-drop-typemod cast-keep-not-null @@ -95,9 +109,11 @@ cast-set-not-null)) (:lambda (source) (destructuring-bind - (&key type drop-default drop-typemod drop-not-null set-not-null &allow-other-keys) + (&key type drop-default drop-extra drop-typemod + drop-not-null set-not-null &allow-other-keys) (apply #'append source) (list :type type + :drop-extra drop-extra :drop-default drop-default :drop-typemod drop-typemod :drop-not-null drop-not-null diff --git a/src/parsers/command-keywords.lisp b/src/parsers/command-keywords.lisp index d670bb9..a2454cd 100644 --- a/src/parsers/command-keywords.lisp +++ b/src/parsers/command-keywords.lisp @@ -157,6 +157,13 @@ (defrule kw-auto-increment (and "auto_increment" (* (or #\Tab #\Space))) (:constant :auto-increment)) +(defrule kw-on-update-current-timestamp (and (~ "on update") + (* (or #\Tab #\Space)) + (or (~ "CURRENT TIMESTAMP") + (~ "CURRENT_TIMESTAMP")) + (* (or #\Tab #\Space))) + (:constant :on-update-current-timestamp)) + (defrule kw-postgresql (or (~ "pgsql") (~ "postgresql"))) (defrule kw-mysql (~ "mysql")) (defrule kw-mssql (~ "mssql")) diff --git a/src/pgsql/pgsql-create-schema.lisp b/src/pgsql/pgsql-create-schema.lisp index 9781fdc..caaa5e7 100644 --- a/src/pgsql/pgsql-create-schema.lisp +++ b/src/pgsql/pgsql-create-schema.lisp @@ -150,6 +150,7 @@ :collect (format-create-sql (trigger-procedure trigger)) :collect (format-create-sql trigger))))) (pgsql-execute-with-timing section label sql-list + :log-level :log :client-min-messages client-min-messages))) diff --git a/src/sources/common/casting-rules.lisp b/src/sources/common/casting-rules.lisp index fe6bcef..3eed256 100644 --- a/src/sources/common/casting-rules.lisp +++ b/src/sources/common/casting-rules.lisp @@ -54,6 +54,7 @@ ((:unsigned rule-unsigned) nil u-s-p) ((:not-null rule-source-not-null) nil n-s-p) ((:auto-increment rule-source-auto-increment)) + ((:on-update-current-timestamp rule-source-updts)) &allow-other-keys) rule-source (destructuring-bind (&key table-name @@ -63,10 +64,12 @@ typemod default not-null + extra unsigned - auto-increment) + auto-increment + on-update-current-timestamp) source - (declare (ignore ctype)) + (declare (ignore ctype extra)) (when (and (or (and t-s-p (string= type rule-source-type)) @@ -81,7 +84,13 @@ ;; current RULE only matches SOURCE when both have an ;; auto_increment property, or none have it. (or (and auto-increment rule-source-auto-increment) - (and (not auto-increment) (not rule-source-auto-increment)))) + (and (not auto-increment) (not rule-source-auto-increment))) + + ;; current RULE only matches SOURCE when both have an + ;; on-update-current-timestamp property, or none have it. + (or (and on-update-current-timestamp rule-source-updts) + (and (not on-update-current-timestamp) + (not rule-source-updts)))) (list :using using :target rule-target)))))) (defun make-pgsql-type (source target using) @@ -92,12 +101,14 @@ ((:ctype source-ctype)) ((:typemod source-typemod)) ((:default source-default)) + ((:extra source-extra)) ((:not-null source-not-null)) &allow-other-keys) source (if target (destructuring-bind (&key type - drop-default + drop-extra + drop-default drop-not-null set-not-null (drop-typemod t) @@ -122,6 +133,8 @@ drop-not-null)) :default (when (and source-default (not drop-default)) source-default) + :extra (when (and source-extra (not drop-extra)) + source-extra) :transform using))) ;; NO MATCH @@ -132,6 +145,7 @@ :type-name source-ctype :nullable (not source-not-null) :default source-default + :extra source-extra :transform using)))) (defun apply-casting-rules (table-name column-name @@ -143,7 +157,8 @@ (let* ((typemod (parse-column-typemod dtype ctype)) (unsigned (parse-column-unsigned dtype ctype)) (not-null (string-equal nullable "NO")) - (auto-increment (string= "auto_increment" extra)) + (auto-increment (eq :auto-increment extra)) + (on-upd-cts (eq :on-update-current-timestamp extra)) (source `(:table-name ,table-name :column-name ,column-name :type ,dtype @@ -152,7 +167,9 @@ :unsigned ,unsigned :default ,default :not-null ,not-null - :auto-increment ,auto-increment))) + :extra ,extra + :auto-increment ,auto-increment + :on-update-current-timestamp ,on-upd-cts))) (let (first-match-using) (loop :for rule :in rules diff --git a/src/sources/mysql/mysql-cast-rules.lisp b/src/sources/mysql/mysql-cast-rules.lisp index cb4fa3d..b56efb6 100644 --- a/src/sources/mysql/mysql-cast-rules.lisp +++ b/src/sources/mysql/mysql-cast-rules.lisp @@ -173,6 +173,15 @@ ("(?i)(?:ENUM|SET)\\s*\\((.*)\\)" ctype) (first (cl-csv:read-csv list :separator #\, :quote #\' :escape "''")))) +(defun normalize-extra (extra) + "Normalize MySQL strings into pgloader CL keywords for internal processing." + (cond ((string= "auto_increment" extra) + :auto-increment) + + ((or (string= extra "on update CURRENT_TIMESTAMP") + (string= extra "on update current_timestamp()")) + :on-update-current-timestamp))) + (defmethod cast ((col mysql-column) &key table) "Return the PostgreSQL type definition from given MySQL column definition." (with-slots (table-name name dtype ctype default nullable extra comment) @@ -227,10 +236,10 @@ ;; ;; See src/pgsql/pgsql-trigger.lisp ;; - (when (or (string= extra "on update CURRENT_TIMESTAMP") - (string= extra "on update current_timestamp()")) + (when (eq (column-extra pgcol) :on-update-current-timestamp) (setf (column-extra pgcol) (make-trigger :name :on-update-current-timestamp))) + pgcol))) diff --git a/src/sources/mysql/mysql-schema.lisp b/src/sources/mysql/mysql-schema.lisp index c8d0715..4d9de20 100644 --- a/src/sources/mysql/mysql-schema.lisp +++ b/src/sources/mysql/mysql-schema.lisp @@ -117,7 +117,8 @@ tname cname (unless (or (null ccomment) (string= "" ccomment)) ccomment) - dtype ctype def-val nullable extra))) + dtype ctype def-val nullable + (normalize-extra extra)))) (add-field table field)) :finally (return schema))) diff --git a/test/mysql/my.load b/test/mysql/my.load index 1bc17d9..062b736 100644 --- a/test/mysql/my.load +++ b/test/mysql/my.load @@ -20,7 +20,10 @@ load database when (and (= 18 precision) (= 6 scale)) to "double precision" drop typemod, - type smallint when unsigned to int drop typemod + type smallint when unsigned to int drop typemod, + + type timestamp with extra on update current timestamp + to "timestamp with time zone" drop extra BEFORE LOAD DO $$ create schema if not exists mysql; $$;