blob: eea2a63d35f935fdfecab3ee210f681e10eb3f63 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
#!/usr/bin/guile \
-s
!#
;;; Commentary:
;; Bulids an index of "all" locations at LiU, and prints it as a JSON
;; object on the form { "location name": "url-fragment", ... }. These
;; fragments should be appended to the base "https://old.liu.se/karta/".
;;
;; See static/user/user-additions.js for this script in action.
;;; Code:
(use-modules (srfi srfi-1)
(web client)
(web response)
(ice-9 rdelim)
(ice-9 format)
(sxml gumbo)
(sxml match)
(json))
(define-values (response body) (http-get "https://old.liu.se/karta/list?l=sv"))
(unless (= 200 (response-code response))
(format #t "Fetching index failed with ~a ~a~%"
(response-code response)
(response-reason-phrase response))
(format #t "~{~s~%~}" (response-headers response))
(exit 1))
(define data (html->sxml body))
(define rx (make-regexp "^karta\\?"))
(define links
(map (lambda (node)
(sxml-match node
[(a (@ (href ,href)) ,b0 ,body ...)
(cons href b0)]))
(((@ (sxml xpath) sxpath) '(// a)) data)))
(define map-links (filter (lambda (pair) (regexp-exec rx (car pair)))
links))
(define link-table (make-hash-table))
(for-each (lambda (pair) (hash-set! link-table (string-upcase (string-trim-both (cdr pair)))
(car pair)))
map-links)
(scm->json (hash-map->list (lambda (name frag)
`(,name . ,frag))
link-table))
(newline)
|
