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