3 (defparameter *mode* (make-instance 'empire::xdump-mode :connection nil))
5 (defvar *current-parser* nil)
7 (defclass meta-table ()
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)))
14 (defvar *meta-by-index* (make-array 30 :fill-pointer 0 :adjustable t))
15 (defvar *meta-index* (make-array 5))
16 (defvar *meta-meta* (make-array 5))
18 (defclass xdump-parser ()
19 ((line-parser :accessor line-parser :initform nil)
20 (entry-buffer :accessor entry-buffer :initform (make-array 1 :fill-pointer 0 :adjustable t))
21 (entry-index :accessor entry-index :initform 0)
22 (finalizer :accessor finalizer :initform nil)))
24 (defgeneric finish-table (xdump-parser number-of-records))
25 (defgeneric parse-entry (xdump-parser line))
26 (defgeneric parse-meta (xdump-parser name timestamp))
27 (defgeneric parse-table (xdump-parser name timestamp))
28 (defgeneric header-parser (xdump-parser line))
29 (defgeneric parse-line (xdump-parser line))
31 (defun meta-meta-finalizer (entry-buffer index)
32 (declare (ignorable index))
34 for i = 0 then (+ i 1)
35 for e across entry-buffer
36 do (let* ((slot-name (string-upcase (car e)))
37 (slot (find-symbol slot-name :xdump)))
38 (setf (aref *meta-index* i) slot)))
39 (loop for entry across entry-buffer
40 for i = 0 then (+ i 1)
41 do (let ((meta-meta (make-instance 'meta-table)))
42 (loop for slot across *meta-index*
44 do (setf (slot-value meta-meta slot) field))
45 (setf (aref *meta-meta* i) meta-meta))))
47 (defun meta-finalizer (entry-buffer index)
50 (defmethod finish-table ((parser xdump-parser) number-of-records)
51 (if (not (equal number-of-records (length (entry-buffer parser))))
52 (error "Table row count mismatch"))
53 (with-slots (finalizer entry-buffer entry-index) parser
54 (funcall finalizer entry-buffer entry-index)))
56 (defmethod parse-entry ((parser xdump-parser) line)
57 (if (char= #\/ (aref line 0))
58 (finish-table parser (parse-integer (subseq line 1)))
59 (let ((fields (mapcar #'read-from-string (cl-ppcre:split " " line))))
60 (with-slots (entry-buffer entry-index) parser
61 (vector-push-extend fields entry-buffer)
62 (incf entry-index)))))
64 (defmethod parse-meta ((parser xdump-parser) name timestamp)
65 (with-slots (line-parser finalizer) parser
66 (setf line-parser #'parse-entry
67 finalizer (if (string= "meta" name)
71 (defmethod parse-table ((parser xdump-parser) name timestamp)
72 (setf (line-parser parser) #'parse-entry))
74 (defmethod header-parser ((parser xdump-parser) line)
75 (multiple-value-bind (fullmatch groups)
76 (cl-ppcre:scan-to-strings "^XDUMP meta (.*) ([0-9]+)$" line)
79 (let ((name (aref groups 0))
80 (timestamp (parse-integer (aref groups 1))))
81 (parse-meta parser name timestamp))
83 (multiple-value-bind (fullmatch groups)
84 (cl-ppcre:scan-to-strings "^XDUMP (.*) ([0-9]+)$" line)
85 (declare (ignorable fullmatch))
86 (let ((name (aref groups 0))
87 (timestamp (parse-integer (aref groups 1))))
88 (parse-table parser name timestamp))))))
90 (defmethod parse-line ((parser xdump-parser) line)
91 (with-slots (line-parser) parser
92 (funcall line-parser parser line)))
95 (let ((parser (make-instance 'xdump-parser)))
96 (setf (line-parser parser) #'header-parser)
100 (let ((parser (make-parser)))
101 (setf *current-parser* parser)
102 (loop for line = (read-line stream nil)
103 while line do (parse-line parser line))))
105 (defun test-parse (filename)
106 (with-open-file (s filename)
109 (defun xd-test (input)
111 do (empire::handle-data *mode* m)))
114 (test-parse "xdump-meta-meta.txt"))