trackernet.lisp

@@ -813,6 +813,14 @@
           (redis::expect :bytes)
         (clear-input (redis::conn-stream redis::*connection*))))))
 
+(defun redis-raw-mget (&rest keys)
+  (return-from redis-raw-mget
+    (redis::with-reconnect-restart
+      (apply #'redis::tell 'mget keys)
+      (prog1
+          (redis::expect :multi-bytes)
+        (clear-input (redis::conn-stream redis::*connection*))))))
+
 (defun redis-raw-zrange (key min max &rest args)
   (return-from redis-raw-zrange
     (redis::with-reconnect-restart
@@ -879,6 +887,10 @@
       (cpk:with-named-index index
         (cpk:decode data)))))
 
+(defun redis-raw-mget-cpk (&rest keys)
+  (let ((data (apply #'redis-raw-mget keys)))
+    (mapcar #'cpk-unraw data)))
+
 (defun redis-last-score (key)
   "Gets the score of the last element of the sorted set with the Redis KEY."
   (let ((score (second
@@ -4935,17 +4947,13 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping.
               (setf (caar (last hash-entry)) train)))))
     (alexandria:hash-table-alist ret)))
 
-;; FIXME(eta): this is from wobsite.lisp, copypasta'd. This should be fixed.
 (defun live-trains-on-line (code)
-  (mapcan (lambda (ltid)
-            (let ((train-obj
-                    (ignore-errors
-                     (trackernet::redis-raw-get-cpk ltid))))
-              (when (and train-obj
-                         (string= (trackernet::line-code train-obj)
-                                  code))
-                (list train-obj))))
-          (red:smembers (format nil "line-trains:~A" code))))
+  (let ((keys (red:smembers (format nil "line-trains:~A" code))))
+    (when keys
+      (delete-if-not
+       (lambda (lt)
+         (and lt (string= (line-code lt) code)))
+       (apply #'redis-raw-mget-cpk keys)))))
 
 (defun live-trains-by-platform-on-line (code)
   (let ((ret (make-hash-table :test 'equal)))
@@ -5481,10 +5489,9 @@ Return four values: a set of nodes, edges, weights, and a new->old edge mapping.
                          0))
            (new (apply-sclass-delta existing message-type address data))
            (changed-bits (logxor existing new))
-           ;; FIXME(eta): This is somewhat inefficient...
+           ;; FIXME(eta): This is VERY inefficient...
            (live-trains
-             ;;(live-trains-by-platform-on-line "X")
-             (make-hash-table :test 'equal)))
+             (live-trains-by-platform-on-line "X")))
       (loop
         for (sig . bit) in (xrcos::get-mentioned-signals area changed-bits)
         do (alexandria:when-let*

wobsite.lisp

@@ -356,15 +356,7 @@
           *line-model-data*))
 
 (defun live-trains-on-line (code)
-  (mapcan (lambda (ltid)
-            (let ((train-obj
-                    (ignore-errors
-                     (trackernet::redis-raw-get-cpk ltid))))
-              (when (and train-obj
-                         (string= (trackernet::line-code train-obj)
-                                  code))
-                (list train-obj))))
-          (red:smembers (format nil "line-trains:~A" code))))
+  (trackernet::live-trains-on-line code))
 
 (defun live-train-wtt-id (lt &aux (ident (trackernet::train-identity lt)))
   (when (and ident (first ident))