mirror of
https://github.com/dimitri/pgloader.git
synced 2025-08-08 23:37:00 +02:00
302a7d402b
That's the big refactoring patch I've been sitting on for too long. First, refactor connection handling to use a uniformed "connection" concept (class and generic functions API) everywhere, so that the COPY derived objects just use that in their :source-db and :target-db slots. Given that, we don't need no messing around with *pgconn* and *myconn-* and other special variables at all anywhere in the tree. Second, clean up some oddities accumulated over time, where some parts of the code didn't get the memo when new API got into place. Third, fix any other oddity or missing part found while doing those first two activities, it was long overdue anyway...
166 lines
6.3 KiB
Common Lisp
166 lines
6.3 KiB
Common Lisp
;;;
|
||
;;; Parse the pgloader commands grammar
|
||
;;;
|
||
|
||
(in-package :pgloader.parser)
|
||
|
||
;;;
|
||
;;; INCLUDING ONLY and EXCLUDING clauses for MS SQL
|
||
;;;
|
||
;;; There's no regexp matching on MS SQL, so we're going to just use the
|
||
;;; classic LIKE support here, as documented at:
|
||
;;;
|
||
;;; http://msdn.microsoft.com/en-us/library/ms187489(SQL.90).aspx
|
||
;;;
|
||
(defrule like-expression (and "'" (+ (not "'")) "'")
|
||
(:lambda (le)
|
||
(bind (((_ like _) le)) (text like))))
|
||
|
||
(defrule another-like-expression (and comma like-expression)
|
||
(:lambda (source)
|
||
(bind (((_ like) source)) like)))
|
||
|
||
(defrule filter-list-like (and like-expression (* another-like-expression))
|
||
(:lambda (source)
|
||
(destructuring-bind (filter1 filters) source
|
||
(list* filter1 filters))))
|
||
|
||
(defrule including-in-schema
|
||
(and kw-including kw-only kw-table kw-names kw-like filter-list-like
|
||
kw-in kw-schema quoted-namestring)
|
||
(:lambda (source)
|
||
(bind (((_ _ _ _ _ filter-list _ _ schema) source))
|
||
(cons schema filter-list))))
|
||
|
||
(defrule including-like (and including-in-schema (* including-in-schema))
|
||
(:lambda (source)
|
||
(destructuring-bind (inc1 incs) source
|
||
(cons :including (list* inc1 incs)))))
|
||
|
||
(defrule excluding-in-schema
|
||
(and kw-excluding kw-table kw-names kw-like filter-list-like
|
||
kw-in kw-schema quoted-namestring)
|
||
(:lambda (source)
|
||
(bind (((_ _ _ _ filter-list _ _ schema) source))
|
||
(cons schema filter-list))))
|
||
|
||
(defrule excluding-like (and excluding-in-schema (* excluding-in-schema))
|
||
(:lambda (source)
|
||
(destructuring-bind (excl1 excls) source
|
||
(cons :excluding (list* excl1 excls)))))
|
||
|
||
|
||
;;;
|
||
;;; Allow clauses to appear in any order
|
||
;;;
|
||
(defrule load-mssql-optional-clauses (* (or mysql-options
|
||
gucs
|
||
casts
|
||
before-load
|
||
after-load
|
||
including-like
|
||
excluding-like))
|
||
(:lambda (clauses-list)
|
||
(alexandria:alist-plist clauses-list)))
|
||
|
||
(defrule mssql-prefix "mssql://" (:constant (list :type :mssql)))
|
||
|
||
(defrule mssql-uri (and mssql-prefix
|
||
(? dsn-user-password)
|
||
(? dsn-hostname)
|
||
dsn-dbname)
|
||
(:lambda (uri)
|
||
(destructuring-bind (&key type
|
||
user
|
||
password
|
||
host
|
||
port
|
||
dbname)
|
||
(apply #'append uri)
|
||
;; Default to environment variables as described in
|
||
;; http://www.freetds.org/userguide/envvar.htm
|
||
(declare (ignore type))
|
||
(make-instance 'mssql-connection
|
||
:user (or user (getenv-default "USER"))
|
||
:pass password
|
||
:host (or host (getenv-default "TDSHOST" "localhost"))
|
||
:port (or port (parse-integer
|
||
(getenv-default "TDSPORT" "1433")))
|
||
:name dbname))))
|
||
|
||
(defrule get-mssql-uri-from-environment-variable (and kw-getenv name)
|
||
(:lambda (p-e-v)
|
||
(bind (((_ varname) p-e-v))
|
||
(let ((connstring (getenv-default varname)))
|
||
(unless connstring
|
||
(error "Environment variable ~s is unset." varname))
|
||
(parse 'mssql-uri connstring)))))
|
||
|
||
(defrule mssql-source (and kw-load kw-database kw-from
|
||
(or mssql-uri
|
||
get-mssql-uri-from-environment-variable))
|
||
(:lambda (source) (bind (((_ _ _ uri) source)) uri)))
|
||
|
||
(defrule load-mssql-command (and mssql-source target
|
||
load-mssql-optional-clauses)
|
||
(:lambda (command)
|
||
(destructuring-bind (source target clauses) command
|
||
`(,source ,target ,@clauses))))
|
||
|
||
|
||
;;; LOAD DATABASE FROM mssql://
|
||
(defun lisp-code-for-loading-from-mssql (ms-db-conn pg-db-conn
|
||
&key
|
||
gucs casts before after
|
||
((:mssql-options options))
|
||
(including)
|
||
(excluding))
|
||
`(lambda ()
|
||
(let* ((state-before (pgloader.utils:make-pgstate))
|
||
(*state* (or *state* (pgloader.utils:make-pgstate)))
|
||
(state-idx (pgloader.utils:make-pgstate))
|
||
(state-after (pgloader.utils:make-pgstate))
|
||
(*default-cast-rules* ',*mssql-default-cast-rules*)
|
||
(*cast-rules* ',casts)
|
||
,@(pgsql-connection-bindings pg-db-conn gucs)
|
||
,@(batch-control-bindings options)
|
||
,@(identifier-case-binding options)
|
||
(source
|
||
(make-instance 'pgloader.mssql::copy-mssql
|
||
:target-db ,pg-db-conn
|
||
:source-db ,ms-db-conn)))
|
||
|
||
,(sql-code-block pg-db-conn 'state-before before "before load")
|
||
|
||
(pgloader.mssql:copy-database source
|
||
:state-before state-before
|
||
:state-after state-after
|
||
:state-indexes state-idx
|
||
:including ',including
|
||
:excluding ',excluding
|
||
,@(remove-batch-control-option options))
|
||
|
||
,(sql-code-block pg-db-conn 'state-after after "after load")
|
||
|
||
(report-full-summary "Total import time" *state*
|
||
:before state-before
|
||
:finally state-after
|
||
:parallel state-idx))))
|
||
|
||
(defrule load-mssql-database load-mssql-command
|
||
(:lambda (source)
|
||
(bind (((ms-db-uri pg-db-uri
|
||
&key
|
||
gucs casts before after including excluding
|
||
((:mysql-options options)))
|
||
source))
|
||
(lisp-code-for-loading-from-mssql ms-db-uri pg-db-uri
|
||
:gucs gucs
|
||
:casts casts
|
||
:before before
|
||
:after after
|
||
:mssql-options options
|
||
:including including
|
||
:excluding excluding))))
|
||
|