Extend driver to dump all tables.
authorGerd Flaig <gefla@pond.sub.org>
Sat, 10 Oct 2009 17:15:25 +0000 (19:15 +0200)
committerGerd Flaig <gefla@pond.sub.org>
Sat, 10 Oct 2009 17:15:25 +0000 (19:15 +0200)
empire.lisp

index 8a83ac0082f6a1806dab2c98a55cf48c9157b15d..433f29fd470634ebf4cab588af24c7ebbe9f8896 100644 (file)
 
 (defclass xdump-mode (play-mode)
   ((parser :initform (xdump:make-parser))
 
 (defclass xdump-mode (play-mode)
   ((parser :initform (xdump:make-parser))
-   (phase :initform :meta-meta)))
+   (phase :initform :meta-meta)
+   (dump-queue :initform nil)
+   (dump-index :initform 0)))
 
 (defmethod handle-data ((m xdump-mode) message)
 
 (defmethod handle-data ((m xdump-mode) message)
-  (with-slots (connection parser phase) m
+  (with-slots (connection parser phase dump-queue dump-index) m
     (if (xdump:parse-line parser message)
        ;;XXX consider something like a 'pop-mode function
        (ccase phase
     (if (xdump:parse-line parser message)
        ;;XXX consider something like a 'pop-mode function
        (ccase phase
                 parser (xdump:make-parser))
           (send-message connection "xdump meta table"))
          (:meta-table
                 parser (xdump:make-parser))
           (send-message connection "xdump meta table"))
          (:meta-table
-          (setf phase :table
+          (setf phase :table-table
                 parser (xdump:make-parser))
           (send-message connection "xdump table *"))
                 parser (xdump:make-parser))
           (send-message connection "xdump table *"))
-         (:table
-          (set-new-mode (connection-mode connection) 'play-mode))))))
+         (:table-table
+          (setf phase :tables-meta
+                dump-queue (xdump::table-entries (xdump::get-table "table"))
+                dump-index 0
+                parser (xdump:make-parser))
+          (send-message connection (format nil "xdump meta ~a" (xdump-data::table-name (aref dump-queue 0)))))
+         (:tables-meta
+          (setf phase :tables-content
+                parser (xdump:make-parser))
+          (send-message connection (format nil "xdump ~a *" (xdump-data::table-name (aref dump-queue dump-index)))))
+         (:tables-content
+          (if (< dump-index (fill-pointer dump-queue))
+              (progn (setf phase :tables-meta
+                           parser (xdump:make-parser))
+                     (incf dump-index)
+                     (loop while (and (< dump-index (fill-pointer dump-queue))
+                                      (null (aref dump-queue dump-index)))
+                        do (incf dump-index))
+                     (if (and (<= dump-index (fill-pointer dump-queue))
+                              (not (null (aref dump-queue dump-index))))
+                         (send-message connection (format nil "xdump meta ~a" (xdump-data::table-name (aref dump-queue dump-index))))))
+              (set-new-mode (connection-mode connection) 'play-mode)))))))
 
 (defmethod special-xup ((c connection))
   (send-message c "xdump meta meta" :next-mode 'xdump-mode))
 
 (defmethod special-xup ((c connection))
   (send-message c "xdump meta meta" :next-mode 'xdump-mode))