Some code was pasted twice in src/api.lisp, and a defstruct with no slots
isn't spelled the way I did in previous patches. We use a defstruct with no
slots for defining a hierarchy on which to dispatch our pretty-print
function.
This commit is contained in:
Dimitri Fontaine 2017-08-26 20:31:24 +02:00
parent 33ab9bcdd5
commit bcc934d7aa
2 changed files with 1 additions and 148 deletions

View File

@ -23,153 +23,6 @@
"~{No such file or directory: ~s~^~% ~}"
(slot-value err 'filename-list)))))
;;;
;;; Main processing functions
;;;
(defun process-command-file (filename-list &key (flush-summary t))
"Process each FILENAME in FILENAME-LIST as a pgloader command
file (.load)."
(loop :for filename :in filename-list
:for truename := (probe-file filename)
:unless truename :collect filename :into not-found-list
:do (if truename
(run-commands truename
:start-logger nil
:flush-summary flush-summary)
(log-message :error "Can not find file: ~s" filename))
:finally (when not-found-list
(error 'load-files-not-found-error :filename-list not-found-list))))
(defun process-source-and-target (source-string target-string
&optional
type encoding set with field cast
before after)
"Given exactly 2 CLI arguments, process them as source and target URIs.
Parameters here are meant to be already parsed, see parse-cli-optargs."
(let* ((type (handler-case
(parse-cli-type type)
(condition (e)
(log-message :warning
"Could not parse --type ~s: ~a"
type e))))
(source-uri (handler-case
(if type
(parse-source-string-for-type type source-string)
(parse-source-string source-string))
(condition (e)
(log-message :warning
"Could not parse source string ~s: ~a"
source-string e))))
(type (when (and source-string
(typep source-uri 'connection))
(parse-cli-type (conn-type source-uri))))
(target-uri (handler-case
(parse-target-string target-string)
(condition (e)
(log-message :error
"Could not parse target string ~s: ~a"
target-string e)))))
;; some verbosity about the parsing "magic"
(log-message :info " SOURCE: ~s" source-string)
(log-message :info "SOURCE URI: ~s" source-uri)
(log-message :info " TARGET: ~s" target-string)
(log-message :info "TARGET URI: ~s" target-uri)
(cond ((and (null source-uri) (null target-uri))
(process-command-file (list source-string target-string)))
((or (null source-string) (null source-uri))
(log-message :fatal
"Failed to parse ~s as a source URI." source-string)
(log-message :log "You might need to use --type."))
((or (null target-string) (null target-uri))
(log-message :fatal
"Failed to parse ~s as a PostgreSQL database URI."
target-string)))
(let* ((nb-errors 0)
(options (handler-case
(parse-cli-options type with)
(condition (e)
(incf nb-errors)
(log-message :error "Could not parse --with ~s:" with)
(log-message :error "~a" e))))
(fields (handler-case
(parse-cli-fields type field)
(condition (e)
(incf nb-errors)
(log-message :error "Could not parse --fields ~s:" field)
(log-message :error "~a" e)))))
(destructuring-bind (&key encoding gucs casts before after)
(loop :for (keyword option user-string parse-fn)
:in `((:encoding "--encoding" ,encoding ,#'parse-cli-encoding)
(:gucs "--set" ,set ,#'parse-cli-gucs)
(:casts "--cast" ,cast ,#'parse-cli-casts)
(:before "--before" ,before ,#'parse-sql-file)
(:after "--after" ,after ,#'parse-sql-file))
:append (list keyword
(handler-case
(funcall parse-fn user-string)
(condition (e)
(incf nb-errors)
(log-message :error "Could not parse ~a ~s: ~a"
option user-string e)))))
(unless (= 0 nb-errors)
(error 'cli-parsing-error))
;; so, we actually have all the specs for the
;; job on the command line now.
(when (and source-uri target-uri (= 0 nb-errors))
(load-data :from source-uri
:into target-uri
:encoding encoding
:options options
:gucs gucs
:fields fields
:casts casts
:before before
:after after
:start-logger nil))))))
;;;
;;; Helper function to run a given command
;;;
(defun run-commands (source
&key
(start-logger t)
(flush-summary t)
((:summary *summary-pathname*) *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*))
"SOURCE can be a function, which is run, a list, which is compiled as CL
code then run, a pathname containing one or more commands that are parsed
then run, or a commands string that is then parsed and each command run."
(with-monitor (:start-logger start-logger)
(let* ((funcs
(typecase source
(function (list source))
(list (list (compile nil source)))
(pathname (mapcar (lambda (expr) (compile nil expr))
(parse-commands-from-file source)))
(t (mapcar (lambda (expr) (compile nil expr))
(if (probe-file source)
(parse-commands-from-file source)
(parse-commands source)))))))
(loop :for func :in funcs
:do (funcall func)
:do (when flush-summary
(flush-summary :reset t))))))
;;;
;;; Helper functions to actually do things
;;;

View File

@ -8,7 +8,7 @@
;; 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)
(defstruct (print-format-human-readable (:include print-format)
(:conc-name pf-))