MOP experiment
[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 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)))
13
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))
17
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)))
23
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))
30
31 (defun meta-meta-finalizer (entry-buffer index)
32   (declare (ignorable index))
33   (loop
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*
43                for field in entry
44                do (setf (slot-value meta-meta slot) field))
45             (setf (aref *meta-meta* i) meta-meta))))
46
47 (defun meta-finalizer (entry-buffer index)
48   t)
49
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)))
55
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)))))
63
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)
68                         #'meta-meta-finalizer
69                         #'meta-finalizer))))
70
71 (defmethod parse-table ((parser xdump-parser) name timestamp)
72   (setf (line-parser parser) #'parse-entry))
73
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)
77     (if fullmatch
78         ;; meta table
79         (let ((name (aref groups 0))
80               (timestamp (parse-integer (aref groups 1))))
81           (parse-meta parser name timestamp))
82         ;; table
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))))))
89
90 (defmethod parse-line ((parser xdump-parser) line)
91   (with-slots (line-parser) parser
92     (funcall line-parser parser line)))
93
94 (defun make-parser ()
95   (let ((parser (make-instance 'xdump-parser)))
96     (setf (line-parser parser) #'header-parser)
97     parser))
98
99 (defun parse (stream)
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))))
104
105 (defun test-parse (filename)
106   (with-open-file (s filename)
107     (parse s)))
108
109 (defun xd-test (input)
110   (loop for m in input
111      do (empire::handle-data *mode* m)))
112
113 (defun t1 ()
114   (test-parse "xdump-meta-meta.txt"))