1e328809a01f47dc107c9caa51b8cd23e884f330
[eow] / xdump-test.lisp
1 (in-package :xdump)
2
3 (defparameter *mode* (make-instance 'empire::xdump-mode :connection nil))
4
5 (defvar *current-parser* nil)
6
7 (defclass table-column-meta ()
8   ((name :accessor meta-name)
9    (type :accessor meta-type)
10    (flags :accessor meta-flags)
11    (len :accessor meta-len)
12    (table :accessor meta-table)))
13
14 ;(defclass empire-table ()
15 ;  (()))
16
17 (defvar *meta-by-index* (make-array 50 :adjustable t :initial-element nil))
18 (defvar *index-by-name* (make-hash-table :size 50))
19 (defvar *meta-index* (make-array 5) "meta slot symbol by meta table column index")
20 (defvar *meta-meta* (make-array 5))
21
22 (defclass xdump-parser ()
23   ((line-parser :accessor line-parser :initform nil)
24    (entry-buffer :accessor entry-buffer :initform (make-array 1 :fill-pointer 0 :adjustable t))
25    (entry-index :accessor entry-index :initform 0)
26    (finalizer :accessor finalizer :initform nil)
27    (name :accessor table-name :initform nil)
28    (timestamp :accessor timestamp :initform nil)))
29
30 (defgeneric finish-table (xdump-parser number-of-records))
31 (defgeneric parse-entry (xdump-parser line))
32 (defgeneric parse-meta (xdump-parser name timestamp))
33 (defgeneric parse-table (xdump-parser name timestamp))
34 (defgeneric header-parser (xdump-parser line))
35 (defgeneric parse-line (xdump-parser line))
36
37 (defun meta-meta-finalizer (parser)
38   (with-slots (entry-buffer) parser
39                                         ; build meta-index from integer index to slot symbol
40     (loop
41        for i = 0 then (+ i 1)
42        for e across entry-buffer
43        do (let* ((slot-name (string-upcase (car e)))
44                  (slot (find-symbol slot-name :xdump)))
45             (setf (aref *meta-index* i) slot)))
46                                         ; build meta-meta table
47     (loop for entry across entry-buffer
48        for i = 0 then (+ i 1)
49        do (let ((meta-meta (make-instance 'table-column-meta)))
50             (loop for slot across *meta-index*
51                for field in entry
52                do (setf (slot-value meta-meta slot) field))
53             (setf (aref *meta-meta* i) meta-meta)))))
54
55 (defun meta-finalizer (parser)
56   (let ((meta-table (make-array 1 :fill-pointer 0 :adjustable t)))
57     (with-slots (entry-buffer name) parser
58       (loop for entry across entry-buffer
59          do (let ((meta (make-instance 'table-column-meta)))
60               (loop for slot across *meta-index*
61                  for field in entry
62                  do (setf (slot-value meta slot) field))
63               (vector-push-extend meta meta-table)))
64       (format t "~a~%~a~%~a~%" name meta-table entry-buffer)
65       (let ((table-index (if (string= "table" name)
66                              ; voodoo: the first column of the table of tables is the uid
67                              (elt (aref entry-buffer 0) 4)
68                              (gethash name *index-by-name*))))
69         (setf (aref *meta-by-index* table-index) meta-table)))))
70
71 (defun table-finalizer (parser)
72   t)
73
74 (defmethod finish-table ((parser xdump-parser) number-of-records)
75   (if (not (equal number-of-records (length (entry-buffer parser))))
76       (error "Table row count mismatch"))
77   (funcall (finalizer parser) parser))
78
79 (defmethod parse-entry ((parser xdump-parser) line)
80   (if (char= #\/ (aref line 0))
81       (finish-table parser (parse-integer (subseq line 1)))
82       (let ((fields (mapcar #'read-from-string (cl-ppcre:split " " line))))
83         (with-slots (entry-buffer entry-index) parser
84           (vector-push-extend fields entry-buffer)
85           (incf entry-index)))))
86
87 (defmethod parse-meta ((parser xdump-parser) input-name input-timestamp)
88   (with-slots (line-parser finalizer name timestamp) parser
89     (setf line-parser #'parse-entry
90           finalizer (if (string= "meta" input-name)
91                         #'meta-meta-finalizer
92                         #'meta-finalizer)
93           name input-name
94           timestamp input-timestamp)))
95
96 (defmethod parse-table ((parser xdump-parser) name timestamp)
97   (with-slots (line-parser finalizer) parser
98     (setf line-parser #'parse-entry
99           finalizer #'table-finalizer)))
100
101 (defmethod header-parser ((parser xdump-parser) line)
102   (multiple-value-bind (fullmatch groups)
103       (cl-ppcre:scan-to-strings "^XDUMP meta (.*) ([0-9]+)$" line)
104     (if fullmatch
105         ;; meta table
106         (let ((name (aref groups 0))
107               (timestamp (parse-integer (aref groups 1))))
108           (parse-meta parser name timestamp))
109         ;; table
110         (multiple-value-bind (fullmatch groups)
111             (cl-ppcre:scan-to-strings "^XDUMP (.*) ([0-9]+)$" line)
112           (declare (ignorable fullmatch))
113           (let ((name (aref groups 0))
114                 (timestamp (parse-integer (aref groups 1))))
115             (parse-table parser name timestamp))))))
116
117 (defmethod parse-line ((parser xdump-parser) line)
118   (with-slots (line-parser) parser
119     (funcall line-parser parser line)))
120
121 (defun make-parser ()
122   (let ((parser (make-instance 'xdump-parser)))
123     (setf (line-parser parser) #'header-parser)
124     parser))
125
126 (defun parse (stream)
127   (let ((parser (make-parser)))
128     (setf *current-parser* parser)
129     (loop for line = (read-line stream nil)
130        while line do (parse-line parser line))))
131
132 (defun test-parse (filename)
133   (with-open-file (s filename)
134     (parse s)))
135
136 (defun xd-test (input)
137   (loop for m in input
138      do (empire::handle-data *mode* m)))
139
140 (defun t1 ()
141   (test-parse "xdump-meta-meta.txt"))
142
143 (defun t2 ()
144   (test-parse "xdump-meta-meta.txt")
145   (test-parse "xdump-meta-table.txt")
146   (test-parse "xdump-table.txt"))