mirrors/pgloader
1
0
Fork 0
mirror of https://github.com/dimitri/pgloader.git synced 2025-08-10 00:07:00 +02:00
Code Issues Projects Releases Wiki Activity

Rewrite the reporting support entirely.

Browse Source 
Use a generic function protocol in order to implement the human readable,
verbose, csv, copy and json reporting output formats. This is much cleaner
and extensible than the previous way.

Use that new power to implement a real JSON output from the internal state
object.
This commit is contained in:
Dimitri Fontaine 2017-08-23 18:30:30 +02:00
parent 4fcb24f448
commit 3b93ffa37a
7 changed files with 379 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pgloader.asd
View File

@ -36,6 +36,8 @@
#:quri ; decode URI parameters
#:cl-ppcre ; Perl Compatible Regular Expressions
#:cl-mustache ; Logic-less templates
#:yason ; JSON routines
#:closer-mop ; introspection
)
:components
((:module "src"
@ -71,7 +73,9 @@
;; State, monitoring, reporting
(:file "reject" :depends-on ("state"))
(:file "pretty-print-state" :depends-on ("state"))
(:file "report" :depends-on ("state"
"pretty-print-state"
"utils"
"catalog"))
(:file "monitor" :depends-on ("logs"

10
src/package.lisp
View File

@ -191,7 +191,15 @@
(defpackage #:pgloader.state
(:use #:cl #:pgloader.params #:pgloader.catalog)
(:export #:make-pgstate
(:export #:create-state
#:make-state
#:state-preload
#:state-data
#:state-postload
#:state-secs
#:get-state-section
#:make-pgstate
#:pgstate-tabnames
#:pgstate-tables
#:pgstate-read

28
src/utils/monitor.lisp
View File

@ -21,8 +21,8 @@
(defvar *monitoring-channel* nil
"Internal lparallel channel.")
(defvar *sections* '(:pre nil :data nil :post nil)
"plist of load sections: :pre, :data and :post.")
(defvar *sections* (create-state)
"Global pgloader state, maintained by the dedicated monitor thread.")
;;;
@ -163,9 +163,7 @@
(defmacro with-monitor ((&key (start-logger t)) &body body)
"Start and stop the monitor around BODY code. The monitor is responsible
for processing logs into a central logfile"
`(let ((*sections* (list :pre (make-pgstate)
:data (make-pgstate)
:post (make-pgstate))))
`(let ((*sections* (create-state)))
(if ,start-logger
(let* ((*monitoring-queue* (lq:make-queue))
(*monitoring-channel* (start-monitor :start-logger ,start-logger)))
@ -203,9 +201,7 @@
(report-current-summary start-time)
(when (report-summary-reset event)
(setf *sections* (list :pre (make-pgstate)
:data (make-pgstate)
:post (make-pgstate)))))
(setf *sections* (create-state))))
(log-message
;; cl-log:log-message is a macro, we can't use apply
@ -219,16 +215,20 @@
(cl-log:log-message (log-message-category event) "~a" mesg)))
(new-label
(let ((label
(pgstate-new-label (getf *sections* (new-label-section event))
(new-label-label event))))
(let* ((section
(get-state-section *sections*
(new-label-section event)))
(label
(pgstate-new-label section
(new-label-label event))))
(when (eq :data (new-label-section event))
(pgtable-initialize-reject-files label
(new-label-dbname event)))))
(update-stats
(let* ((pgstate (getf *sections* (update-stats-section event)))
(let* ((pgstate (get-state-section *sections*
(update-stats-section event)))
(label (update-stats-label event))
(table (pgstate-new-label pgstate label)))
@ -300,8 +300,8 @@
:if-exists :rename
:if-does-not-exist :create)))
(*report-stream* (or summary-stream *standard-output*)))
(report-full-summary "Total import time"
*sections*
(report-full-summary *sections*
"Total import time"
(elapsed-time-since start-time))
(when summary-stream (close summary-stream))))

312
src/utils/pretty-print-state.lisp Normal file
View File

@ -0,0 +1,312 @@
;;;
;;; Pretty print a report while doing bulk operations
;;;
(in-package :pgloader.state)
;;
;; define a tree of print format so that we can generalize some methods on
;; any “data” type format or any “human readable” print format.
;;
(defstruct print-format ())
(defstruct (print-format-human-readable (:include print-format)
(:conc-name pf-))
(legend nil :type (or null string))
(max-label-length 1 :type fixnum))
(defstruct (print-format-text (:include print-format-human-readable)))
(defstruct (print-format-verbose (:include print-format-human-readable)))
(defstruct (print-format-tab (:include print-format)))
(defstruct (print-format-csv (:include print-format-tab)))
(defstruct (print-format-copy (:include print-format-tab)))
(defstruct (print-format-json (:include print-format)))
(defgeneric pretty-print (stream state format &key))
;;;
;;; The pretty-print methods for data and human readable formats for a
;;; global state are a “shell” that calls into the more specialized version,
;;; for pgstate then pgtable.
;;;
(defmethod pretty-print ((stream stream)
(state state)
(format print-format-tab)
&key)
(loop :for pgstate :in (list (state-preload state)
(state-data state)
(state-postload state))
:do (pretty-print stream pgstate format)))
(defmethod pretty-print ((stream stream)
(state state)
(format print-format-json)
&key)
(yason:encode state stream))
(defmethod pretty-print ((stream stream)
(state state)
(format print-format-human-readable)
&key)
(when (and (state-preload state) (pgstate-tabnames (state-preload state)))
(pretty-print *report-stream*
(state-preload state)
format
:header t
:footer nil
:extra-sep-line t))
(pretty-print *report-stream*
(state-data state)
format
:header (not (and (state-preload state)
(pgstate-tabnames (state-preload state))))
:footer (unless (and (state-postload state)
(pgstate-tabnames (state-postload state)))
(pf-legend format))
:extra-sep-line t)
(when (and (state-postload state) (pgstate-tabnames (state-postload state)))
(pretty-print *report-stream*
(state-postload state)
format
:header nil
:footer (pf-legend format))))
;;;
;;; Support for TEXT format, human readable
;;;
(defmethod pretty-print ((stream stream)
(pgstate pgstate)
(format print-format-text)
&key
header
footer
extra-sep-line)
(let* ((max-len (pf-max-label-length format))
(col-label (make-string max-len :initial-element #\-))
(col-sep (make-string 9 :initial-element #\-))
(col-long-sep (make-string 14 :initial-element #\-))
(sep-line (format nil
"~&~v@a ~9@a ~9@a ~9@a ~14@a~%"
max-len
col-label col-sep col-sep col-sep col-long-sep)))
(when header
(format stream
"~&~v@a ~9@a ~9@a ~9@a ~14@a~%"
max-len
"table name" "read" "imported" "errors" "total time")
(format stream sep-line))
(loop
:for label :in (reverse (pgstate-tabnames pgstate))
:for pgtable := (gethash label (pgstate-tables pgstate))
:do (let ((legend (etypecase label
(string label)
(table (format-table-name label)))))
(pretty-print stream pgtable format
:legend legend
:max-label-length max-len)))
(cond (extra-sep-line
(format stream sep-line))
(footer
(with-slots (tabnames read rows errs secs) pgstate
(when tabnames
(format stream sep-line)
(format stream
"~&~v@a ~9@a ~9@a ~9@a ~14@a~%"
max-len
footer read rows errs
(format-interval secs nil))))))))
(defmethod pretty-print ((stream stream)
(pgtable pgtable)
(format print-format-text)
&key legend max-label-length)
(with-slots (read rows errs secs rs ws) pgtable
(format stream
"~&~v@a ~9@a ~9@a ~9@a ~14@a~%"
max-label-length
legend
read
rows
errs
(format-interval-guess secs rs ws))))
;;;
;;; Support for VERBOSE format, human readable
;;;
(defmethod pretty-print ((stream stream)
(pgstate pgstate)
(format print-format-verbose)
&key
header
footer
extra-sep-line)
(let* ((max-len (pf-max-label-length format))
(col-label (make-string max-len :initial-element #\-))
(col-sep (make-string 9 :initial-element #\-))
(col-long-sep (make-string 14 :initial-element #\-))
(sep-line (format nil
"~&~v@a ~9@a ~9@a ~9@a ~14@a ~9@a ~9@a~%"
max-len col-label
col-sep col-sep col-sep
col-long-sep col-sep col-sep)))
(when header
(format stream
"~&~v@a ~9@a ~9@a ~9@a ~14@a ~9@a ~9@a~%"
max-len
"table name" "read" "imported" "errors" "total time" "read" "write")
(format stream sep-line))
(loop
:for label :in (reverse (pgstate-tabnames pgstate))
:for pgtable := (gethash label (pgstate-tables pgstate))
:do (let ((legend (etypecase label
(string label)
(table (format-table-name label)))))
(pretty-print stream pgtable format
:legend legend
:max-label-length max-len)))
(cond (extra-sep-line
(format stream sep-line))
(footer
(with-slots (tabnames read rows errs secs rs ws) pgstate
(when tabnames
(format stream sep-line)
(format stream
"~&~v@a ~9@a ~9@a ~9@a ~14@a ~@[~9@a~] ~@[~9@a~]~%"
max-len
footer read rows errs
(format-interval secs nil)
(when (and rs (/= rs 0.0))
(format-interval rs nil))
(when (and ws (/= ws 0.0))
(format-interval ws nil)))))))))
(defmethod pretty-print ((stream stream)
(pgtable pgtable)
(format print-format-verbose)
&key legend max-label-length)
(with-slots (read rows errs secs rs ws) pgtable
(format stream
"~&~v@a ~9@a ~9@a ~9@a ~14@a ~@[~9@a~] ~@[~9@a~]~%"
max-label-length
legend
read
rows
errs
(format-interval-guess secs rs ws)
(when (and rs (/= rs 0.0)) (format-interval rs nil))
(when (and ws (/= ws 0.0)) (format-interval ws nil)))))
;;;
;;; Support for CSV format
;;;
(defmethod pretty-print ((stream stream)
(pgstate pgstate)
(format print-format-csv)
&key)
(loop
:for label :in (reverse (pgstate-tabnames pgstate))
:for pgtable := (gethash label (pgstate-tables pgstate))
:do (let ((legend (etypecase label
(string label)
(table (format-table-name label)))))
(pretty-print stream pgtable format :legend legend))))
(defmethod pretty-print ((stream stream)
(pgtable pgtable)
(format print-format-csv)
&key legend)
(with-slots (read rows errs secs rs ws) pgtable
(format stream
"~&~s;~s;~s;~s;~s"
legend
read
rows
errs
(format-interval-guess secs rs ws))))
;;;
;;; Support for COPY format
;;;
(defmethod pretty-print ((stream stream)
(pgstate pgstate)
(format print-format-copy)
&key)
(loop
:for label :in (reverse (pgstate-tabnames pgstate))
:for pgtable := (gethash label (pgstate-tables pgstate))
:do (let ((legend (etypecase label
(string label)
(table (format-table-name label)))))
(pretty-print stream pgtable format :legend legend))))
(defmethod pretty-print ((stream stream)
(pgtable pgtable)
(format print-format-copy)
&key legend)
(with-slots (read rows errs secs rs ws) pgtable
(format stream
"~&~a ~s ~s ~s ~s"
legend
read
rows
errs
(format-interval-guess secs rs ws))))
;;;
;;; In the main output format, guess what's the real time spent when we
;;; don't have it.
;;;
(defun format-interval-guess (secs rs ws)
(cond ((> 0 secs) (format-interval secs nil))
((and rs ws (= 0 secs)) (format-interval (max rs ws) nil))
(t (format-interval secs nil))))
;;;
;;; Have yason output JSON formated output, straight from our instances.
;;;
(defmacro define-yason-encoder (class)
"Define a new yason:encode method for CLASS."
`(defmethod yason:encode ((instance ,class)
&optional (stream *standard-output*))
"Encode an EXTENSION object into JSON."
(yason:with-output (stream)
(yason:with-object ()
(loop :for slot :in (closer-mop:compute-slots ,class)
:for slot-name := (closer-mop:slot-definition-name slot)
:do (unless (member slot-name '(reject-data reject-logs))
(yason:encode-object-element
(string slot-name)
(slot-value instance slot-name))))))))
(define-yason-encoder #. (find-class 'state))
(define-yason-encoder #. (find-class 'pgtable))
(defmethod yason:encode ((pgstate pgstate) &optional (stream *standard-output*))
"Output catalog tables by name only, don't recurse into the catalog..."
(yason:with-output (stream)
(yason:with-array ()
(yason:encode-array-element
(loop :for label :in (reverse (pgstate-tabnames pgstate))
:for pgtable := (gethash label (pgstate-tables pgstate))
:collect pgtable)))))
(defmethod yason:encode ((table table) &optional (stream *standard-output*))
(yason:with-output (stream)
(yason:encode (format-table-name table))))

2
src/utils/reject.lisp
View File

@ -12,7 +12,7 @@
(defun %process-bad-row (table-name condition row)
"Add the row to the reject file, in PostgreSQL COPY TEXT format"
;; first, update the stats.
(let ((state (getf *sections* :data)))
(let ((state (get-state-section *sections* :data)))
(pgstate-incf state table-name :errs 1)
;; now, the bad row processing

214
src/utils/report.lisp
View File

@ -4,76 +4,6 @@
(in-package :pgloader.state)
(defvar *header-line*
"~&~v@{~A~:*~} --------- --------- --------- -------------- --------- ---------")
(defvar *header* "~&")
(defvar *footer* "~&")
(defvar *end-of-line-format* "~%")
(defvar *max-length-table-name* 30)
(defvar *header-tname-format* "~&~v@a")
(defvar *header-stats-format* " ~9@a ~9@a ~9@a ~14@a ~@[~9@a~] ~@[~9@a~]")
(defvar *header-cols-format* (concatenate 'string *header-tname-format*
*header-stats-format*))
(defvar *header-cols-names* '("table name" "read" "imported" "errors" "time"))
(defvar *header-format-strings*
'((:human-readable
(:header "~&"
:footer "~%"
:end-of-line-format "~%"
:header-line "~&~v@{~A~:*~} --------- --------- --------- --------------"
:header-tname-format "~&~v@a"
:header-stats-format " ~9@a ~9@a ~9@a ~14@a ~*~*"
:header-cols-format "~&~v@a ~9@a ~9@a ~9@a ~14@a"
:header-cols-names ("table name" "read" "imported" "errors" "total time")))
(:human-readable-verbose
(:header "~&"
:footer "~%"
:end-of-line-format "~%"
:header-line "~&~v@{~A~:*~} --------- --------- --------- -------------- --------- ---------"
:header-tname-format "~&~v@a"
:header-stats-format " ~9@a ~9@a ~9@a ~14@a ~:[~9<~>~;~:*~9@a~] ~:[~9<~>~;~:*~9@a~]"
:header-cols-format "~&~v@a ~9@a ~9@a ~9@a ~14@a ~9@a ~9@a"
:header-cols-names ("table name" "read" "imported" "errors"
"total time" "read" "write")))
(:csv
(:header "~&"
:footer "~%"
:end-of-line-format "~%"
:header-line "~*~*"
:header-tname-format "~&~*~s;"
:header-stats-format "~s;~s;~s;~s~*~*"
:header-cols-format "~&~*~s;~s;~s;~s;~s"
:header-cols-names ("table name" "read" "imported" "errors" "time")))
(:copy
(:header "~&"
:footer "~%"
:end-of-line-format "~%"
:header-line "~&~*~*"
:header-tname-format "~&~*~a "
:header-stats-format "~s ~s ~s ~s~*~*"
:header-cols-format "~*~*~*~*~*~*" ; skip it
:header-cols-names ("table name" "read" "imported" "errors" "time")))
(:json
(:header "~&["
:footer "~&]~%"
:end-of-line-format ",~%"
:header-line "~&~*~*"
:header-tname-format "~& {\"table-name\": ~*~s,"
:header-stats-format "\"read\":~s,\"imported\":~s,\"errors\":~s,\"time\":~s~@[,\"read\":~s~]~@[,\"write\":~s~]}"
:header-cols-format "~*~*~*~*~*~*" ; skip it
:header-cols-names ("table name" "read" "imported" "errors" "time")))))
(defun get-format-for (type key)
"Return the format string to use for a given TYPE of output and KEY."
(getf (cadr (assoc type *header-format-strings*)) key))
;;;
;;; Timing Formating
;;;
@ -96,92 +26,18 @@
q)
secs)))))
;;;
;;; Pretty printing reports in several formats
;;;
(defun report-header ()
;; (apply #'format *report-stream* *header-cols-format* *header-cols-names*)
(format *report-stream*
"~{~}"
*header-cols-format*
(list* *max-length-table-name*
*header-cols-names*))
(format *report-stream* *header-line* *max-length-table-name* "-"))
(defun report-table-name (table-name)
(format *report-stream*
*header-tname-format*
*max-length-table-name* table-name))
(defun report-results (read rows errors seconds rs ws &optional (eol t))
(format *report-stream* *header-stats-format* read rows errors seconds rs ws)
(when eol
(format *report-stream* *end-of-line-format*)))
(defun report-footer (legend read rows errors seconds &optional rs ws)
(format *report-stream* *header-line* *max-length-table-name* "-")
(format *report-stream*
"~{~}"
*header-tname-format*
(list* *max-length-table-name*
(list legend)))
(report-results read rows errors
(format-interval seconds nil)
(when (and rs (not (= rs 0.0))) (format-interval rs nil))
(when (and ws (not (= rs 0.0))) (format-interval ws nil))
nil)
(format *report-stream* *footer*))
;;;
;;; Pretty print a report from a pgtable and pgstats counters
;;;
(defun report-pgtable-stats (pgstate name)
(with-slots (read rows errs secs rs ws) (pgstate-get-label pgstate name)
(report-results read rows errs
(format-interval secs nil)
(when (and rs (not (= rs 0.0))) (format-interval rs nil))
(when (and ws (not (= ws 0.0))) (format-interval ws nil)))))
(defun report-pgstate-stats (pgstate legend)
(with-slots (tabnames read rows errs secs rs ws) pgstate
(when tabnames
(report-footer legend read rows errs secs rs ws))))
;;;
;;; Pretty print the whole summary from a state
;;;
(defun report-summary (pgstate &key (header t) footer)
"Report a whole summary."
(when header (report-header))
(loop
:for label :in (reverse (pgstate-tabnames pgstate))
:for pgtable := (gethash label (pgstate-tables pgstate))
:do (with-slots (read rows errs secs rs ws) pgtable
(format *report-stream*
*header-tname-format*
*max-length-table-name*
(etypecase label
(string label)
(table (format-table-name label))))
(report-results read rows errs
(cond ((> 0 secs) (format-interval secs nil))
((and rs ws (= 0 secs))
(format-interval (max rs ws) nil))
(t (format-interval secs nil)))
(when (and rs (not (= rs 0.0))) (format-interval rs nil))
(when (and ws (not (= ws 0.0))) (format-interval ws nil))))
:finally (when footer
(report-pgstate-stats pgstate footer))))
(defun parse-summary-type (&optional (pathname *summary-pathname*))
"Return the summary type we want: human-readable, csv, json."
(when pathname
(cond ((string= "csv" (pathname-type pathname)) :csv)
((string= "json" (pathname-type pathname)) :json)
((string= "copy" (pathname-type pathname)) :copy)
(t :human-readable))))
(if pathname
(cond ((string= "csv" (pathname-type pathname)) 'print-format-csv)
((string= "json" (pathname-type pathname)) 'print-format-json)
((string= "copy" (pathname-type pathname)) 'print-format-copy))
(if (member *client-min-messages*
'(:notice :sql :info :debug :data))
'print-format-verbose
'print-format-text)))
(defun max-length-table-name (legend data pre post)
(defun max-length-table-name (state legend)
"Compute the max length of a table-name in the legend."
(reduce #'max
(mapcar #'length
@ -189,51 +45,25 @@
(etypecase entry
(string entry)
(table (format-table-name entry))))
(append (pgstate-tabnames data)
(pgstate-tabnames pre)
(pgstate-tabnames post)
(append (pgstate-tabnames (state-data state))
(pgstate-tabnames (state-preload state))
(pgstate-tabnames (state-postload state))
(list legend))))
:initial-value 0))
(defun report-full-summary (legend sections total-secs)
(defun report-full-summary (state legend total-secs)
"Report the full story when given three different sections of reporting."
(let* ((ftype (parse-summary-type *summary-pathname*))
(format (make-instance ftype))
(max-label-length (max-length-table-name state legend)))
(let* ((data (getf sections :data))
(pre (getf sections :pre))
(post (getf sections :post))
(stype (or (parse-summary-type *summary-pathname*)
(if (member *client-min-messages*
'(:notice :sql :info :debug :data))
:human-readable-verbose
:human-readable)))
(*header* (get-format-for stype :header))
(*footer* (get-format-for stype :footer))
(*end-of-line-format* (get-format-for stype :end-of-line-format))
(*header-line* (get-format-for stype :header-line))
(*max-length-table-name* (max-length-table-name legend data pre post))
(*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))
(*header-cols-names* (get-format-for stype :header-cols-names)))
(when *header*
(format *report-stream* *header*))
(when (and pre (pgstate-tabnames pre))
(report-summary pre :footer nil)
(format *report-stream* *header-line* *max-length-table-name* "-"))
(report-summary data :header (null pre) :footer nil)
(when (and post (pgstate-tabnames post))
(format *report-stream* *header-line* *max-length-table-name* "-")
(report-summary post :header nil :footer nil))
(when (typep format 'print-format-human-readable)
(setf (pf-max-label-length format) max-label-length)
(setf (pf-legend format) legend))
;; replace the grand total now
(setf (pgstate-secs data) total-secs)
(setf (state-secs state) total-secs)
(setf (pgstate-secs (state-data state)) total-secs)
;; and report the Grand Total
(report-pgstate-stats data legend)))
(pretty-print *report-stream* state format)))

17
src/utils/state.lisp
View File

@ -32,6 +32,23 @@
(ws 0.0 :type float)
(bytes 0 :type fixnum))
(defstruct state
(preload nil :type (or null pgstate))
(data nil :type (or null pgstate))
(postload nil :type (or null pgstate))
(secs 0.0 :type float))
(defun create-state ()
(make-state :preload (make-pgstate)
:data (make-pgstate)
:postload (make-pgstate)))
(defun get-state-section (state section)
(ecase section
(:pre (state-preload state))
(:data (state-data state))
(:post (state-postload state))))
(defun relative-pathname (filename type &optional dbname)
"Return the pathname of a file of type TYPE (dat or log) under *ROOT-DIR*"
(let ((dir (if dbname