Browse Source

deal with handover berths (poorly)

master
eta 1 week ago
parent
commit
beaee05504
  1. 16
      trackernet.lisp

16
trackernet.lisp

@ -4464,6 +4464,12 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping. @@ -4464,6 +4464,12 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping.
(subseq train #.(length "X-train-")))
(redis-train (+ ts 1) "X" "X-DEL" fake-train)))))
(defparameter *xrcos-handover-berths*
'("0091" "0099" "095S" ; GWML end
"0233" "0243" ; GEML end
"COUT" ; not used but here just for safety
))
(defun stomp-td-message-handler (message-type body)
"Handles a STOMP message."
(unless (member message-type '(:+CA-MSG+ :+CB-MSG+ :+CC-MSG+ :+CT-MSG+))
@ -4557,7 +4563,15 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping. @@ -4557,7 +4563,15 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping.
berth rescue-headcode headcode)
(rescue-train (format nil "X-train-~A" rescue-headcode)
(format nil "X-train-~A" headcode))
(red:del (format nil "X-train-~A" rescue-headcode))))))
(red:del (format nil "X-train-~A" rescue-headcode)))
;; FIXME(eta): actually handle GWML/GEML transitions
;; the Q0 TD doesn't send deletes or steps to COUT for handover
;; berths, but we only use that TD, so just delete trains to
;; keep them from sticking
(when (member berth *xrcos-handover-berths*
:test #'string=)
(log:info "train ~A in handover berth, deleting" headcode)
(enqueue-td-deletion headcode)))))
(defvar *current-stomp-td-backoff* 1)

Loading…
Cancel
Save