From d72c711b45e472129a2d190b97051bde27ea4500 Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Sun, 27 Mar 2016 00:58:45 +0100
Subject: [PATCH] Implement support for on update CURRENT_TIMESTAMP.

That's the MySQL slang for a simple ON UPDATE trigger, and that's what
pgloader nows translate the expression to. Fix #195.
---
 src/package.lisp                        |  2 ++
 src/pgsql/schema.lisp                   | 28 +++++++++++---------
 src/sources/mysql/mysql-cast-rules.lisp | 35 ++++++++++++++++++++++++-
 3 files changed, 51 insertions(+), 14 deletions(-)

diff --git a/src/package.lisp b/src/package.lisp
index 7cfc07d..072559b 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -366,6 +366,7 @@
 	   #:create-views
 	   #:format-pgsql-column
 	   #:format-extra-type
+	   #:format-extra-triggers
 	   #:make-pgsql-fkey
 	   #:format-pgsql-create-fkey
 	   #:format-pgsql-drop-fkey
@@ -596,6 +597,7 @@
                 #:truncate-tables
 		#:format-pgsql-column
 		#:format-extra-type
+		#:format-extra-triggers
 		#:make-pgsql-fkey
 		#:format-pgsql-create-fkey
 		#:format-pgsql-drop-fkey
diff --git a/src/pgsql/schema.lisp b/src/pgsql/schema.lisp
index 768642a..112f5b8 100644
--- a/src/pgsql/schema.lisp
+++ b/src/pgsql/schema.lisp
@@ -21,24 +21,21 @@
     column, or nil of none is required. If no special extra type is ever
     needed, it's allowed not to specialize this generic into a method."))
 
-;; (defmethod format-pgsql-column ((col pgsql-column))
-;;   "Return a string representing the PostgreSQL column definition."
-;;   (let* ((column-name
-;; 	  (apply-identifier-case (pgsql-column-name col)))
-;; 	 (type-definition
-;; 	  (format nil
-;; 		  "~a~@[~a~]~:[~; not null~]~@[ default ~a~]"
-;; 		  (pgsql-column-type-name col)
-;; 		  (pgsql-column-type-mod col)
-;; 		  (pgsql-column-nullable col)
-;; 		  (pgsql-column-default col))))
-;;     (format nil "~a ~22t ~a" column-name type-definition)))
+(defgeneric format-extra-trigger (col &key include-drop)
+  (:documentation
+   "Return a list of string representing the extra SQL commands needed to
+    implement PostgreSQL triggers."))
 
 (defmethod format-extra-type ((col T) &key include-drop)
   "The default `format-extra-type' implementation returns an empty list."
   (declare (ignorable include-drop))
   nil)
 
+(defmethod format-extra-triggers ((col T) &key include-drop)
+  "The default `format-extra-triggers' implementation returns an empty list."
+  (declare (ignorable include-drop))
+  nil)
+
 
 ;;;
 ;;; API for Foreign Keys
@@ -143,13 +140,18 @@
      :for extra-types := (loop :for field :in fields
                             :append (format-extra-type
                                      field :include-drop include-drop))
+     :for extra-triggers := (loop :for field :in fields
+                               :append (format-extra-triggers
+                                        field :include-drop include-drop))
 
      :when include-drop
      :collect (drop-table-if-exists-sql table)
 
      :when extra-types :append extra-types
 
-     :collect (create-table-sql table :if-not-exists if-not-exists)))
+     :collect (create-table-sql table :if-not-exists if-not-exists)
+
+     :when extra-triggers :append extra-triggers))
 
 (defun create-table-list (table-list
                           &key
diff --git a/src/sources/mysql/mysql-cast-rules.lisp b/src/sources/mysql/mysql-cast-rules.lisp
index 2d7a7c4..0e6a31e 100644
--- a/src/sources/mysql/mysql-cast-rules.lisp
+++ b/src/sources/mysql/mysql-cast-rules.lisp
@@ -189,12 +189,45 @@
 	 (let* ((type-name
 		 (get-enum-type-name (mysql-column-table-name col)
 				     (mysql-column-name col))))
-		 (format nil "DROP TYPE IF EXISTS ~a;" type-name)))
+           (format nil "DROP TYPE IF EXISTS ~a;" type-name)))
 
        (get-create-enum (mysql-column-table-name col)
 			(mysql-column-name col)
 			(mysql-column-ctype col))))))
 
+(defmethod format-extra-triggers ((col mysql-column) &key include-drop)
+  "Return a list of string representing the extra SQL commands needed to
+   implement some MySQL features as PostgreSQL triggers, such as on update
+   CURRENT_TIMESTAMP."
+  (when (string= (mysql-column-extra col) "on update CURRENT_TIMESTAMP")
+    (let* ((col-name (apply-identifier-case (mysql-column-name col)))
+           (fun-name (format nil "on_update_current_timestamp_~a" col-name))
+           (update-fun-sql
+            (format nil "
+CREATE OR REPLACE FUNCTION ~a()
+ RETURNS TRIGGER
+LANGUAGE plpgsql
+AS $$
+BEGIN
+   NEW.~a = now();
+   RETURN NEW;
+END;
+$$;"
+                    fun-name col-name))
+           (trigger-sql
+            (format nil "
+CREATE TRIGGER on_update_current_timestamp
+ BEFORE UPDATE ON ~a
+  FOR EACH ROW EXECUTE PROCEDURE ~a();"
+                    (mysql-column-table-name col) fun-name)))
+      (append
+       (when include-drop
+         (list
+          (format nil "DROP FUNCTION IF EXISTS ~a();" fun-name)
+          (format nil "DROP TRIGGER IF EXISTS on_update_current_timestamp ON ~a;"
+                  (mysql-column-table-name col))))
+       (list update-fun-sql trigger-sql)))))
+
 (defmethod cast ((col mysql-column))
   "Return the PostgreSQL type definition from given MySQL column definition."
   (with-slots (table-name name dtype ctype default nullable extra comment)