X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=empire.lisp;h=f4fb8b2a7619525dd1337fd97ce5c662251d3fa7;hp=8a1689be7899a089754b8eb98127cd2f2b4bab94;hb=54e14006564ff34c8249b9ddb357201759d77101;hpb=c61f30ca70589a5ea3e532a313722ecb3f109b53 diff --git a/empire.lisp b/empire.lisp index 8a1689b..f4fb8b2 100644 --- a/empire.lisp +++ b/empire.lisp @@ -9,6 +9,8 @@ (defvar *default-empire-server* "localhost") (defvar *default-empire-server-port* 6665) +(defvar *last-active-connection* nil) + (defclass connection () ((user :initarg :user @@ -268,6 +270,7 @@ (let* ((s (network-stream c)) (line (read-line s))) (empire-log:info "~a: < ~a" c line) + (setf *last-active-connection* c) (multiple-value-bind (message type) (parse-server-line line) (let ((handler (lookup-handler type)) (mode (connection-mode c))) @@ -287,6 +290,7 @@ (defgeneric send-message-one (connection string)) (defmethod send-message-one ((c connection) message) (empire-log:info "~a: > ~a" c message) + (setf *last-active-connection* c) (let ((s (network-stream c))) (raw-send-message s message))) @@ -310,39 +314,51 @@ (defmethod handle-data ((m xdump-mode) message) (with-slots (connection phase dump-queue dump-index) m - (if (xdump:parse-line (xdump connection) message) - ;;XXX consider something like a 'pop-mode function - (ccase phase - (:meta-meta - (setf phase :meta-table) - (send-message connection "xdump meta table")) - (:meta-table - (setf phase :table-table) - (send-message connection "xdump table *")) - (:table-table - (setf phase :tables-meta - dump-queue (xdump::table-entries (xdump::get-table "table")) - dump-index 0) - (send-message connection (format nil "xdump meta ~a" (xdump-data::table-name (aref dump-queue 0))))) - (:tables-meta - (setf phase :tables-content) - (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) - (incf dump-index) - (loop while (and (< dump-index (fill-pointer dump-queue)) - (let ((dump-queue-entry (aref dump-queue dump-index))) - (or (null dump-queue-entry) - (string= "meta" (xdump-data::table-name dump-queue-entry))))) - 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))))))) + (xdump:with-parser (xdump connection) + (if (xdump:parse-line (xdump connection) message) + ;;XXX consider something like a 'pop-mode function + (ccase phase + (:meta-meta + (setf phase :meta-table) + (send-message connection "xdump meta table")) + (:meta-table + (setf phase :table-table) + (send-message connection "xdump table *")) + (:table-table + (setf phase :meta-type) + (send-message connection "xdump meta meta-type")) + (:meta-type + (setf phase :type-table) + (send-message connection "xdump meta-type *")) + (:type-table + (setf phase :tables-meta + dump-queue (xdump::table-entries (xdump:table "table")) + dump-index 0) + (send-message connection (format nil "xdump meta ~a" (xdump-data:name (aref dump-queue 0))))) + (:tables-meta + (setf phase :tables-content) + (send-message connection (format nil "xdump ~a *" (xdump-data:name (aref dump-queue dump-index))))) + (:tables-content + (if (< dump-index (fill-pointer dump-queue)) + (progn (setf phase :tables-meta) + (incf dump-index) + (loop while (and (< dump-index (fill-pointer dump-queue)) + (let ((dump-queue-entry (aref dump-queue dump-index))) + (or (null dump-queue-entry) + (string= "meta" + (xdump-data:name dump-queue-entry))))) + 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:name (aref dump-queue dump-index)))))) + (progn + (xdump:checkpoint) + (set-new-mode (connection-mode connection) 'play-mode))))))))) (defmethod special-xup ((c connection)) - (send-message c "xdump meta meta" :next-mode 'xdump-mode)) + (let ((user-log (empire-log:open-user-log (user c)))) + (setf (xdump c) (xdump:make-parser :user-log user-log)) + (send-message c "xdump meta meta" :next-mode 'xdump-mode))) (defmethod special-command ((c connection) line) (cond ((string= line "xup") (special-xup c))