mirror of
https://github.com/dimitri/pgloader.git
synced 2026-05-04 18:36:12 +02:00
Cleanup.
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:
parent
33ab9bcdd5
commit
bcc934d7aa
147
src/api.lisp
147
src/api.lisp
@ -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
|
||||
;;;
|
||||
|
||||
@ -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-))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user