mirrors/pgloader
1
0
Fork 0
mirror of https://github.com/dimitri/pgloader.git synced 2026-02-05 14:31:41 +01:00
Code Issues Projects Releases Wiki Activity

Implement support for new casting rules guards and actions.

Browse Source 
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.
This commit is contained in:
Dimitri Fontaine 2018-01-31 15:17:05 +01:00
parent 5ecd03ceba
commit 4612e68435
7 changed files with 70 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/parsers/command-cast-rules.lisp
View File

@ -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

7
src/parsers/command-keywords.lisp
View File

@ -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"))

1
src/pgsql/pgsql-create-schema.lisp
View File

@ -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)))

29
src/sources/common/casting-rules.lisp
View File

@ -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

13
src/sources/mysql/mysql-cast-rules.lisp
View File

@ -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)))

3
src/sources/mysql/mysql-schema.lisp
View File

@ -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)))

5
test/mysql/my.load
View File

@ -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; $$;