tidmap, make overlong length pruning actually work

trackernet.lisp

@@ -545,12 +545,21 @@
 (defun redis-train (universal-ts line-code code-station train)
   (with-slots (train-id set-no trip-no lcid seconds-to track-code location-desc leading-car-no) train
     (when (and (or lcid train-id) seconds-to track-code)
-      (let* ((tid (or (if (and lcid (or (string= lcid "0")
-                                        (string= lcid "")))
-                          nil
-                          lcid)
-                      (format nil "tid~A" train-id)))
-             (key (format nil "~A-train-~A" line-code tid)))
+      (let* ((lcid (when (and lcid
+                              (not (string= lcid "0"))
+                              (not (string= lcid "")))
+                     lcid))
+             (tid (or lcid (format nil "tid~A" train-id)))
+             (tidmap-key (format nil "~A-tidmap-~A" line-code train-id))
+             (key (or (unless lcid (red:get tidmap-key))
+                      (format nil "~A-train-~A" line-code tid))))
+        (when (and (not lcid) (red:get tidmap-key))
+          (log:warn "using TrainID map for ~A => ~A; very naughty TfL!"
+                    tid key))
+        (when lcid
+          ;; set a mapping of tid -> actual key used
+          (red:setnx tidmap-key key)
+          (red:expire tidmap-key *train-active-expiry-secs-real*))
         ;; get a mapping of seconds to -> track code
         (red:zadd (format nil "~A-secs-to-track-code"
                           code-station)
@@ -613,12 +622,12 @@
           (length (get-trains pred)))))))
 
 (defun get-archivable-trains ()
-  "Returns a list of all trains that were last updated more than *TRAIN-ACTIVE-EXPIRY-SECS* ago."
+  "Returns a list of all trains that were last updated more than *TRAIN-ACTIVE-EXPIRY-SECS* ago, or have too many records."
   (let* ((trains (get-all "?-train-*"))
          (cutoff (- (get-universal-time) *train-active-expiry-secs*)))
     (delete-if-not (lambda (train)
-                     (and
-                      (< (redis-sorted-set-length train)
+                     (or
+                      (> (redis-sorted-set-length train)
                          *train-live-data-limit*)
                       (< (redis-last-score train) cutoff)))
                    trains)))
@@ -963,6 +972,15 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
   (get-all (format nil "~A-active-*"
                    line-code)))
 
+(defun all-trains-with-sizes ()
+  (sort
+   (mapcar
+    (lambda (trn)
+      (cons trn (redis-sorted-set-length trn)))
+    (get-all "?-train-*"))
+   #'>
+   :key #'cdr))
+
 (defun statsd-reporter-loop (line-code)
   (redis:with-connection ()
     (loop