diff --git a/src/package.lisp b/src/package.lisp index e1172b3..838fb8b 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -59,6 +59,7 @@ #:unquote ;; state + #:format-table-name #:make-pgstate #:pgstate-get-table #:pgstate-add-table diff --git a/src/parsers/command-copy.lisp b/src/parsers/command-copy.lisp index a68510d..1cafdbe 100644 --- a/src/parsers/command-copy.lisp +++ b/src/parsers/command-copy.lisp @@ -121,7 +121,7 @@ (make-instance 'pgloader.copy:copy-copy :target-db ,pg-db-conn :source source-db - :target ,(pgconn-table-name pg-db-conn) + :target ',(pgconn-table-name pg-db-conn) :encoding ,encoding :fields ',fields :columns ',columns diff --git a/src/parsers/command-csv.lisp b/src/parsers/command-csv.lisp index a0024f8..d52b85c 100644 --- a/src/parsers/command-csv.lisp +++ b/src/parsers/command-csv.lisp @@ -440,7 +440,7 @@ (make-instance 'pgloader.csv:copy-csv :target-db ,pg-db-conn :source source-db - :target ,(pgconn-table-name pg-db-conn) + :target ',(pgconn-table-name pg-db-conn) :encoding ,encoding :fields ',fields :columns ',columns diff --git a/src/parsers/command-db-uri.lisp b/src/parsers/command-db-uri.lisp index 710e79f..0cf4768 100644 --- a/src/parsers/command-db-uri.lisp +++ b/src/parsers/command-db-uri.lisp @@ -113,7 +113,7 @@ maybe-quoted-namestring) (:destructure (schema dot table) (declare (ignore dot)) - (format nil "~a.~a" (text schema) (text table)))) + (cons (text schema) (text table)))) (defrule dsn-table-name (or qualified-table-name maybe-quoted-namestring) (:lambda (name) diff --git a/src/parsers/command-fixed.lisp b/src/parsers/command-fixed.lisp index 88d11b3..dd2aa08 100644 --- a/src/parsers/command-fixed.lisp +++ b/src/parsers/command-fixed.lisp @@ -140,7 +140,7 @@ (make-instance 'pgloader.fixed:copy-fixed :target-db ,pg-db-conn :source source-db - :target ,(pgconn-table-name pg-db-conn) + :target ',(pgconn-table-name pg-db-conn) :encoding ,encoding :fields ',fields :columns ',columns diff --git a/src/pgsql/pgsql.lisp b/src/pgsql/pgsql.lisp index 0895a5e..f66ea49 100644 --- a/src/pgsql/pgsql.lisp +++ b/src/pgsql/pgsql.lisp @@ -54,20 +54,31 @@ (truncate-tables pgconn (list table-name))) (with-pgsql-connection (pgconn) - (when disable-triggers (disable-triggers table-name)) - (log-message :info "pgsql:copy-from-queue: ~a ~a" table-name columns) - (loop - for (mesg batch read oversized?) = (lq:pop-queue queue) - until (eq mesg :end-of-data) - for rows = (copy-batch table-name columns batch read) - do (progn - ;; The SBCL implementation needs some Garbage Collection - ;; decision making help... and now is a pretty good time. - #+sbcl (when oversized? (sb-ext:gc :full t)) - (log-message :debug "copy-batch ~a ~d row~:p~:[~; [oversized]~]" - table-name rows oversized?) - (pgstate-incf *state* table-name :rows rows))) - (when disable-triggers (enable-triggers table-name)))) + (let ((unqualified-table-name + (typecase table-name + (cons (let ((sql (format nil "SET search_path TO ~a;" + (car table-name)))) + (log-message :notice "~a" sql) + (pgsql-execute sql) + (cdr table-name))) + (string table-name)))) + + (when disable-triggers (disable-triggers unqualified-table-name)) + (log-message :info "pgsql:copy-from-queue: ~a ~a" table-name columns) + + (loop + for (mesg batch read oversized?) = (lq:pop-queue queue) + until (eq mesg :end-of-data) + for rows = (copy-batch unqualified-table-name columns batch read) + do (progn + ;; The SBCL implementation needs some Garbage Collection + ;; decision making help... and now is a pretty good time. + #+sbcl (when oversized? (sb-ext:gc :full t)) + (log-message :debug "copy-batch ~a ~d row~:p~:[~; [oversized]~]" + unqualified-table-name rows oversized?) + (pgstate-incf *state* table-name :rows rows))) + + (when disable-triggers (enable-triggers unqualified-table-name))))) ;;; ;;; When a batch has been refused by PostgreSQL with a data-exception, that diff --git a/src/pgsql/schema.lisp b/src/pgsql/schema.lisp index 7d8f5bf..4e5755c 100644 --- a/src/pgsql/schema.lisp +++ b/src/pgsql/schema.lisp @@ -230,11 +230,18 @@ (defun truncate-tables (pgconn table-name-list) "Truncate given TABLE-NAME in database DBNAME" (with-pgsql-transaction (:pgconn pgconn) - (let ((sql (format nil "TRUNCATE ~{~a~^,~};" - (loop :for table-name :in table-name-list - :collect (apply-identifier-case table-name))))) - (log-message :notice "~a" sql) - (pomo:execute sql)))) + (flet ((process-table-name (table-name) + (typecase table-name + (cons + (format nil "~a.~a" + (apply-identifier-case (car table-name)) + (apply-identifier-case (cdr table-name)))) + (string + (apply-identifier-case table-name))))) + (let ((sql (format nil "TRUNCATE ~{~a~^,~};" + (mapcar #'process-table-name table-name-list)))) + (log-message :notice "~a" sql) + (pomo:execute sql))))) (defun disable-triggers (table-name) "Disable triggers on TABLE-NAME. Needs to be called with a PostgreSQL diff --git a/src/utils/report.lisp b/src/utils/report.lisp index b68fa25..73a8007 100644 --- a/src/utils/report.lisp +++ b/src/utils/report.lisp @@ -117,7 +117,7 @@ (format *report-stream* *header-tname-format* *max-length-table-name* - table-name) + (format-table-name table-name)) (report-results read rows errs (format-interval secs nil))) finally (when footer (report-pgstate-stats pgstate footer)))) @@ -171,11 +171,12 @@ (*max-length-table-name* (reduce #'max (mapcar #'length - (append (pgstate-tabnames state) - (when before (pgstate-tabnames before)) - (when finally (pgstate-tabnames finally)) - (when parallel (pgstate-tabnames parallel)) - (list legend))))) + (mapcar #'format-table-name + (append (pgstate-tabnames state) + (when before (pgstate-tabnames before)) + (when finally (pgstate-tabnames finally)) + (when parallel (pgstate-tabnames parallel)) + (list legend)))))) (*header-tname-format* (get-format-for stype :header-tname-format)) (*header-stats-format* (get-format-for stype :header-stats-format)) (*header-cols-format* (get-format-for stype :header-cols-format)) diff --git a/src/utils/state.lisp b/src/utils/state.lisp index a656d6b..eec5afd 100644 --- a/src/utils/state.lisp +++ b/src/utils/state.lisp @@ -24,6 +24,12 @@ (errs 0 :type fixnum) (secs 0.0 :type float)) +(defun format-table-name (table-name) + "TABLE-NAME might be a CONS of a schema name and a table name." + (typecase table-name + (cons (format nil "~a.~a" (car table-name) (cdr table-name))) + (string table-name))) + (defun pgstate-get-table (pgstate name) (gethash name (pgstate-tables pgstate))) @@ -32,11 +38,12 @@ (or (pgstate-get-table pgstate table-name) (let* ((table (setf (gethash table-name (pgstate-tables pgstate)) (make-pgtable :name table-name))) - (reject-dir (merge-pathnames (format nil "~a/" dbname) *root-dir*)) + (reject-dir (merge-pathnames (format nil "~a/" dbname) *root-dir*)) + (filename (format-table-name table-name)) (data-pathname (make-pathname :defaults reject-dir - :name table-name :type "dat")) + :name filename :type "dat")) (logs-pathname (make-pathname :defaults reject-dir - :name table-name :type "log"))) + :name filename :type "log"))) ;; maintain the ordering (push table-name (pgstate-tabnames pgstate))