diff --git a/pgloader.asd b/pgloader.asd index 7e7fdad..724fec4 100644 --- a/pgloader.asd +++ b/pgloader.asd @@ -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")))) diff --git a/src/monkey/mssql.lisp b/src/monkey/mssql.lisp new file mode 100644 index 0000000..a1787cd --- /dev/null +++ b/src/monkey/mssql.lisp @@ -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)))))) diff --git a/src/sources/mssql.lisp b/src/sources/mssql.lisp index ec9627a..7f492b0 100644 --- a/src/sources/mssql.lisp +++ b/src/sources/mssql.lisp @@ -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))) diff --git a/src/sources/mssql/mssql-cast-rules.lisp b/src/sources/mssql/mssql-cast-rules.lisp new file mode 100644 index 0000000..b7f1248 --- /dev/null +++ b/src/sources/mssql/mssql-cast-rules.lisp @@ -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))) diff --git a/src/sources/mssql/mssql-schema.lisp b/src/sources/mssql/mssql-schema.lisp new file mode 100644 index 0000000..97c17aa --- /dev/null +++ b/src/sources/mssql/mssql-schema.lisp @@ -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)))))))))) diff --git a/src/utils/transforms.lisp b/src/utils/transforms.lisp index e11710c..4ecee16 100644 --- a/src/utils/transforms.lisp +++ b/src/utils/transforms.lisp @@ -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)))