diff --git a/src/package.lisp b/src/package.lisp index 52f144f..762720c 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -65,6 +65,7 @@ #:apply-identifier-case #:create-tables #:format-pgsql-column + #:maybe-shorten-column-name #:format-extra-type #:make-pgsql-fkey #:format-pgsql-create-fkey @@ -144,7 +145,8 @@ #:pgsql-execute-with-timing #:apply-identifier-case #:create-tables - #:format-pgsql-column) + #:format-pgsql-column + #:maybe-shorten-column-name) (:export #:copy-db3 #:map-rows #:copy-to @@ -161,6 +163,7 @@ #:list-tables-and-fkeys #:create-tables #:format-pgsql-column + #:maybe-shorten-column-name #:format-extra-type #:make-pgsql-fkey #:format-pgsql-create-fkey @@ -189,6 +192,7 @@ #:apply-identifier-case #:create-tables #:format-pgsql-column + #:maybe-shorten-column-name #:make-pgsql-index #:index-table-name #:format-pgsql-create-index diff --git a/src/pgsql/schema.lisp b/src/pgsql/schema.lisp index 4980922..21cc345 100644 --- a/src/pgsql/schema.lisp +++ b/src/pgsql/schema.lisp @@ -23,6 +23,14 @@ ;;; their own column struct and may implement the methods ;;; `format-pgsql-column' and `format-extra-type' on those. ;;; +(defun maybe-shorten-column-name (column-name) + "PostgreSQL truncates columns with more than 63 characters in their name, + but Postmodern then mysteriously loses its connection. Handle the case in + the client here." + (if (< 63 (length column-name)) + (subseq column-name 0 63) + column-name)) + (defstruct pgsql-column name type-name type-mod nullable default) (defgeneric format-pgsql-column (col &key identifier-case) @@ -42,7 +50,7 @@ (type-definition (format nil "~a~@[~a~]~:[~; not null~]~@[ default ~a~]" - (pgsql-column-type-name col) + (maybe-shorten-column-name (pgsql-column-type-name col)) (pgsql-column-type-mod col) (pgsql-column-nullable col) (pgsql-column-default col)))) diff --git a/src/sources/db3.lisp b/src/sources/db3.lisp index dbd2435..dd19e65 100644 --- a/src/sources/db3.lisp +++ b/src/sources/db3.lisp @@ -23,7 +23,9 @@ (cdr (assoc (db3-field-type col) *db3-pgsql-type-mapping* :test #'string=)))) - (format nil "~a ~22t ~a" column-name type-definition))) + (format nil "~a ~22t ~a" + (maybe-shorten-column-name column-name) + type-definition))) (defun list-all-columns (db3-file-name &optional (table-name (pathname-name db3-file-name))) diff --git a/src/sources/mysql-schema.lisp b/src/sources/mysql-schema.lisp index 264c2ea..f35aee6 100644 --- a/src/sources/mysql-schema.lisp +++ b/src/sources/mysql-schema.lisp @@ -22,7 +22,9 @@ (with-slots (table-name name dtype ctype default nullable extra) col (cast table-name name dtype ctype default nullable extra)))) - (format nil "~a ~22t ~a" column-name type-definition))) + (format nil "~a ~22t ~a" + (maybe-shorten-column-name column-name) + type-definition))) (defmethod format-extra-type ((col mysql-column) &key identifier-case include-drop) diff --git a/src/sources/sqlite.lisp b/src/sources/sqlite.lisp index a6d8531..a6a60d8 100644 --- a/src/sources/sqlite.lisp +++ b/src/sources/sqlite.lisp @@ -24,7 +24,9 @@ (coldef-type col) (coldef-nullable col) (coldef-default col)))) - (format nil "~a ~22t ~a" column-name type-definition))) + (format nil "~a ~22t ~a" + (maybe-shorten-column-name column-name) + type-definition))) (defun list-tables (&optional (db *sqlite-db*)) "Return the list of tables found in SQLITE-DB."