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

Some more SQL Server support (schema conversion).

Browse Source 
Converting the table definitions (with type casting) seems to work. Also
did experiment a little with actuallt fetching some data... and had to
edit the cl-mssql driver, which is temporarily monkey patched.
This commit is contained in:
Dimitri Fontaine 2014-11-10 01:16:10 +01:00
parent ca325ba799
commit 03bba5f486
6 changed files with 518 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pgloader.asd
View File

@ -32,6 +32,7 @@
#:cl-markdown ; To produce the website
#:metabang-bind ; the bind macro
#:mssql ; M$ SQL connectivity
#:uuid ; Transforming MS SQL unique identifiers
)
:components
((:module "src"
@ -42,7 +43,8 @@
(:module "monkey"
:components
((:file "bind")))
((:file "bind")
(:file "mssql")))
(:module "utils"
:depends-on ("package" "params")
@ -108,11 +110,21 @@
(:file "sqlite" :depends-on ("sqlite-utils"))
(:module "mssql-utils"
:pathname "mssql"
:components
((:file "mssql-cast-rules")
(:file "mssql-schema"
:depends-on ("mssql-cast-rules"))))
(:file "mssql" :depends-on ("mssql-utils"))
(:module "mysql-utils"
:pathname "mysql"
:components
((:file "mysql-cast-rules")
(:file "mysql-schema")
(:file "mysql-schema"
:depends-on ("mysql-cast-rules"))
(:file "mysql-csv"
:depends-on ("mysql-schema"))))

100
src/monkey/mssql.lisp Normal file
View File

@ -0,0 +1,100 @@
;;;
;;; Monkey patch mssql to add missing bits, will cook a patch later.
;;;
(in-package :mssql)
;;
;; See freetds/include/freetds/proto.h for reference
;;
(defcenum %syb-value-type
(:syb-char 47)
(:syb-varchar 39)
(:syb-intn 38)
(:syb-int1 48)
(:syb-int2 52)
(:syb-int4 56)
(:syb-int8 127)
(:syb-flt8 62)
(:syb-datetime 61)
(:syb-bit 50)
(:syb-text 35)
(:syb-image 34)
(:syb-money4 122)
(:syb-money 60)
(:syb-datetime4 58)
(:syb-real 59)
(:syb-binary 45)
(:syb-varbinary 37)
(:syb-bitn 104)
(:syb-numeric 108)
(:syb-decimal 106)
(:syb-fltn 109)
(:syb-moneyn 110)
(:syb-datetimn 111)
;; MS only types
(:syb-nvarchar 103)
;(:syb-int8 127)
(:xsy-bchar 175)
(:xsy-bvarchar 167)
(:xsy-bnvarchar 231)
(:xsy-bnchar 239)
(:xsy-bvarbinary 165)
(:xsy-bbinary 173)
(:syb-unique 36)
(:syb-variant 98)
(:syb-msudt 240)
(:syb-msxml 241)
(:syb-msdate 40)
(:syb-mstime 41)
(:syb-msdatetime2 42)
(:syb-msdatetimeoffset 43)
;; Sybase only types
(:syb-longbinary 225)
(:syb-uint1 64)
(:syb-uint2 65)
(:syb-uint4 66)
(:syb-uint8 67)
(:syb-blob 36)
(:syb-boundary 104)
(:syb-date 49)
(:syb-daten 123)
(:syb-5int8 191)
(:syb-interval 46)
(:syb-longchar 175)
(:syb-sensitivity 103)
(:syb-sint1 176)
(:syb-time 51)
(:syb-timen 147)
(:syb-uintn 68)
(:syb-unitext 174)
(:syb-xml 163)
)
(defun sysdb-data-to-lisp (%dbproc data type len)
(if (> len 0)
(case (foreign-enum-keyword '%syb-value-type type)
((:syb-varchar :syb-text) (foreign-string-to-lisp data :count len))
(:syb-char (string-trim #(#\Space) (foreign-string-to-lisp data :count len)))
((:syb-bit :syb-bitn) (mem-ref data :int))
((:syb-int1 :syb-int2 :syb-int4) (mem-ref data :int))
(:syb-int8 (mem-ref data :int8))
(:syb-flt8 (mem-ref data :double))
(:syb-datetime
(with-foreign-pointer (%buf +numeric-buf-sz+)
(foreign-string-to-lisp %buf
:count (%dbconvert %dbproc type data -1 :syb-char %buf +numeric-buf-sz+))))
((:syb-money :syb-money4 :syb-decimal :syb-numeric)
(with-foreign-pointer (%buf +numeric-buf-sz+)
(parse-number:parse-number
(foreign-string-to-lisp %buf
:count (%dbconvert %dbproc type data -1 :syb-char %buf +numeric-buf-sz+)))))
((:syb-image :syb-binary :syb-varbinary :syb-blob)
(let ((vector (make-array len :element-type '(unsigned-byte 8))))
(dotimes (i len)
(setf (aref vector i) (mem-ref data :uchar i)))
vector))
(otherwise (error "not supported type ~A"
(foreign-enum-keyword '%syb-value-type type))))))

345
src/sources/mssql.lisp
View File

@ -4,238 +4,137 @@
(in-package :pgloader.mssql)
(defvar *mssql-db* nil
"The MS SQL database connection handler.")
(defclass copy-mssql (copy)
((encoding :accessor encoding ; allows forcing encoding
:initarg :encoding
:initform nil))
(:documentation "pgloader MS SQL Data Source"))
(defparameter *mssql-default-cast-rules*
`((:source (:type "char") :target (:type "text" :drop-typemod t))
(:source (:type "nchar") :target (:type "text" :drop-typemod t))
(:source (:type "varchar") :target (:type "text" :drop-typemod t))
(:source (:type "nvarchar") :target (:type "text" :drop-typemod t))
(:source (:type "xml") :target (:type "xml" :drop-typemod t))
(defun cast-mssql-column-definition-to-pgsql (mssql-column)
"Return the PostgreSQL column definition from the MySQL one."
(with-slots (schema table-name name type default nullable)
mssql-column
(declare (ignore schema)) ; FIXME
(let ((ctype (mssql-column-ctype mssql-column)))
(cast table-name name type ctype default nullable nil))))
(:source (:type "bit") :target (:type "boolean"))
(defmethod initialize-instance :after ((source copy-mssql) &key)
"Add a default value for transforms in case it's not been provided."
(let* ((source-db (slot-value source 'source-db))
(table-name (when (slot-boundp source 'source)
(slot-value source 'source)))
(fields (or (and (slot-boundp source 'fields)
(slot-value source 'fields))
(when table-name
(let* ((all-columns (list-all-columns :dbname source-db)))
(cdr (assoc table-name all-columns
:test #'string=))))))
(transforms (when (slot-boundp source 'transforms)
(slot-value source 'transforms))))
(:source (:type "uniqueidentifier") :target (:type "uuid"))
;; default to using the same database name as source and target
(when (and source-db
(or (not (slot-boundp source 'target-db))
(not (slot-value source 'target-db))))
(setf (slot-value source 'target-db) source-db))
(:source (:type "money") :target (:type "numeric"))
(:source (:type "smallmoney") :target (:type "numeric"))
;; default to using the same table-name as source and target
(when (and table-name
(or (not (slot-boundp source 'target))
(not (slot-value source 'target))))
(setf (slot-value source 'target) table-name))
(:source (:type "tinyint") :target (:type "smallint"))
(when fields
(unless (slot-boundp source 'fields)
(setf (slot-value source 'fields) fields))
(:source (:type "float") :target (:type "float")
:using pgloader.transforms::float-to-string)
(loop :for field :in fields
:for (column fn) := (multiple-value-bind (column fn)
(cast-mysql-column-definition-to-pgsql field)
(list column fn))
:collect column :into columns
:collect fn :into fns
:finally (progn (setf (slot-value source 'columns) columns)
(unless transforms
(setf (slot-value source 'transforms) fns)))))))
(:source (:type "real") :target (:type "real")
:using pgloader.transforms::float-to-string)
(defmethod copy-database ((mssql copy-mssql)
&key
state-before
data-only
schema-only
(truncate nil)
(create-tables t)
(include-drop t)
(create-indexes t)
(reset-sequences t)
only-tables
including
excluding
(identifier-case :downcase)
(encoding :utf-8))
"Stream the given MS SQL database down to PostgreSQL."
(declare (ignore create-indexes reset-sequences))
(let* ((summary (null *state*))
(*state* (or *state* (make-pgstate)))
(state-before (or state-before (make-pgstate)))
(idx-state (make-pgstate))
(seq-state (make-pgstate))
(cffi:*default-foreign-encoding* encoding)
;; (copy-kernel (make-kernel 2))
(all-columns (filter-column-list (list-all-columns)
:only-tables only-tables
:including including
:excluding excluding))
;; (all-indexes (filter-column-list (list-all-indexes)
;; :only-tables only-tables
;; :including including
;; :excluding excluding))
;; (max-indexes (loop :for (table . indexes) :in all-indexes
;; :maximizing (length indexes)))
;; (idx-kernel (when (and max-indexes (< 0 max-indexes))
;; (make-kernel max-indexes)))
;; (idx-channel (when idx-kernel
;; (let ((lp:*kernel* idx-kernel))
;; (lp:make-channel))))
;; (pg-dbname (target-db mssql))
)
(:source (:type "double") :target (:type "double precision")
:using pgloader.transforms::float-to-string)
;; if asked, first drop/create the tables on the PostgreSQL side
(cond ((and (or create-tables schema-only) (not data-only))
(log-message :notice "~:[~;DROP then ~]CREATE TABLES" include-drop)
(with-stats-collection ("create, truncate"
:state state-before
:summary summary)
(with-pgsql-transaction ()
(loop :for (schema . tables) :in all-columns
:do (let ((schema
(apply-identifier-case schema identifier-case)))
;; create schema
(let ((sql (format nil "CREATE SCHEMA ~a;" schema)))
(log-message :notice "~a" sql)
(pgsql-execute sql))
(:source (:type "numeric") :target (:type "numeric")
:using pgloader.transforms::float-to-string)
;; set search_path to only that schema
(pgsql-execute
(format nil "SET LOCAL search_path TO ~a;" schema))
(:source (:type "binary") :target (:type "bytea")
:using pgloader.transforms::byte-vector-to-bytea)
;; and now create the tables within that schema
(create-tables tables
:include-drop include-drop
:identifier-case identifier-case))))))
(:source (:type "varbinary") :target (:type "bytea")
:using pgloader.transforms::byte-vector-to-bytea)
(truncate
(let ((qualified-table-name-list
(qualified-table-name-list all-columns
:identifier-case identifier-case)))
(truncate-tables *pg-dbname*
;; here we really do want only the name
(mapcar #'car qualified-table-name-list)
:identifier-case identifier-case))))
(:source (:type "datetime") :target (:type "timestamptz")
:using pgloader.transforms::sqlite-timestamp-to-timestamp))
"Data Type Casting to migrate from MSSQL to PostgreSQL")
;;;
;;; General utility to manage MySQL connection
;;;
(defun mssql-query (query)
"Execute given QUERY within the current *connection*, and set proper
defaults for pgloader."
(mssql:query query :connection *mssql-db*))
(defmacro with-mssql-connection ((&optional (dbname *ms-dbname*)) &body forms)
"Connect to MSSQL, use given DBNAME as the current database if provided,
and execute FORMS in a protected way so that we always disconnect when
done.
Connection parameters are *myconn-host*, *myconn-port*, *myconn-user* and
*myconn-pass*."
`(let* ((dbname (or ,dbname *ms-dbname*))
(*mssql-db* (mssql:connect dbname
*msconn-user*
*msconn-pass*
*msconn-host*)))
(unwind-protect
(progn ,@forms)
(mssql:disconnect *mssql-db*))))
;;;
;;; Specific implementation of schema migration, see the API in
;;; src/pgsql/schema.lisp
;;;
(defstruct (mssql-column
(:constructor make-mssql-column
(schema table-name name type
default nullable identity
character-maximum-length
numeric-precision
numeric-precision-radix
numeric-scale
datetime-precision
character-set-name
collation-name)))
schema table-name name type default nullable identity
character-maximum-length
numeric-precision numeric-precision-radix numeric-scale
datetime-precision
character-set-name collation-name)
(defmethod mssql-column-ctype ((col mssql-column))
"Build the ctype definition from the full mssql-column information."
(let ((type (mssql-column-type col)))
(cond ((and (string= type "int")
(mssql-column-identity col))
"bigserial")
((member type
'("decimal" "numeric" "float" "double" "real")
:test #'string=)
(format nil "~a(~a,~a)"
type
(mssql-column-numeric-precision col)
(mssql-column-numeric-scale col)))
(t type))))
(defmethod format-pgsql-column ((col mssql-column) &key identifier-case)
"Return a string representing the PostgreSQL column definition."
(let* ((column-name
(apply-identifier-case (mssql-column-name col) identifier-case))
(type-definition
(with-slots (schema table-name name type default nullable)
col
(declare (ignore schema)) ; FIXME
(let ((ctype (mssql-column-ctype col)))
(cast table-name name type ctype default nullable nil)))))
(format nil "~a ~22t ~a" column-name type-definition)))
;;;
;;; Those functions are to be called from withing an already established
;;; MS SQL Connection.
;;;
;;; Tools to get MS SQL table and columns definitions and transform them to
;;; PostgreSQL CREATE TABLE statements, and run those.
;;;
(defvar *table-type* '((:table . "BASE TABLE")
(:view . "VIEW"))
"Associate internal table type symbol with what's found in MS SQL
information_schema.tables.table_type column.")
(defun list-all-columns (&key
(dbname *ms-dbname*)
(table-type :table)
&aux
(table-type-name (cdr (assoc table-type *table-type*))))
(loop
:with result := nil
:for (schema table-name name type default nullable identity
character-maximum-length
numeric-precision numeric-precision-radix numeric-scale
datetime-precision
character-set-name collation-name)
:in
(mssql-query (format nil "
select c.table_schema,
c.table_name,
c.column_name,
c.data_type,
c.column_default,
c.is_nullable,
COLUMNPROPERTY(object_id(c.table_name), c.column_name, 'IsIdentity'),
c.CHARACTER_MAXIMUM_LENGTH,
c.NUMERIC_PRECISION,
c.NUMERIC_PRECISION_RADIX,
c.NUMERIC_SCALE,
c.DATETIME_PRECISION,
c.CHARACTER_SET_NAME,
c.COLLATION_NAME
from information_schema.columns c
join information_schema.tables t
on c.table_schema = t.table_schema
and c.table_name = t.table_name
where c.table_catalog = '~a'
and t.table_type = '~a'
order by table_schema, table_name, ordinal_position"
dbname
table-type-name))
:do
(let* ((s-entry (assoc schema result :test 'equal))
(t-entry (when s-entry
(assoc table-name (cdr s-entry) :test 'equal)))
(column
(make-mssql-column
schema table-name name type default nullable
(eq 1 identity)
character-maximum-length
numeric-precision numeric-precision-radix numeric-scale
datetime-precision
character-set-name collation-name)))
(if s-entry
(if t-entry
(push column (cdr t-entry))
(push (cons table-name (list column)) (cdr s-entry)))
(push (cons schema (list (cons table-name (list column)))) result)))
:finally
;; we did push, we need to reverse here
(return (reverse
(loop :for (schema . tables) :in result
:collect
(cons schema
(reverse (loop :for (table-name . cols) :in tables
:collect (cons table-name (reverse cols))))))))))
(defun list-all-indexes (&key
(dbname *my-dbname*))
"Get the list of MSSQL index definitions per table."
(loop
:with result := nil
:for (schema table-name name unique col)
:in
(mssql:query (format nil "
SELECT OBJECT_SCHEMA_NAME(T.[object_id],DB_ID()) AS [Schema],
T.[name] AS [table_name], I.[name] AS [index_name], AC.[name] AS [column_name],
I.[type_desc], I.[is_unique], I.[data_space_id], I.[ignore_dup_key], I.[is_primary_key],
I.[is_unique_constraint], I.[fill_factor], I.[is_padded], I.[is_disabled], I.[is_hypothetical],
I.[allow_row_locks], I.[allow_page_locks], IC.[is_descending_key], IC.[is_included_column]
FROM sys.[tables] AS T
INNER JOIN sys.[indexes] I ON T.[object_id] = I.[object_id]
INNER JOIN sys.[index_columns] IC ON I.[object_id] = IC.[object_id]
INNER JOIN sys.[all_columns] AC ON T.[object_id] = AC.[object_id] AND IC.[column_id] = AC.[column_id]
WHERE T.[is_ms_shipped] = 0 AND I.[type_desc] <> 'HEAP'
ORDER BY T.[name], I.[index_id], IC.[key_ordinal];")
:connection *mssql-db*)
:do
(let* ((s-entry (assoc schema result :test 'equal))
(i-entry (when s-entry
(assoc table-name (cdr s-entry) :test 'equal)))
(index
))
(if s-entry
(if t-entry
(push column (cdr t-entry))
(push (cons table-name (list column)) (cdr s-entry)))
(push (cons schema (list (cons table-name (list column)))) result)))
:finally
;; we did push, we need to reverse here
(return (reverse
(loop :for (schema . tables) :in result
:collect
(cons schema
(reverse (loop :for (table-name . cols) :in tables
:collect (cons table-name (reverse cols))))))))))
;; and report the total time spent on the operation
(report-full-summary "Total streaming time" *state*
:before state-before
:finally seq-state
:parallel idx-state)))

100
src/sources/mssql/mssql-cast-rules.lisp Normal file
View File

@ -0,0 +1,100 @@
;;;
;;; Tools to handle MS SQL data type casting rules
;;;
(in-package :pgloader.mssql)
(defparameter *mssql-default-cast-rules*
`((:source (:type "char") :target (:type "text" :drop-typemod t))
(:source (:type "nchar") :target (:type "text" :drop-typemod t))
(:source (:type "varchar") :target (:type "text" :drop-typemod t))
(:source (:type "nvarchar") :target (:type "text" :drop-typemod t))
(:source (:type "xml") :target (:type "xml" :drop-typemod t))
(:source (:type "bit") :target (:type "boolean"))
(:source (:type "uniqueidentifier") :target (:type "uuid")
:using pgloader.transforms::sql-server-uniqueidentifier-to-uuid)
(:source (:type "hierarchyid") :target (:type "bytea")
:using pgloader.transforms::byte-vector-to-bytea)
(:source (:type "geography") :target (:type "bytea")
:using pgloader.transforms::byte-vector-to-bytea)
(:source (:type "money") :target (:type "numeric"))
(:source (:type "smallmoney") :target (:type "numeric"))
(:source (:type "tinyint") :target (:type "smallint"))
(:source (:type "float") :target (:type "float")
:using pgloader.transforms::float-to-string)
(:source (:type "real") :target (:type "real")
:using pgloader.transforms::float-to-string)
(:source (:type "double") :target (:type "double precision")
:using pgloader.transforms::float-to-string)
(:source (:type "numeric") :target (:type "numeric")
:using pgloader.transforms::float-to-string)
(:source (:type "binary") :target (:type "bytea")
:using pgloader.transforms::byte-vector-to-bytea)
(:source (:type "varbinary") :target (:type "bytea")
:using pgloader.transforms::byte-vector-to-bytea)
(:source (:type "datetime") :target (:type "timestamptz")
:using pgloader.transforms::sqlite-timestamp-to-timestamp))
"Data Type Casting to migrate from MSSQL to PostgreSQL")
;;;
;;; Specific implementation of schema migration, see the API in
;;; src/pgsql/schema.lisp
;;;
(defstruct (mssql-column
(:constructor make-mssql-column
(schema table-name name type
default nullable identity
character-maximum-length
numeric-precision
numeric-precision-radix
numeric-scale
datetime-precision
character-set-name
collation-name)))
schema table-name name type default nullable identity
character-maximum-length
numeric-precision numeric-precision-radix numeric-scale
datetime-precision
character-set-name collation-name)
(defmethod mssql-column-ctype ((col mssql-column))
"Build the ctype definition from the full mssql-column information."
(let ((type (mssql-column-type col)))
(cond ((and (string= type "int")
(mssql-column-identity col))
"bigserial")
((member type
'("decimal" "numeric" "float" "double" "real")
:test #'string=)
(format nil "~a(~a,~a)"
type
(mssql-column-numeric-precision col)
(mssql-column-numeric-scale col)))
(t type))))
(defmethod format-pgsql-column ((col mssql-column) &key identifier-case)
"Return a string representing the PostgreSQL column definition."
(let* ((column-name
(apply-identifier-case (mssql-column-name col) identifier-case))
(type-definition
(with-slots (schema table-name name type default nullable)
col
(declare (ignore schema)) ; FIXME
(let ((ctype (mssql-column-ctype col)))
(cast table-name name type ctype default nullable nil)))))
(format nil "~a ~22t ~a" column-name type-definition)))

176
src/sources/mssql/mssql-schema.lisp Normal file
View File

@ -0,0 +1,176 @@
;;;
;;; Tools to query the MS SQL Schema to reproduce in PostgreSQL
;;;
(in-package :pgloader.mssql)
(defvar *mssql-db* nil
"The MS SQL database connection handler.")
;;;
;;; General utility to manage MySQL connection
;;;
(defun mssql-query (query)
"Execute given QUERY within the current *connection*, and set proper
defaults for pgloader."
(mssql:query query :connection *mssql-db*))
(defmacro with-mssql-connection ((&optional (dbname *ms-dbname*)) &body forms)
"Connect to MSSQL, use given DBNAME as the current database if provided,
and execute FORMS in a protected way so that we always disconnect when
done.
Connection parameters are *myconn-host*, *myconn-port*, *myconn-user* and
*myconn-pass*."
`(let* ((dbname (or ,dbname *ms-dbname*))
(*mssql-db* (mssql:connect dbname
*msconn-user*
*msconn-pass*
*msconn-host*)))
(unwind-protect
(progn ,@forms)
(mssql:disconnect *mssql-db*))))
;;;
;;; We store the whole database schema in memory with the following
;;; organisation:
;;;
;;; - an alist of (schema . tables)
;;; - where tables is an alist of (name . cols)
;;; - where cols is a list of mssql-column struct instances
;;;
(defun qualify-name (schema table-name &key (identifier-case :downcase))
"Return the fully qualified name."
(let ((sn (apply-identifier-case schema identifier-case))
(tn (apply-identifier-case table-name identifier-case)))
(format nil "~a.~a" sn tn)))
(defun qualified-table-name-list (schema-table-cols-alist
&key (identifier-case :downcase))
"Return a flat list of qualified table names."
(loop :for (schema . tables) :in schema-table-cols-alist
:append (loop :for (table . cols) :in tables
:collect (cons (qualify-name schema table
:identifier-case identifier-case)
cols))))
;;;
;;; Those functions are to be called from withing an already established
;;; MS SQL Connection.
;;;
;;; Tools to get MS SQL table and columns definitions and transform them to
;;; PostgreSQL CREATE TABLE statements, and run those.
;;;
(defvar *table-type* '((:table . "BASE TABLE")
(:view . "VIEW"))
"Associate internal table type symbol with what's found in MS SQL
information_schema.tables.table_type column.")
(defun list-all-columns (&key
(dbname *ms-dbname*)
(table-type :table)
&aux
(table-type-name (cdr (assoc table-type *table-type*))))
(loop
:with result := nil
:for (schema table-name name type default nullable identity
character-maximum-length
numeric-precision numeric-precision-radix numeric-scale
datetime-precision
character-set-name collation-name)
:in
(mssql-query (format nil "
select c.table_schema,
c.table_name,
c.column_name,
c.data_type,
c.column_default,
c.is_nullable,
COLUMNPROPERTY(object_id(c.table_name), c.column_name, 'IsIdentity'),
c.CHARACTER_MAXIMUM_LENGTH,
c.NUMERIC_PRECISION,
c.NUMERIC_PRECISION_RADIX,
c.NUMERIC_SCALE,
c.DATETIME_PRECISION,
c.CHARACTER_SET_NAME,
c.COLLATION_NAME
from information_schema.columns c
join information_schema.tables t
on c.table_schema = t.table_schema
and c.table_name = t.table_name
where c.table_catalog = '~a'
and t.table_type = '~a'
order by table_schema, table_name, ordinal_position"
dbname
table-type-name))
:do
(let* ((s-entry (assoc schema result :test 'equal))
(t-entry (when s-entry
(assoc table-name (cdr s-entry) :test 'equal)))
(column
(make-mssql-column
schema table-name name type default nullable
(eq 1 identity)
character-maximum-length
numeric-precision numeric-precision-radix numeric-scale
datetime-precision
character-set-name collation-name)))
(if s-entry
(if t-entry
(push column (cdr t-entry))
(push (cons table-name (list column)) (cdr s-entry)))
(push (cons schema (list (cons table-name (list column)))) result)))
:finally
;; we did push, we need to reverse here
(return (reverse
(loop :for (schema . tables) :in result
:collect
(cons schema
(reverse (loop :for (table-name . cols) :in tables
:collect (cons table-name (reverse cols))))))))))
(defun list-all-indexes (&key
(dbname *my-dbname*))
"Get the list of MSSQL index definitions per table."
(loop
:with result := nil
:for (schema table-name name unique col)
:in
(mssql:query (format nil "
SELECT OBJECT_SCHEMA_NAME(T.[object_id],DB_ID()) AS [Schema],
T.[name] AS [table_name], I.[name] AS [index_name], AC.[name] AS [column_name],
I.[type_desc], I.[is_unique], I.[data_space_id], I.[ignore_dup_key], I.[is_primary_key],
I.[is_unique_constraint], I.[fill_factor], I.[is_padded], I.[is_disabled], I.[is_hypothetical],
I.[allow_row_locks], I.[allow_page_locks], IC.[is_descending_key], IC.[is_included_column]
FROM sys.[tables] AS T
INNER JOIN sys.[indexes] I ON T.[object_id] = I.[object_id]
INNER JOIN sys.[index_columns] IC ON I.[object_id] = IC.[object_id]
INNER JOIN sys.[all_columns] AC ON T.[object_id] = AC.[object_id] AND IC.[column_id] = AC.[column_id]
WHERE T.[is_ms_shipped] = 0 AND I.[type_desc] <> 'HEAP'
ORDER BY T.[name], I.[index_id], IC.[key_ordinal];")
:connection *mssql-db*)
:do
(let* ((s-entry (assoc schema result :test 'equal))
(i-entry (when s-entry
(assoc table-name (cdr s-entry) :test 'equal)))
(index
))
(if s-entry
(if t-entry
(push column (cdr t-entry))
(push (cons table-name (list column)) (cdr s-entry)))
(push (cons schema (list (cons table-name (list column)))) result)))
:finally
;; we did push, we need to reverse here
(return (reverse
(loop :for (schema . tables) :in result
:collect
(cons schema
(reverse (loop :for (table-name . cols) :in tables
:collect (cons table-name (reverse cols))))))))))

7
src/utils/transforms.lisp
View File

@ -21,7 +21,8 @@
set-to-enum-array
right-trim
byte-vector-to-bytea
sqlite-timestamp-to-timestamp))
sqlite-timestamp-to-timestamp
sql-server-uniqueidentifier-to-uuid))
;;;
@ -227,3 +228,7 @@
(t
date-string-or-integer)))))))
(defun sql-server-uniqueidentifier-to-uuid (id)
(declare (type (array (unsigned-byte 8) (16)) id))
(format nil "~a" (uuid:byte-array-to-uuid id)))