;;; ;;; The main API, or an attempt at providing pgloader as a lisp usable API ;;; rather than only an end-user program. ;;; (in-package #:pgloader) (define-condition source-definition-error (error) ((mesg :initarg :mesg :reader source-definition-error-mesg)) (:report (lambda (err stream) (format stream "~a" (source-definition-error-mesg err))))) (define-condition cli-parsing-error (error) () (:report (lambda (err stream) (declare (ignore err)) (format stream "Could not parse the command line: see above.")))) (define-condition load-files-not-found-error (error) ((filename-list :initarg :filename-list)) (:report (lambda (err stream) (format stream ;; start lines with 3 spaces because of trivial-backtrace "~{No such file or directory: ~s~^~% ~}" (slot-value err 'filename-list))))) ;;; ;;; Helper functions to actually do things ;;; (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* ((*print-circle* nil) (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)))))) ;;; ;;; Main API to use from outside of pgloader. ;;; (defun load-data (&key ((:from source)) ((:into target)) encoding fields target-table-name options gucs casts before after (start-logger t) (flush-summary t)) "Load data from SOURCE into TARGET." (declare (type connection source) (type pgsql-connection target)) (when (and (typep source (or 'csv-connection 'copy-connection 'fixed-connection)) (null target-table-name) (null (pgconn-table-name target))) (error 'source-definition-error :mesg (format nil "~a data source require a table name target." (conn-type source)))) (with-monitor (:start-logger start-logger) (when (and casts (not (member (type-of source) '(sqlite-connection mysql-connection mssql-connection)))) (log-message :log "Cast rules are ignored for this sources.")) ;; now generates the code for the command (log-message :debug "LOAD DATA FROM ~s" source) (let* ((target-table-name (or target-table-name (pgconn-table-name target))) (code (lisp-code-for-loading :from source :into target :encoding encoding :fields fields :target-table-name target-table-name :options options :gucs gucs :casts casts :before before :after after))) (run-commands (process-relative-pathnames (uiop:getcwd) code) :start-logger nil :flush-summary flush-summary)))) (defvar *get-code-for-source* (list (cons 'copy-connection #'lisp-code-for-loading-from-copy) (cons 'fixed-connection #'lisp-code-for-loading-from-fixed) (cons 'csv-connection #'lisp-code-for-loading-from-csv) (cons 'dbf-connection #'lisp-code-for-loading-from-dbf) (cons 'ixf-connection #'lisp-code-for-loading-from-ixf) (cons 'sqlite-connection #'lisp-code-for-loading-from-sqlite) (cons 'mysql-connection #'lisp-code-for-loading-from-mysql) (cons 'mssql-connection #'lisp-code-for-loading-from-mssql) (cons 'pgsql-connection #'lisp-code-for-loading-from-pgsql)) "Each source type might require a different set of options.") (defun lisp-code-for-loading (&key ((:from source)) ((:into target)) encoding fields target-table-name options gucs casts before after) (let ((func (cdr (assoc (type-of source) *get-code-for-source*)))) ;; not all functions support the same set of &key parameters, ;; they all have &allow-other-keys in their signature tho. (assert (not (null func))) (if func (funcall func source target :target-table-name target-table-name :fields fields :encoding (or encoding :default) :gucs gucs :casts casts :options options :before before :after after :allow-other-keys t))))