mirrors/pgloader
1
0
Fork 0
mirror of https://github.com/dimitri/pgloader.git synced 2026-05-05 02:46:10 +02:00
Code Issues Projects Releases Wiki Activity

Implement ALTER SCHEMA ... RENAME TO...

Browse Source 
That's only available for MS SQL as of now, as it's the only source
database we have where the notion of a schema makes sense. Fix #224.
This commit is contained in:
Dimitri Fontaine 2016-03-26 20:25:03 +01:00
parent 3d061a5f88
commit fcc6e8f813
8 changed files with 118 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/package.lisp
View File

@ -54,6 +54,7 @@
#:catalog-name
#:catalog-schema-list
#:schema-name
#:schema-source-name
#:schema-table-list
#:schema-view-list
#:table-name
@ -101,6 +102,7 @@
#:push-to-end
#:with-schema
#:alter-table
#:alter-schema
#:format-table-name))
@ -218,6 +220,7 @@
#:catalog-name
#:catalog-schema-list
#:schema-name
#:schema-source-name
#:schema-table-list
#:schema-view-list
#:table-name
@ -265,6 +268,7 @@
#:push-to-end
#:with-schema
#:alter-table
#:alter-schema
#:format-table-name
#:format-default-value

20
src/parsers/command-alter-table.lisp
View File

@ -56,3 +56,23 @@
(cons :alter-table
(loop :for (command ws) :in alter-table-command-list
:collect command))))
;;;
;;; ALTER SCHEMA ... RENAME TO ...
;;;
;;; Useful mainly for MS SQL at the moment
;;;
(defrule alter-schema-rename-to (and kw-alter kw-schema quoted-namestring
kw-rename kw-to quoted-namestring)
(:lambda (alter-schema-command)
(bind (((_ _ current-name _ _ new-name) alter-schema-command))
(pgloader.schema::make-match-rule
:type :string
:target current-name
:action #'pgloader.schema::alter-schema-rename
:args (list new-name)))))
;;; currently we only support a single ALTER SCHEMA variant
(defrule alter-schema alter-schema-rename-to
(:lambda (alter-schema-rename-to)
(cons :alter-schema (list (list alter-schema-rename-to)))))

7
src/parsers/command-mssql.lisp
View File

