Humble beginnings of an xdump parser

diff --git a/xdump-34.txt b/xdump-34.txt
new file mode 100644 (file)
index 0000000..daea494
--- /dev/null
+++ b/xdump-34.txt
@@ -0,0 +1,16 @@
+XDUMP meta-type 1242293228
+1 "d"
+2 "g"
+3 "s"
+4 "d"
+5 "d"
+6 "d"
+7 "d"
+8 "d"
+9 "d"
+10 "d"
+11 "d"
+12 "d"
+13 "g"
+14 "c"
+/14

diff --git a/xdump-meta-34.txt b/xdump-meta-34.txt
new file mode 100644 (file)
index 0000000..b7abe4c
--- /dev/null
+++ b/xdump-meta-34.txt
@@ -0,0 +1,4 @@
+XDUMP meta meta-type 1242293224
+"value" 8 4 0 -1
+"name" 3 4 0 -1
+/2

diff --git a/xdump-meta-meta.txt b/xdump-meta-meta.txt
new file mode 100644 (file)
index 0000000..f672fb7
--- /dev/null
+++ b/xdump-meta-meta.txt
@@ -0,0 +1,7 @@
+XDUMP meta meta 1242293190
+"name" 3 4 0 -1
+"type" 4 4 0 34
+"flags" 5 12 0 33
+"len" 7 4 0 -1
+"table" 8 4 0 -1
+/5

diff --git a/xdump-test.lisp b/xdump-test.lisp
new file mode 100644 (file)
index 0000000..3a7846f
--- /dev/null
+++ b/xdump-test.lisp
@@ -0,0 +1,114 @@
+(in-package :xdump)
+
+(defparameter *mode* (make-instance 'empire::xdump-mode :connection nil))
+
+(defvar *current-parser* nil)
+
+(defclass meta-table ()
+  ((name :accessor meta-name)
+   (type :accessor meta-type)
+   (flags :accessor meta-flags)
+   (len :accessor meta-len)
+   (table :accessor meta-table)))
+
+(defvar *meta-by-index* (make-array 30 :fill-pointer 0 :adjustable t))
+(defvar *meta-index* (make-array 5))
+(defvar *meta-meta* (make-array 5))
+
+(defclass xdump-parser ()
+  ((line-parser :accessor line-parser :initform nil)
+   (entry-buffer :accessor entry-buffer :initform (make-array 1 :fill-pointer 0 :adjustable t))
+   (entry-index :accessor entry-index :initform 0)
+   (finalizer :accessor finalizer :initform nil)))
+
+(defgeneric finish-table (xdump-parser number-of-records))
+(defgeneric parse-entry (xdump-parser line))
+(defgeneric parse-meta (xdump-parser name timestamp))
+(defgeneric parse-table (xdump-parser name timestamp))
+(defgeneric header-parser (xdump-parser line))
+(defgeneric parse-line (xdump-parser line))
+
+(defun meta-meta-finalizer (entry-buffer index)
+  (declare (ignorable index))
+  (loop
+     for i = 0 then (+ i 1)
+     for e across entry-buffer
+     do (let* ((slot-name (string-upcase (car e)))
+              (slot (find-symbol slot-name :xdump)))
+         (setf (aref *meta-index* i) slot)))
+  (loop for entry across entry-buffer
+     for i = 0 then (+ i 1)
+     do   (let ((meta-meta (make-instance 'meta-table)))
+           (loop for slot across *meta-index*
+              for field in entry
+              do (setf (slot-value meta-meta slot) field))
+           (setf (aref *meta-meta* i) meta-meta))))
+
+(defun meta-finalizer (entry-buffer index)
+  t)
+
+(defmethod finish-table ((parser xdump-parser) number-of-records)
+  (if (not (equal number-of-records (length (entry-buffer parser))))
+      (error "Table row count mismatch"))
+  (with-slots (finalizer entry-buffer entry-index) parser
+    (funcall finalizer entry-buffer entry-index)))
+
+(defmethod parse-entry ((parser xdump-parser) line)
+  (if (char= #\/ (aref line 0))
+      (finish-table parser (parse-integer (subseq line 1)))
+      (let ((fields (mapcar #'read-from-string (cl-ppcre:split " " line))))
+       (with-slots (entry-buffer entry-index) parser
+         (vector-push-extend fields entry-buffer)
+         (incf entry-index)))))
+
+(defmethod parse-meta ((parser xdump-parser) name timestamp)
+  (with-slots (line-parser finalizer) parser
+    (setf line-parser #'parse-entry
+         finalizer (if (string= "meta" name)
+                       #'meta-meta-finalizer
+                       #'meta-finalizer))))
+
+(defmethod parse-table ((parser xdump-parser) name timestamp)
+  (setf (line-parser parser) #'parse-entry))
+
+(defmethod header-parser ((parser xdump-parser) line)
+  (multiple-value-bind (fullmatch groups)
+      (cl-ppcre:scan-to-strings "^XDUMP meta (.*) ([0-9]+)$" line)
+    (if fullmatch
+       ;; meta table
+       (let ((name (aref groups 0))
+             (timestamp (parse-integer (aref groups 1))))
+         (parse-meta parser name timestamp))
+       ;; table
+       (multiple-value-bind (fullmatch groups)
+           (cl-ppcre:scan-to-strings "^XDUMP (.*) ([0-9]+)$" line)
+         (declare (ignorable fullmatch))
+         (let ((name (aref groups 0))
+               (timestamp (parse-integer (aref groups 1))))
+           (parse-table parser name timestamp))))))
+
+(defmethod parse-line ((parser xdump-parser) line)
+  (with-slots (line-parser) parser
+    (funcall line-parser parser line)))
+
+(defun make-parser ()
+  (let ((parser (make-instance 'xdump-parser)))
+    (setf (line-parser parser) #'header-parser)
+    parser))
+
+(defun parse (stream)
+  (let ((parser (make-parser)))
+    (setf *current-parser* parser)
+    (loop for line = (read-line stream nil)
+       while line do (parse-line parser line))))
+
+(defun test-parse (filename)
+  (with-open-file (s filename)
+    (parse s)))
+
+(defun xd-test (input)
+  (loop for m in input
+     do (empire::handle-data *mode* m)))
+
+(defun t1 ()
+  (test-parse "xdump-meta-meta.txt"))