From 2faf053142e31d5c7cad8924cdfdb1e5fcb4c4a5 Mon Sep 17 00:00:00 2001 From: Gerd Flaig Date: Sun, 28 Jun 2009 17:07:14 +0200 Subject: [PATCH] Humble beginnings of an xdump parser --- xdump-34.txt | 16 +++++++ xdump-meta-34.txt | 4 ++ xdump-meta-meta.txt | 7 +++ xdump-test.lisp | 114 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 141 insertions(+) create mode 100644 xdump-34.txt create mode 100644 xdump-meta-34.txt create mode 100644 xdump-meta-meta.txt create mode 100644 xdump-test.lisp diff --git a/xdump-34.txt b/xdump-34.txt new file mode 100644 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 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 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 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")) -- 2.43.0