Implement --summary to copy the output to a file, fix #68.

Given than redirecting a tty such as *terminal-io* isn't easy enough,
let's provide a way to copy the summary output to a file. Another way to
solve it would have been to output the summary to the main logs, but
that could have made the logs parsing more difficult that necessary.

Let's see how users like it...

pgloader.1

@@ -64,6 +64,10 @@ Minimum level of verbosity needed for log message to make it to the logfile\. On
 Minimum level of verbosity needed for log message to make it to the console\. One of critical, log, error, warning, notice, info or debug\.
 .
 .TP
+\fB\-S\fR, \fB\-\-summary\fR
+A filename where to copy the summary output\. When relative, the filename is expanded into \fB*root\-dir\fR\.
+.
+.TP
 \fB\-E\fR, \fB\-\-list\-encodings\fR
 List known encodings in this version of pgloader\.
 .

pgloader.1.md

@@ -46,6 +46,10 @@ pgloader operates from commands which are read from files:
     Minimum level of verbosity needed for log message to make it to the
     console. One of critical, log, error, warning, notice, info or debug.
 
+  * `-S`, `--summary`:
+    A filename where to copy the summary output. When relative, the filename
+    is expanded into `*root-dir`.
+
   * `-E`, `--list-encodings`:
     List known encodings in this version of pgloader.
 

src/main.lisp

@@ -25,6 +25,8 @@
     ("log-min-messages" :type string :initial-value "notice"
 			:documentation "Filter logs seen in the logfile")
 
+    (("summary" #\S) :type string :documentation "Filename where to copy the summary")
+
     (("root-dir" #\D) :type string :initial-value ,*root-dir*
                       :documentation "Output root directory.")
 
@@ -105,6 +107,17 @@
       (condition (c)
         (format t "Fatal: ~a~%" c)))))
 
+(defun parse-summary-filename (summary debug)
+  "Return the pathname where to write the summary output."
+  (when summary
+    (let* ((summary-pathname (uiop:parse-unix-namestring summary))
+           (summary-pathname (if (uiop:absolute-pathname-p summary-pathname)
+                                 summary-pathname
+                                 (uiop:merge-pathnames* summary-pathname *root-dir*)))
+           (summary-dir      (directory-namestring summary-pathname)))
+      (mkdir-or-die summary-dir debug)
+      summary-pathname)))
+
 (defun main (argv)
   "Entry point when building an executable image with buildapp"
   (let ((args (rest argv)))
@@ -118,7 +131,7 @@
 
       (destructuring-bind (&key help version quiet verbose debug logfile
 				list-encodings upgrade-config load
-				client-min-messages log-min-messages
+				client-min-messages log-min-messages summary
 				root-dir self-upgrade)
 	  options
 
@@ -212,9 +225,13 @@
                              #'(lambda (condition)
                                  (log-message :fatal "We have a situation here.")
                                  (print-backtrace condition debug *standard-output*))))
-                         (let ((truename (probe-file filename)))
+                         (let ((truename (probe-file filename))
+                               (summary-pathname
+                                (parse-summary-filename summary debug)))
                            (if truename
-                               (run-commands truename :start-logger nil)
+                               (run-commands truename
+                                             :summary summary-pathname
+                                             :start-logger nil)
                                (log-message :error "Can not find file: ~s" filename)))
                          (format t "~&"))
 

src/params.lisp

@@ -11,6 +11,7 @@
 	   #:*log-filename*
 	   #:*client-min-messages*
 	   #:*log-min-messages*
+           #:*report-stream*
 	   #:*copy-batch-rows*
            #:*copy-batch-size*
            #:*concurrent-batches*
@@ -71,6 +72,9 @@
 (defparameter *client-min-messages* :notice)
 (defparameter *log-min-messages* :info)
 
+(defparameter *report-stream* *terminal-io*
+  "Stream where to format the output stream.")
+
 ;;;
 ;;; How to split batches in case of data loading errors.
 ;;;

src/parser.lisp

@@ -2074,6 +2074,7 @@ load database
 (defun run-commands (source
 		     &key
 		       (start-logger t)
+                       ((:summary summary-pathname))
 		       ((:log-filename *log-filename*) *log-filename*)
 		       ((:log-min-messages *log-min-messages*) *log-min-messages*)
 		       ((:client-min-messages *client-min-messages*) *client-min-messages*))
@@ -2096,8 +2097,22 @@ load database
                                     (parse-commands-from-file source)
                                     (parse-commands source)))))))
 
-      ;; run the commands
-      (loop for func in funcs do (funcall func)))))
+      ;; maybe duplicate the summary to a file
+      (let* ((summary-stream (when summary-pathname
+                              (open summary-pathname
+                                    :direction :output
+                                    :if-exists :rename
+                                    :if-does-not-exist :create)))
+             (*report-stream* (apply
+                               #'make-broadcast-stream
+                               (remove-if #'null (list *terminal-io*
+                                                       summary-stream)))))
+        (unwind-protect
+             ;; run the commands
+             (loop for func in funcs do (funcall func))
+
+          ;; cleanup
+          (when summary-stream (close summary-stream)))))))
 
 
 ;;;

src/utils.lisp

@@ -161,25 +161,26 @@
 (defvar *header-cols-names* '("table name" "read" "imported" "errors" "time"))
 
 (defun report-header ()
-  (apply #'format *terminal-io* *header-cols-format* *header-cols-names*)
+  ;; (apply #'format *report-stream* *header-cols-format* *header-cols-names*)
+  (format *report-stream* "~{~}" *header-cols-format* *header-cols-names*)
   (terpri)
-  (format *terminal-io* *header-line*)
+  (format *report-stream* *header-line*)
   (terpri))
 
 (defun report-table-name (table-name)
-  (format *terminal-io* *header-tname-format* table-name))
+  (format *report-stream* *header-tname-format* table-name))
 
 (defun report-results (read rows errors seconds)
-  (format *terminal-io* *header-stats-format*
+  (format *report-stream* *header-stats-format*
           read rows errors (format-interval seconds nil))
   (terpri))
 
 (defun report-footer (legend read rows errors seconds)
   (terpri)
-  (format *terminal-io* *header-line*)
-  (apply #'format *terminal-io* *header-cols-format*
-	 (list legend read rows errors (format-interval seconds nil)))
-  (format *terminal-io* "~&")
+  (format *report-stream* *header-line*)
+  (format *report-stream* "~{~}" *header-cols-format*
+          (list legend read rows errors (format-interval seconds nil)))
+  (format *report-stream* "~&")
   (terpri))
 
 ;;;
@@ -204,7 +205,7 @@
      for pgtable = (gethash table-name (pgstate-tables pgstate))
      do
        (with-slots (read rows errs secs) pgtable
-	 (format *terminal-io* *header-cols-format*
+	 (format *report-stream* *header-cols-format*
 		 table-name read rows errs (format-interval secs nil)))
      finally (when footer
 	       (report-pgstate-stats pgstate footer))))
@@ -248,13 +249,13 @@
   (if before
       (progn
 	(report-summary :state before :footer nil)
-	(format *terminal-io* pgloader.utils::*header-line*)
+	(format *report-stream* pgloader.utils::*header-line*)
 	(report-summary :state state :header nil :footer nil))
       ;; no state before
       (report-summary :state state :footer nil))
 
   (when (or finally parallel)
-    (format *terminal-io* pgloader.utils::*header-line*)
+    (format *report-stream* pgloader.utils::*header-line*)
     (when parallel
       (report-summary :state parallel :header nil :footer nil))
     (when finally