From 409842395b5e745e45c97c5c3c509d3901530571 Mon Sep 17 00:00:00 2001
From: Gerd Flaig <gefla@pond.sub.org>
Date: Sun, 8 Nov 2009 16:37:55 +0100
Subject: [PATCH] Fix dumping for tables without uid

---
 xdump.lisp | 55 ++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 37 insertions(+), 18 deletions(-)

diff --git a/xdump.lisp b/xdump.lisp
index 5d68b1d..624eb69 100644
--- a/xdump.lisp
+++ b/xdump.lisp
@@ -17,14 +17,15 @@
    (entries :accessor table-entries :initform (make-array 8
 							  :fill-pointer 8
 							  :adjustable t
-							  :initial-element nil))))
+							  :initial-element nil))
+   (has-uid-p :accessor has-uid-p :initarg :has-uid-p)))
 
 ;(defclass empire-table ()
 ;  (()))
 
-(defvar *meta-by-index* (make-array 50 :adjustable t :initial-element nil))
-(defvar *table-by-index* (make-array 50 :adjustable t :initial-element nil))
-(defvar *index-by-name* (make-hash-table :size 50 :test 'equal))
+(defvar *meta-by-index* (make-array 128 :adjustable t :initial-element nil))
+(defvar *table-by-index* (make-array 128 :adjustable t :initial-element nil))
+(defvar *index-by-name* (make-hash-table :size 128 :test 'equal))
 (defvar *meta-index* (make-array 5) "meta slot symbol by meta table column index")
 (defvar *meta-meta* (make-array 5))
 
@@ -82,16 +83,23 @@
       (let ((table-index (if (string= "table" name)
 			     ; voodoo: the first column of the table of tables is the uid
 			     (elt (aref entry-buffer 0) 4)
-			     (gethash name *index-by-name*))))
+			     (gethash name *index-by-name*)))
+	    (has-uid-p nil))
 	(setf (aref *meta-by-index* table-index) meta-table)
 
+	;; determine if this table has a uid column
+	(if (and (string= "uid" (elt (aref entry-buffer 0) 0))
+		 (eql (elt (aref entry-buffer 0) 4) table-index))
+	    (setf has-uid-p t))
+
 	;; create xdump-table instance and entry class
 	(let* ((class-name (string-upcase (format nil "~a-table-entry" name)))
 	       (package (find-package "XDUMP-DATA"))
 	       (table-instance (make-instance 'xdump-table
 					      :name name
 					      :index table-index
-					      :entry-class (intern class-name package)))
+					      :entry-class (intern class-name package)
+					      :has-uid-p has-uid-p))
 	       (slot-list (loop for entry across entry-buffer
 			     collect (car entry))))
 	  (setf (aref *table-by-index* table-index) table-instance)
@@ -103,6 +111,22 @@
 				  (list (intern slot-name package) :accessor (intern accessor-name package))))
 			    slot-list))))))))
 
+(defun entry-from-vector (class meta-table entry-vector)
+  (let ((new-entry (make-instance class)))
+    (loop
+       for item in entry-vector
+       for column across meta-table do
+	 (let ((slot (find-symbol (string-upcase (meta-name column)) (find-package "XDUMP-DATA"))))
+	   (setf (slot-value new-entry slot) item)))
+    new-entry))
+
+(defmethod table-entry-insert-at ((table xdump-table) entry index)
+					; extend array if necessary
+  (let ((entries (table-entries table)))
+    (unless (> (fill-pointer entries) index)
+      (adjust-array entries (* 2 index) :fill-pointer index :initial-element nil))
+    (setf (aref entries index) entry)))
+
 (defun table-finalizer (parser)
   (with-slots (entry-buffer name timestamp) parser
     (if (string= name "table") ; special magic: prefill index-by-name
@@ -111,19 +135,14 @@
     (format t "table-finalizer: ~a~%" name)
     (let* ((table-index (gethash name *index-by-name*))
 	   (meta-table (aref *meta-by-index* table-index))
-	   (table (aref *table-by-index* table-index)))
+	   (table (aref *table-by-index* table-index))
+	   (has-uid-p (has-uid-p table)))
       (loop for entry across entry-buffer do
-	   (let ((e (make-instance (table-entry-class table)))
-		 (index (first entry))
-		 (entries (table-entries table)))
-	     ; extend array if necessary
-	     (unless (> (fill-pointer entries) index)
-	       (adjust-array entries (* 2 index) :fill-pointer index :initial-element nil))
-	     (setf (aref entries index) e)
-	     (loop
-		for item in entry
-		for column across meta-table do
-		  (setf (slot-value e (find-symbol (string-upcase (meta-name column)) (find-package "XDUMP-DATA"))) item))))
+	   (let ((entry-instance (entry-from-vector (table-entry-class table) meta-table entry)))
+	     (if has-uid-p
+		 (let ((index (first entry)))
+		   (table-entry-insert-at table entry-instance index))
+		 (vector-push-extend entry-instance (table-entries table)))))
       (setf (table-last-update table) timestamp))))
 
 (defmethod finish-table ((parser xdump-parser) number-of-records)
-- 
2.43.0