1;;; 2;;; The main API, or an attempt at providing pgloader as a lisp usable API 3;;; rather than only an end-user program. 4;;; 5 6(in-package #:pgloader) 7 8(define-condition source-definition-error (error) 9 ((mesg :initarg :mesg :reader source-definition-error-mesg)) 10 (:report (lambda (err stream) 11 (format stream "~a" (source-definition-error-mesg err))))) 12 13(define-condition cli-parsing-error (error) () 14 (:report (lambda (err stream) 15 (declare (ignore err)) 16 (format stream "Could not parse the command line: see above.")))) 17 18(define-condition load-files-not-found-error (error) 19 ((filename-list :initarg :filename-list)) 20 (:report (lambda (err stream) 21 (format stream 22 ;; start lines with 3 spaces because of trivial-backtrace 23 "~{No such file or directory: ~s~^~% ~}" 24 (slot-value err 'filename-list))))) 25 26;;; 27;;; Helper functions to actually do things 28;;; 29(defun process-command-file (filename-list &key (flush-summary t)) 30 "Process each FILENAME in FILENAME-LIST as a pgloader command 31 file (.load)." 32 (loop :for filename :in filename-list 33 :for truename := (probe-file filename) 34 :unless truename :collect filename :into not-found-list 35 :do (if truename 36 (run-commands truename 37 :start-logger nil 38 :flush-summary flush-summary) 39 (log-message :error "Can not find file: ~s" filename)) 40 :finally (when not-found-list 41 (error 'load-files-not-found-error :filename-list not-found-list)))) 42 43(defun process-source-and-target (source-string target-string 44 &optional 45 type encoding set with field cast 46 before after) 47 "Given exactly 2 CLI arguments, process them as source and target URIs. 48Parameters here are meant to be already parsed, see parse-cli-optargs." 49 (let* ((type (handler-case 50 (parse-cli-type type) 51 (condition (e) 52 (log-message :warning 53 "Could not parse --type ~s: ~a" 54 type e)))) 55 (source-uri (handler-case 56 (if type 57 (parse-source-string-for-type type source-string) 58 (parse-source-string source-string)) 59 (condition (e) 60 (log-message :warning 61 "Could not parse source string ~s: ~a" 62 source-string e)))) 63 (type (when (and source-string 64 (typep source-uri 'connection)) 65 (parse-cli-type (conn-type source-uri)))) 66 (target-uri (handler-case 67 (parse-target-string target-string) 68 (condition (e) 69 (log-message :error 70 "Could not parse target string ~s: ~a" 71 target-string e))))) 72 73 ;; some verbosity about the parsing "magic" 74 (log-message :info " SOURCE: ~s" source-string) 75 (log-message :info "SOURCE URI: ~s" source-uri) 76 (log-message :info " TARGET: ~s" target-string) 77 (log-message :info "TARGET URI: ~s" target-uri) 78 79 (cond ((and (null source-uri) (null target-uri)) 80 (process-command-file (list source-string target-string))) 81 82 ((or (null source-string) (null source-uri)) 83 (log-message :fatal 84 "Failed to parse ~s as a source URI." source-string) 85 (log-message :log "You might need to use --type.")) 86 87 ((or (null target-string) (null target-uri)) 88 (log-message :fatal 89 "Failed to parse ~s as a PostgreSQL database URI." 90 target-string))) 91 92 (let* ((nb-errors 0) 93 (options (handler-case 94 (parse-cli-options type with) 95 (condition (e) 96 (incf nb-errors) 97 (log-message :error "Could not parse --with ~s:" with) 98 (log-message :error "~a" e)))) 99 (fields (handler-case 100 (parse-cli-fields type field) 101 (condition (e) 102 (incf nb-errors) 103 (log-message :error "Could not parse --fields ~s:" field) 104 (log-message :error "~a" e))))) 105 106 (destructuring-bind (&key encoding gucs casts before after) 107 (loop :for (keyword option user-string parse-fn) 108 :in `((:encoding "--encoding" ,encoding ,#'parse-cli-encoding) 109 (:gucs "--set" ,set ,#'parse-cli-gucs) 110 (:casts "--cast" ,cast ,#'parse-cli-casts) 111 (:before "--before" ,before ,#'parse-sql-file) 112 (:after "--after" ,after ,#'parse-sql-file)) 113 :append (list keyword 114 (handler-case 115 (funcall parse-fn user-string) 116 (condition (e) 117 (incf nb-errors) 118 (log-message :error "Could not parse ~a ~s: ~a" 119 option user-string e))))) 120 121 (unless (= 0 nb-errors) 122 (error 'cli-parsing-error)) 123 124 ;; so, we actually have all the specs for the 125 ;; job on the command line now. 126 (when (and source-uri target-uri (= 0 nb-errors)) 127 (load-data :from source-uri 128 :into target-uri 129 :encoding encoding 130 :options options 131 :gucs gucs 132 :fields fields 133 :casts casts 134 :before before 135 :after after 136 :start-logger nil)))))) 137 138 139;;; 140;;; Helper function to run a given command 141;;; 142(defun run-commands (source 143 &key 144 (start-logger t) 145 (flush-summary t) 146 ((:summary *summary-pathname*) *summary-pathname*) 147 ((:log-filename *log-filename*) *log-filename*) 148 ((:log-min-messages *log-min-messages*) *log-min-messages*) 149 ((:client-min-messages *client-min-messages*) *client-min-messages*)) 150 "SOURCE can be a function, which is run, a list, which is compiled as CL 151 code then run, a pathname containing one or more commands that are parsed 152 then run, or a commands string that is then parsed and each command run." 153 154 (with-monitor (:start-logger start-logger) 155 (let* ((*print-circle* nil) 156 (funcs 157 (typecase source 158 (function (list source)) 159 160 (list (list (compile nil source))) 161 162 (pathname (mapcar (lambda (expr) (compile nil expr)) 163 (parse-commands-from-file source))) 164 165 (t (mapcar (lambda (expr) (compile nil expr)) 166 (if (probe-file source) 167 (parse-commands-from-file source) 168 (parse-commands source))))))) 169 170 (loop :for func :in funcs 171 :do (funcall func) 172 :do (when flush-summary 173 (flush-summary :reset t)))))) 174 175 176;;; 177;;; Main API to use from outside of pgloader. 178;;; 179(defun load-data (&key ((:from source)) ((:into target)) 180 encoding fields target-table-name 181 options gucs casts before after 182 (start-logger t) (flush-summary t)) 183 "Load data from SOURCE into TARGET." 184 (declare (type connection source) 185 (type pgsql-connection target)) 186 187 (when (and (typep source (or 'csv-connection 188 'copy-connection 189 'fixed-connection)) 190 (null target-table-name) 191 (null (pgconn-table-name target))) 192 (error 'source-definition-error 193 :mesg (format nil 194 "~a data source require a table name target." 195 (conn-type source)))) 196 197 (with-monitor (:start-logger start-logger) 198 (when (and casts (not (member (type-of source) 199 '(sqlite-connection 200 mysql-connection 201 mssql-connection)))) 202 (log-message :log "Cast rules are ignored for this sources.")) 203 204 ;; now generates the code for the command 205 (log-message :debug "LOAD DATA FROM ~s" source) 206 (let* ((target-table-name (or target-table-name 207 (pgconn-table-name target))) 208 (code (lisp-code-for-loading :from source 209 :into target 210 :encoding encoding 211 :fields fields 212 :target-table-name target-table-name 213 :options options 214 :gucs gucs 215 :casts casts 216 :before before 217 :after after))) 218 (run-commands (process-relative-pathnames (uiop:getcwd) code) 219 :start-logger nil 220 :flush-summary flush-summary)))) 221 222(defvar *get-code-for-source* 223 (list (cons 'copy-connection #'lisp-code-for-loading-from-copy) 224 (cons 'fixed-connection #'lisp-code-for-loading-from-fixed) 225 (cons 'csv-connection #'lisp-code-for-loading-from-csv) 226 (cons 'dbf-connection #'lisp-code-for-loading-from-dbf) 227 (cons 'ixf-connection #'lisp-code-for-loading-from-ixf) 228 (cons 'sqlite-connection #'lisp-code-for-loading-from-sqlite) 229 (cons 'mysql-connection #'lisp-code-for-loading-from-mysql) 230 (cons 'mssql-connection #'lisp-code-for-loading-from-mssql)) 231 "Each source type might require a different set of options.") 232 233(defun lisp-code-for-loading (&key 234 ((:from source)) ((:into target)) 235 encoding fields target-table-name 236 options gucs casts before after) 237 (let ((func (cdr (assoc (type-of source) *get-code-for-source*)))) 238 ;; not all functions support the same set of &key parameters, 239 ;; they all have &allow-other-keys in their signature tho. 240 (assert (not (null func))) 241 (if func 242 (funcall func 243 source 244 target 245 :target-table-name target-table-name 246 :fields fields 247 :encoding (or encoding :default) 248 :gucs gucs 249 :casts casts 250 :options options 251 :before before 252 :after after 253 :allow-other-keys t)))) 254