Browse Source

fix stupid archiving / rescue behaviours, use log4cl, reorg code

master
eta 2 months ago
parent
commit
5343986441
  1. 3
      deploy.sh
  2. 3
      deploy.txt
  3. 1037
      trackernet.lisp
  4. 50
      wobsite.lisp

3
deploy.sh

@ -1,3 +1,2 @@
#!/bin/sh
echo '*** NB: press Enter after the text stops scrolling past!'
sbcl < deploy.txt
sbcl --noinform --load deploy.txt

3
deploy.txt

@ -1,5 +1,6 @@
(ql:quickload '(drakma cl-conspack cxml cl-statsd cl-redis qbase64 archive cl-ansi-text gzip-stream bobbin cl-heap local-time))
(ql:quickload '(drakma cl-conspack cxml cl-statsd cl-redis qbase64 archive cl-ansi-text gzip-stream bobbin cl-heap local-time log4cl) :silent t)
(load "trackernet.lisp")
(require :sb-sprof)
(format t "** Loaded ~A track links **~%" (hash-table-size trackernet::*normalized-track-links*))
(sb-ext:save-lisp-and-die "./intertube-scraper" :toplevel #'trackernet::main :executable t)

1037
trackernet.lisp

File diff suppressed because it is too large

50
wobsite.lisp

@ -129,6 +129,11 @@
<path fill=\"currentColor\" d=\"M0 0h13l20 20-20 20H0l20-20z\" />
</svg>")
(defparameter *govuk-go-arrow-small-svg*
"<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"8.75\" height=\"9.5\" viewBox=\"0 0 33 40\" aria-hidden=\"true\" focusable=\"false\">)
<path fill=\"currentColor\" d=\"M0 0h13l20 20-20 20H0l20-20z\" />
</svg>")
(defun train-objects-on-line (code)
(let ((active (trackernet::trains-active-on-line code)))
(mapcan (lambda (active-key)
@ -224,7 +229,7 @@
do (write-byte byte out))
(close in)))))
(defun display-trackernet-train (train &key code ts reporter distance)
(defun display-trackernet-train (train &key code ts reporter distance show-dest maybe-hide-codes)
(who:with-html-output-to-string (*standard-output* nil
:prologue nil)
(:tr
@ -266,13 +271,26 @@
:class "govuk-table__cell id-field no-phones"
(unless (string= (trackernet::lcid train) "0")
(who:esc (trackernet::lcid train))))
(:td ; Destination
(:td ; Location / destination
:class "govuk-table__cell govuk-!-width-two-thirds"
(:span
(who:esc (or
(cdr (assoc (trackernet::track-code train)
(cached-track-suggestions "D")
:test #'string=))
(trackernet::location-desc train)
"<somewhere>"))
(who:str " ")
(when show-dest
(who:htm
(:span
:style "color: darkgray;"
(who:str *govuk-go-arrow-small-svg*)
" "
(who:esc (or
(trackernet::destination-desc train)
"<somewhere>")))
(who:str " ")))
(when code
(who:htm
(:a
@ -284,7 +302,8 @@
(when reporter
(who:htm
(:strong
:class "govuk-tag govuk-tag--yellow train-reporter"
:class "govuk-tag govuk-tag--yellow train-reporter no-phones"
:style "float: right; margin-left: 10px;"
(who:esc reporter))
(who:str " ")))
(when (and code
@ -294,8 +313,17 @@
(:strong
:class "govuk-tag govuk-tag--red train-stale"
"Stale")))
(:strong
:class "govuk-tag govuk-tag--grey train-track-code"
(:a
:href (multiple-value-bind (around hmac)
(trusted-serialize (list (trackernet::track-code train)))
(format nil "/miniviz?around=~A&hmac=~A"
(hunchentoot:url-encode
around)
(hunchentoot:url-encode
hmac)))
:class (if maybe-hide-codes
"govuk-tag govuk-tag--grey train-track-code no-phones"
"govuk-tag govuk-tag--grey train-track-code")
(who:esc (trackernet::track-code train))))))))
(defparameter *max-train-lines* 100)
@ -443,6 +471,7 @@
:class "govuk-table__body"
(loop
with last = nil
with last-dest = nil
for (ts reporter train) in train-data
for i from 0
unless (or
@ -450,7 +479,9 @@
(>= i max-to-show))
do (who:str (display-trackernet-train train
:ts ts
:show-dest (not (string= (trackernet::destination-desc train) last-dest))
:reporter reporter))
(setf last-dest (trackernet::destination-desc train))
(setf last (trackernet::track-code train))))
(unless (>= max-to-show train-data-len)
(who:htm
@ -511,7 +542,8 @@
(cdr match))))
`((:name . ,name)
(:code . ,(car match)))))
matches))))
(delete-if (lambda (match) (string= (cdr match) "At Platform"))
matches)))))
(defun now-london-time-str ()
(local-time:format-timestring
@ -587,6 +619,8 @@
for (distance key train) in train-list
do (who:str (display-trackernet-train train
:distance distance
:maybe-hide-codes t
:show-dest t
:code key)))))))))
(hunchentoot:define-easy-handler (line :uri "/line") (code)
@ -641,7 +675,7 @@
(:div
:id "trackcode-hint"
:class "govuk-hint"
"Start typing the name of a station, platform, or track code.")
"Start typing the name of a station to show a list of options.")
(:div
:id "trackcode-autocomplete-container"
(:input
@ -830,7 +864,7 @@
(push (hunchentoot:create-folder-dispatcher-and-handler "/fonts/" "./fonts/")
hunchentoot:*dispatch-table*)
(defparameter *redis-port* 3000)
(defparameter *redis-port* 6379)
(defmethod hunchentoot:acceptor-dispatch-request :around (acceptor request)
(redis:with-connection (:port *redis-port*)

Loading…
Cancel
Save