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