diff --git a/src/package.lisp b/src/package.lisp index 813614f..387ec4f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -135,12 +135,13 @@ #:fkey-deferrable #:fkey-initially-deferred + #:trigger-p #:trigger-name #:trigger-table #:trigger-action - #:trigger-procedure-name #:trigger-procedure + #:procedure-schema #:procedure-name #:procedure-returns #:procedure-language diff --git a/src/pgsql/pgsql-ddl.lisp b/src/pgsql/pgsql-ddl.lisp index 45b123f..d3a4802 100644 --- a/src/pgsql/pgsql-ddl.lisp +++ b/src/pgsql/pgsql-ddl.lisp @@ -289,11 +289,12 @@ (defmethod format-create-sql ((trigger trigger) &key (stream nil) if-not-exists) (declare (ignore if-not-exists)) (format stream - "CREATE TRIGGER ~a ~a ON ~a FOR EACH ROW EXECUTE PROCEDURE ~a()" + "CREATE TRIGGER ~a ~a ON ~a FOR EACH ROW EXECUTE PROCEDURE ~a.~a()" (trigger-name trigger) (trigger-action trigger) (format-table-name (trigger-table trigger)) - (trigger-procedure-name trigger))) + (procedure-schema (trigger-procedure trigger)) + (procedure-name (trigger-procedure trigger)))) (defmethod format-drop-sql ((trigger trigger) &key (stream nil) cascade if-exists) (format stream @@ -310,7 +311,14 @@ (defmethod format-create-sql ((procedure procedure) &key (stream nil) if-not-exists) (declare (ignore if-not-exists)) (format stream - "CREATE OR REPLACE FUNCTION ~a() RETURNS ~a LANGUAGE ~a AS $$~%~a~%$$;" + "CREATE OR REPLACE FUNCTION ~a.~a() + RETURNS ~a + LANGUAGE ~a + AS +$$ +~a +$$;" + (procedure-schema procedure) (procedure-name procedure) (procedure-returns procedure) (procedure-language procedure) @@ -318,8 +326,11 @@ (defmethod format-drop-sql ((procedure procedure) &key (stream nil) cascade if-exists) (format stream - "DROP FUNCTION~:[~; IF EXISTS~] ~a()~@[ CASCADE~];" - if-exists (procedure-name procedure) cascade)) + "DROP FUNCTION~:[~; IF EXISTS~] ~a.~a()~@[ CASCADE~];" + if-exists + (procedure-schema procedure) + (procedure-name procedure) + cascade)) ;;; diff --git a/src/pgsql/pgsql-trigger.lisp b/src/pgsql/pgsql-trigger.lisp index 778cce0..ec4e531 100644 --- a/src/pgsql/pgsql-trigger.lisp +++ b/src/pgsql/pgsql-trigger.lisp @@ -6,60 +6,70 @@ (in-package #:pgloader.pgsql) (defvar *pgsql-triggers-procedures* - `((:on-update-current-timestamp . - ,(lambda (trigger column table) - (let ((body (format nil - "BEGIN~% NEW.~a = now();~% RETURN NEW;~%END;" - (column-name column)))) - (make-procedure :name (trigger-procedure-name trigger) - :returns "trigger" - :language "plpgsql" - :body body))))) + `((:on-update-current-timestamp + . + ,(lambda (schema proc-name column-list) + (let ((body (format nil + "~ +BEGIN + ~{NEW.~a = now();~^~% ~} + RETURN NEW; +END;" + (mapcar #'column-name column-list)))) + (make-procedure :schema schema + :name proc-name + :returns "trigger" + :language "plpgsql" + :body body))))) "List of lambdas to generate procedure definitions from pgloader internal trigger names as positioned in the internal catalogs at CAST time.") -(defun rename-trigger (trigger) - "Turn a common lisp symbol into a proper PostgreSQL trigger name." - (setf (trigger-name trigger) - (string-downcase - (cl-ppcre:regex-replace-all "-" - (symbol-name (trigger-name trigger)) - "_")))) +(defun build-trigger (trigger-symbol-name table column-list action) + "Take a synthetic TRIGGER as generated from per-source cast methods and + complete it into a proper trigger, attached on TABLE, firing on ACTION, + impacting COLUMN-LIST." + (let* ((tg-name (string-downcase + (cl-ppcre:regex-replace-all + "-" (symbol-name trigger-symbol-name) "_"))) + (proc-name (build-identifier "_" tg-name (table-name table))) + (gen-proc (cdr + (assoc trigger-symbol-name *pgsql-triggers-procedures*))) + (schema (schema-name (table-schema table))) + (proc (funcall gen-proc schema proc-name column-list))) + + ;; + ;; Build our trigger definition now: real name, action, and procedure + ;; + (make-trigger :name tg-name + :table table + :action action + :procedure proc))) (defun process-triggers (table) "Return the list of PostgreSQL statements to create a catalog trigger." - (loop :for column :in (table-column-list table) - :when (column-extra column) - :do (etypecase (column-extra column) - (trigger - ;; finish the trigger CAST and attach it to the table now - (let* ((trigger (column-extra column)) - (proc (or (trigger-procedure trigger) - ;; - ;; We have a trigger with no attached - ;; procedure, so we search for the trigger - ;; procedure-name in - ;; *pgsql-triggers-procedures* to find a - ;; lambda form to call to produce our PLpgSQL - ;; procedure - ;; - (let ((generate-proc - (cdr - (assoc (trigger-name trigger) - *pgsql-triggers-procedures*)))) - (assert (functionp generate-proc)) - (funcall generate-proc - trigger column table))))) - ;; - ;; Properly attach the procedure to the trigger and the - ;; trigger to the table. - ;; - (unless (trigger-procedure trigger) - (setf (trigger-procedure trigger) proc)) + (let ((triggers-by-name (make-hash-table))) + ;; + ;; trigger names at this stage are normalized to + ;; *pgsql-triggers-procedures* keys, like :on-update-current-timestamp + ;; our job is to transform them into proper trigger definitions + ;; + ;; note that we might have several on update column definitions on the + ;; same table, we want a single trigger that takes care of them all. + ;; + (loop :for column :in (table-column-list table) + :do (when (trigger-p (column-extra column)) + (let* ((trigger (column-extra column)) + (tg-name (trigger-name trigger))) + (push column (gethash tg-name triggers-by-name))))) - (rename-trigger trigger) - - (setf (column-extra column) nil) - - (setf (trigger-table trigger) table) - (push-to-end trigger (table-trigger-list table))))))) + ;; + ;; Now that we have a hash-table of column-list per trigger-name, build + ;; the real triggers and attach them to our table. + ;; + (loop :for tg-name :being :the :hash-keys :of triggers-by-name + :using (hash-value column-list) + :do (ecase tg-name + (:on-update-current-timestamp + (let ((trigger + (build-trigger tg-name table column-list "BEFORE UPDATE"))) + (push-to-end trigger (table-trigger-list table)))))))) diff --git a/src/sources/mysql/mysql-cast-rules.lisp b/src/sources/mysql/mysql-cast-rules.lisp index 954c4e8..af5ed4c 100644 --- a/src/sources/mysql/mysql-cast-rules.lisp +++ b/src/sources/mysql/mysql-cast-rules.lisp @@ -217,14 +217,10 @@ ;; ;; See src/pgsql/pgsql-trigger.lisp ;; - (when (string= extra "on update CURRENT_TIMESTAMP") - (let* ((pro-name (format nil - "on_update_current_timestamp_~a" - (unquote (column-name pgcol) #\")))) - (setf (column-extra pgcol) - (make-trigger :name :on-update-current-timestamp - :action "BEFORE UPDATE" - :procedure-name pro-name)))) + (when (or (string= extra "on update CURRENT_TIMESTAMP") + (string= extra "on update current_timestamp()")) + (setf (column-extra pgcol) + (make-trigger :name :on-update-current-timestamp))) pgcol))) diff --git a/src/utils/catalog.lisp b/src/utils/catalog.lisp index b2e24c7..a1ed9b5 100644 --- a/src/utils/catalog.lisp +++ b/src/utils/catalog.lisp @@ -87,9 +87,9 @@ ;;; ;;; Triggers and trigger procedures, no args support (yet?) ;;; -(defstruct trigger name table action procedure-name procedure) +(defstruct trigger name table action procedure) -(defstruct procedure name returns language body) +(defstruct procedure schema name returns language body) ;;; ;;; Main data collection API diff --git a/test/mysql/my.sql b/test/mysql/my.sql index 11b8e33..13054cf 100644 --- a/test/mysql/my.sql +++ b/test/mysql/my.sql @@ -32,7 +32,7 @@ insert into `base64`(id, data) values('65de699d-b5cc-4e13-b507-c71adea31e53', 'eyJrZXkiOiAidmFsdWUifQ=='); -CREATE TABLE `mytable` ( +CREATE TABLE `onupdate` ( `id` int(11) NOT NULL AUTO_INCREMENT, `patient_id` varchar(50) NOT NULL, `calc_date` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,