@ -69,6 +69,7 @@
(defrule load-mssql-optional-clauses (* (or mssql-options
gucs
casts
alter-schema
before-load
after-load
including-like-in-schema
@ -135,6 +136,7 @@
(defun lisp-code-for-loading-from-mssql (ms-db-conn pg-db-conn
&key
gucs casts before after options
alter-schema
including excluding)
`(lambda ()
;; now is the time to load the CFFI lib we need (freetds)
@ -156,6 +158,7 @@
(pgloader.mssql:copy-database source
:including ',including
:excluding ',excluding
:alter-schema ',alter-schema
:set-table-oids t
,@(remove-batch-control-option options))
@ -165,7 +168,8 @@
(:lambda (source)
(bind (((ms-db-uri pg-db-uri
&key
gucs casts before after including excluding options)
gucs casts before after alter-schema
including excluding options)
source))
(cond (*dry-run*
(lisp-code-for-mssql-dry-run ms-db-uri pg-db-uri))
@ -175,6 +179,7 @@
:casts casts
:before before
:after after
:alter-schema alter-schema
:options options
:including including
:excluding excluding))))))

1
src/pgsql/schema.lisp
View File

@ -364,6 +364,7 @@
(defmethod process-index-definitions ((table table) &key sql-dialect)
"Rewrite all index filter in TABLE."
(loop :for index :in (table-index-list table)
:when (pgsql-index-filter index)
:do (let ((pg-filter
(handler-case
(translate-index-filter table index sql-dialect)

34
src/sources/common/db-methods.lisp
View File

@ -114,6 +114,24 @@
:columns columns
:transforms transforms)))
(defun process-catalog (copy catalog &key alter-table alter-schema)
"Do all the PostgreSQL catalog tweaking here: casts, index WHERE clause
rewriting, pgloader level alter schema and alter table commands."
;; cast the catalog into something PostgreSQL can work on
(cast catalog)
;; support code for index filters (where clauses)
(process-index-definitions catalog :sql-dialect (class-name (class-of copy)))
;; we may have to alter schemas
(when alter-schema
(alter-schema catalog alter-schema))
;; if asked, now alter the catalog with given rules: the alter-table
;; keyword parameter actually contains a set of alter table rules.
(when alter-table
(alter-table catalog alter-table)))
;;;
;;; Generic enough implementation of the copy-database method.
@ -139,6 +157,7 @@
excluding
set-table-oids
alter-table
alter-schema
materialize-views)
"Export database source data and Import it into PostgreSQL"
(let* ((copy-kernel (make-kernel worker-count))
@ -166,16 +185,11 @@
(let ((lp:*kernel* idx-kernel))
(lp:make-channel)))))
;; cast the catalog into something PostgreSQL can work on
(cast catalog)
;; support code for index filters (where clauses)
(process-index-definitions catalog :sql-dialect (class-name (class-of copy)))
;; if asked, now alter the catalog with given rules: the alter-table
;; keyword parameter actually contains a set of alter table rules.
(when alter-table
(alter-table catalog alter-table))
;; apply catalog level transformations to support the database migration
;; that's CAST rules, index WHERE clause rewriting and ALTER commands
(process-catalog copy catalog
:alter-table alter-table
:alter-schema alter-schema)
;; if asked, first drop/create the tables on the PostgreSQL side
(handler-case

5
src/sources/mssql/mssql.lisp
View File

@ -31,7 +31,7 @@
(with-connection (*mssql-db* (source-db mssql))
(let* ((sql (format nil "SELECT ~{~a~^, ~} FROM [~a].[~a];"
(get-column-list (fields mssql))
(table-schema (source mssql))
(schema-source-name (table-schema (source mssql)))
(table-name (source mssql)))))
(log-message :debug "~a" sql)
(handler-case
@ -39,8 +39,7 @@
((condition
#'(lambda (c)
(log-message :error "~a" c)
(update-stats :data (target mssql) :errs 1)
(invoke-restart 'mssql::use-nil))))
(update-stats :data (target mssql) :errs 1))))
(mssql::map-query-results sql
:row-fn process-row-fn
:connection (conn-handle *mssql-db*)))

48
src/utils/alter-table.lisp
View File

@ -49,7 +49,9 @@
;;;
(defun alter-table-set-schema (table schema-name)
"Alter the schema of TABLE, set SCHEMA-NAME instead."
(setf (table-schema table) schema-name))
(let* ((catalog (schema-catalog (table-schema table)))
(schema (maybe-add-schema catalog schema-name)))
(setf (table-schema table) schema)))
(defun alter-table-rename (table new-name)
"Alter the name of TABLE to NEW-NAME."
@ -60,12 +62,50 @@
;;; Apply the match rules as given by the parser to a table name.
;;;
(declaim (inline rule-matches))
(defun rule-matches (match-rule table)
(defgeneric rule-matches (match-rule object)
(:documentation "Returns non-nill when MATCH-RULE matches with OBJECT."))
(defmethod rule-matches ((match-rule match-rule) (table table))
"Return non-nil when TABLE matches given MATCH-RULE."
(declare (type match-rule match-rule) (type table table))
(let ((table-name (table-source-name table)))
(ecase (match-rule-type match-rule)
(:string (string= (match-rule-target match-rule) table-name))
(:regex (cl-ppcre:scan (match-rule-target match-rule) table-name)))))
(defmethod rule-matches ((match-rule match-rule) (schema schema))
"Return non-nil when TABLE matches given MATCH-RULE."
(let ((schema-name (schema-source-name schema)))
(ecase (match-rule-type match-rule)
(:string (string= (match-rule-target match-rule) schema-name))
(:regex (cl-ppcre:scan (match-rule-target match-rule) schema-name)))))
;;;
;;; Also implement ALTER SCHEMA support here, it's using the same underlying
;;; structure.
;;;
(defgeneric alter-schema (object alter-schema-rule-list))
(defmethod alter-schema ((catalog catalog) alter-schema-rule-list)
"Apply ALTER-SCHEMA-RULE-LIST to all schema of CATALOG."
(loop :for schema :in (catalog-schema-list catalog)
:do (alter-schema schema alter-schema-rule-list)))
(defmethod alter-schema ((schema schema) alter-schema-rule-list)
"Apply ALTER-SCHEMA-RULE-LIST to SCHEMA."
;;
;; alter-schema-rule-list is a list of set of rules, within each set we
;; only apply the first rules that matches.
;;
(loop :for rule-list :in alter-schema-rule-list
:do (let ((match-rule
(loop :for match-rule :in rule-list
:thereis (when (rule-matches match-rule schema)
match-rule))))
(when match-rule
(apply (match-rule-action match-rule)
(list* schema (match-rule-args match-rule)))))))
(defun alter-schema-rename (schema new-name)
"Alter the name fo the given schema to new-name."
(setf (schema-name schema) new-name))

41
src/utils/schema-structs.lisp
View File

@ -30,7 +30,7 @@
;;; implemented in each source separately.
;;;
(defstruct catalog name schema-list)
(defstruct schema source-name name table-list view-list)
(defstruct schema source-name name catalog table-list view-list)
(defstruct table source-name name schema oid comment
;; field is for SOURCE
;; column is for TARGET
@ -155,7 +155,8 @@
(defmethod add-schema ((catalog catalog) schema-name &key)
"Add SCHEMA-NAME to CATALOG and return the new schema instance."
(let ((schema (make-schema :source-name schema-name
(let ((schema (make-schema :catalog catalog
:source-name schema-name
:name (when schema-name
(apply-identifier-case schema-name)))))
(push-to-end schema (catalog-schema-list catalog))))
@ -165,7 +166,7 @@
(let ((table
(make-table :source-name table-name
:name (apply-identifier-case table-name)
:schema (schema-name schema)
:schema schema
:comment (unless (or (null comment) (string= "" comment))
comment))))
(push-to-end table (schema-table-list schema))))
@ -175,7 +176,7 @@
(let ((view
(make-table :source-name view-name
:name (apply-identifier-case view-name)
:schema (schema-name schema)
:schema schema
:comment (unless (or (null comment) (string= "" comment))
comment))))
(push-to-end view (schema-view-list schema))))
@ -336,29 +337,21 @@
"TABLE should be a table instance, but for hysterical raisins might be a
CONS of a schema name and a table name, or just the table name as a
string."
(format nil "~@[~a.~]~a" (table-schema table) (table-name table)))
(format nil "~@[~a.~]~a"
(schema-name (table-schema table))
(table-name table)))
;;;
;;; Still lacking round tuits here, so for the moment the representation of
;;; a table name is either a string or a cons built from schema and
;;; table-name.
;;;
(defmacro with-schema ((var table-name) &body body)
"When table-name is a CONS, SET search_path TO its CAR and return its CDR,
otherwise just return the TABLE-NAME. A PostgreSQL connection must be
established when calling this function."
`(let ((,var
(typecase ,table-name
(table (if (table-schema ,table-name)
(let ((sql (format nil "SET search_path TO ~a;"
(table-schema ,table-name))))
(pgloader.pgsql:pgsql-execute sql)
(table-name ,table-name))
(table-name ,table-name)))
(cons (let ((sql (format nil "SET search_path TO ~a;"
(car ,table-name))))
(pgloader.pgsql:pgsql-execute sql)
(cdr ,table-name)))
(string ,table-name))))
,@body))
(let ((schema-name (gensym "SCHEMA-NAME")))
`(let* ((,schema-name (schema-name (table-schema ,table-name)))
(,var
(progn
(if ,schema-name
(let ((sql (format nil "SET search_path TO ~a;" ,schema-name)))
(pgloader.pgsql:pgsql-execute sql)))
(table-name ,table-name))))
,@body)))