Shorten column names in the application to bypass a postmodern bug (or something).

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

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))))

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)))

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)

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."