学校课表至ICS文件转化器
目录
1. 前言
此程序通过Guile实现，没有经验的读者可以尝试了解scheme语法。
2. 综述
为了解决学生课表不具有日历中事件类似的“按时提醒”、“消息同步”等等功能，我打算 实现一个可以将网页课表转化为ICS文件的程序，这样，“上课”这个动作就可以作为一个 事件被导入到日历中，由日历进行管理，这些功能缺失问题就可以迎刃而解。
3. 初步设想
对于我校课表，正常的查询路径是打开智慧江财平台，并在其中打开“我的课表”应用来查 询。
对“我的课表”进行分析后发现。其作为网页前端，会通过微信办事大厅来向我校后端服务
器发送课表请求，后端会返回一个html文件，其中记录着课表的详细信息，之后前端将后端
的内容挂载在 div#kbResult 来实现课表的显示。
而且，学校还为我们编写类似程序提供了一个便捷的通路：通过微信办事大厅请求课表，只
要求三个参数和一个cookie，分别是、请求载荷、学期、周数和一个包含 JSESSIONID 的
cookie 。只要我们的请求具有这四个东西，就可以成功获取信息，其中，请求载荷甚至
是固定的，只需要硬编码即可。
注意到，后端会返回一个纯html文件，针对这个文件，可以使用css选择器或者xpath来实现 对节点的选中并整合为事件数组。有了课程名称信息，结合学校课程时间和长度是固定的， 可以实现对时间的标注。
至于节假日，由于此方面信息具有不确定性，因此不决定实现对于节假日休假的特殊处理， 这一部分将会在导入到日历后由使用者自行调整。
4. 预实验
所谓预实验就是在正式实验之前进行的实验，可以确定正式实验的正确性，并给正式实验参 考价值。而这里的预实验是通过AI完成的，由AI编写简易Python脚本验证。
在经历一下午的时间之后，AI成功编写出对学校课表的处理脚本，验证其可行性。
5. 第一阶段：分析程序结构
此程序的行为是线性的，因此可以使用流水线的方式编写。
(chain (get-url datas)
(fetch-url _)
(process-html _)
(select-classes _)
(merge-same-classes _)
(produce-event _)
(write-to-file _ file))
对于其中传递的数据可以使用“流”数据结构进行抽象。流具有惰性计算的特性，可以减少 程序运行时内存的压力，同时“流”也提供了强大的编程支持，可以让我们像编写普通程序 一样来编写惰性处理代码：
;;; List Example
(map (lambda (nums) (+ num 1)) '(1 2 3)) ;=> (2 3 4)
;;; Stream Example
(stream-map (lambda (numbs) (+ num 1))
(list->stream '(1 2 3))) ;=> #<stream (2 3 4)>
而对于处理信息的函数，其本质上就是一个对流进行处理的函数：
FunctionInChain ::= Stream -> Stream
更激进一些，我们还可以将其视作一个把流中的单个元素映射到另一个元素的函数，只是其
嵌套在一个 stream-map 中。
FunctionInChain = stream-map <Function>
由此，我们可以得到这些函数的基本结构。
(define (function-in-chain stream)
(define (handle-elements elem)
(do-something elem))
(stream-map handle-elements stream))
而对于流的具体实现，我使用 SRFI-41 实现。
6. 第二阶段：网络信息获取
结合初步设想中发现的种种优势，网络信息获取的过程会相当简单。简单说，分三步，第一 步，从终端中获取各项参数，第二步，构建载荷，第三步，发送并获取课表信息。
6.1. 第一步：获取参数
对于命令行参数解析，我打算使用 SRFI-37 标准中的 args-fold 实现。
如果把命令看作一个函数，那么这个函数必须接受至少四个信息才能正常工作：
- 请求学期
- 开始时间
- 请求周次
- cookie信息
由此，设计命令行参数：
-s--semester：请求学期，以YYYY,S格式编码。示例：2026,0表示2026-2027 学年第一学期。-d--start-date：开始时间，以YYYY-MM-DD格式编码，通过开始时间，我们 得以以递推的形式求得每一个事件的具体时间。另外，由于软件实现的问题，这个时间 必须是周一，否则递推会不准确。-w--weeks：请求周次，以[0-9\,\-]+格式编码，这种格式可以展开为一个周 次列表。示例：1 -> 1 1,2 -> 1 2 1-3 -> 1 2 3 1,3,5-7 -> 1 3 5 6 7-c--cookie：cookie信息，一个十六进制值。为了简便起见，我不使用完整的 cookie信息，而是直接将此参数的值与JSEESIONID进行拼接来构建cookie。
对于具体实现方式，请参见 args-fold 文档并结合读者的自行思考，这里只给出一些可
能的要点：
option 过程需要第四个选项是一个处理器，这个处理器接受三个以上参数，而对于多出
的参数，按照标准是SEEDS，可以通过点对符号来将其打包声明为一个列表，同时，此函数
的返回值作为下一个函数的SEEDS参数传递，此时不能直接返回一个列表，否则，再经历一
次点对符号的打包声明，结果就会成为一个嵌套的列表，随着处理的深入，列表只会越嵌套
越深。
在这种情况下，请使用 values 过程来实现多参数传递。同时记得，一定要在
args-fold 中把所有的参数给出来，如果没有，就会报出参数数量不符的错误。
当然，根据开闭原则，更好的做法可能是使用 alist 传递信息，因为这个数据结构可以
实现添加新选项时不需要改动其他处理器。
对于以上要求可以编写参数处理器：
(define option-list
(list (option '(#\s "semester") #t #t
(lambda (opt name arg semester date weeks cookie)
(values arg date weeks cookie)))
(option '(#\d "start-date") #t #t
(lambda (opt name arg semester date weeks cookie)
(values semester arg weeks cookie)))
(option '(#\w "weeks") #t #t
(lambda (opt name arg semester date weeks cookie)
(values semester date arg cookie)))
(option '(#\c "cookie") #t #t
(lambda (opt name arg semester date weeks cookie)
(values semester date weeks arg)))))
(define (handle-oprand oprand . seeds)
(format #t "Wrong Arg: ~s~%" oprand)
(quit 1))
(define (handle-unknown-opt opt name arg . seeds)
(format #t "Wrong Opt ~s with Arg ~s~%" name arg)
(quit 1))
(args-fold (cdr (command-line)) handle-unknown-opt handle-oprand
'() '() '() '())
当然以上的代码只是一个示例，实际上的脚本会更加复杂。
在得到以上参数的时候，我们即可开始下一阶段。
6.2. 第二步：组合URI对象
这一阶段主要由两步组成，一个是组合URI对象，另一个就是执行http请求。
通过周数参数，我们可以获得需要生成哪些周次的信息，这些信息全部记录在参数字符串中。 有了这些信息，以及相对固定不变的其他各项信息，我们可以相对轻松的组织URI对象。
在组合URI之前，首先把周次展开，周次可以看作由逗号分隔的，可能是单个周也可能是一 个周组的列表。同时一个周组可以看作是一个记录着起始和结束信息的一对信息。在周组生 成之后，可以拉平为一个列表
由此我们确定周次处理的类型和机制：
expand-week ::= String -> Stream week
(define (expand-week week-str)
(define (range start stop)
(iota (+ 1 (- stop start)) start))
(define (handle-week-or-week-range input)
(define (handle-week-range)
(let* ((range-group
(map string->num (string-split #\- input)))
(start (list-ref range-group 0))
(stop (list-ref range-group 1)))
(range start stop)))
(define (hadnle-week)
(list (string->num input)))
(if (string-contains input "-")
(handle-week-range)
(handle-week)))
(chain (string-split #\, week-str)
(map handle-week-or-week-range _)
(concatnate _)
(list->stream _)))
以上代码主要做的事情就是把字符串以逗号为分隔符拆分为列表，并对列表中的每一项进行
处理，如果是一个不包含横杠的字符串，就是一个简单的单周，但是为了类型统一，需要使
用 list 进行处理，如果是一个包含横杠的字符串就拆分为具有两个元素的列表，对这个
列表进行拆分，得到的第一项与第二项分别传递给 range 函数。
得到这些之后把结果组织为列表，这样就是一个列表套列表的结构，但是这种结构后续处理
时不好处理，因此需要拉平为一个列表。具体来说就是使用 concatnate 函数，这个函数
在 SRFI-1 中有定义，我不打算细说。
在得到这个列表之后，我们需要将列表映射为一个流来方便处理。
对于周数流，我们可以在得到学期信息后来构建URI对象，由此定义
produce-uri ::= Stream week -> semester -> Stream uri
(define (build-frag-from-alist alist)
(define (handle-entry entry)
(let ((key (car entry))
(val (cdr entry)))
(string-append key "=" val)))
(define (merge-to-string str-list)
(define (concat-two-string str1 str2)
(append str1 "&" str2))
(reduce concat-two-string str-list))
(define (prepend-question-mark str)
(append "?" str))
(chain (map handle-entry alist)
(merge-to-string _)
(prepend-question-mark _)))
(define (produce-uri week-stream semester)
(define (handle-week week)
(build-uri 'http
#:host school-host
#:path class-table-path
#:fragments (chain static-data-alist
(acons "weeks" week _)
(acons "xqxn" semester _)
(build-frag-from-alist _)))
)
(stream-map handle-week week-stream))
其中使用到的库有 (web uri) 。
另外，其中出现的 static-data-alist class-table-path 以及 school-host 是几
个预定义的数据，具体值将不会出示，在附件中可以获取。
以上代码处理周数数据自顶向下分两步：
- 首先，组建URI对象，根据提前定义的值和
fragments以及周数，我们得以构建URI。 - 其次，构建
fragments参数字符串，我们可以通过关联列表与Fragments列表的相似 性来编写代码，在每一个条目中的键值对中间使用等号来连接，而对于条目之间，使用 “&”连接，最后在前方添加一个 “?” 即可。
这样就可以构建出URI来了。
6.3. 第三步：获取HTML数据
在这一步，需要快速的对文件进行下载，否则Cookie过期就会导致下载数据不完整，这里推 荐使用多线程下载来提高速度。
make-http-request ::= Stream uri -> Stream html
(define (make-http-request uri-strm cookie)
(define (handle-uri uri)
(define (perfrom-request)
(http-get
uri
#:headers
`((Cookies . ,(string-append "JSESSIONID=" cookie)))))
(let-values (((stat body) perfrom-request))
(if (equal? 200 (response-code stat))
body
(quit 2))))
(chain (stream->list uri-strm)
(par-map handle-uri _)
(list->stream _)))
上面的代码使用到了这些库： (web client) (ice-9 threads)
这里，我把传入的 cookie 变量与 JSESSIONID= 进行拼接，这也就可以得到符合格式
的Cookies。只有这样服务器才可以辨认身份，同时鉴权。
另外， http-get 函数的返回值是两个，第一个是http连接的状态，第二个是实际接受的
数据，所以我们需要把这两个值解构出来并返回我们需要的实际接受数据。
当然，需要按照返回状态来进行分支，如果不是一个成功的请求，则应该弹出，并报错，如 果是一个成功的请求，就按照上面的流程继续做。
7. 第三阶段：处理HTML数据成为事件的中间表示
这一阶段主要分为四个步骤：
7.1. 第一步：转化格式
上一阶段成功获得了HTML的字符串，有了这些字符串，我们就可以尝试将其解析为Guile可 以理解的格式，并加以处理。
produce-shtml ::= Stream html -> Stream shtml
(define (produce-shtml html-strm)
(define (handle-html html)
(html->shtml html))
(stream-map handle-html html-strm))
这一阶段相对简单，其中使用到的 html->shtml 来自于库 (htmlprag) 。
7.2. 第二步：选择数据
对于存在表中的数据，我们主要需要的是表中的数据，而由于学校在处理课表数据时可能出 现的错误以及表本身的复杂性，我们需要一个DSL语言来辅助完成选择的过程。
这里隆重介绍XML与HTML元素选择器库： (sxml xpath) 。
这个库中包含着一个可以将特定列表展开为一个函数的特殊的函数： sxpath 。有了这个
函数的帮助，我们得以实现编写较少的代码实现复杂的选择功能。
((sxpath path) sxml-or-shtml-data)
这是这个函数的基本用法，而在这个项目中，其具体代码如下：
((sxpath '(html body html body div table tbody tr)) _)
组合为符合格式的代码即为：
(define (select-data shtml-strm)
(let ((path '(html body html body div table tbody tr)))
(stream-map (sxpath path) shtml-strm)))
7.3. 第三步：打上标签
这一步至关重要，给中间数据打上标签才可以让数据携带方便后续处理为ICS事件的信息。 而对于事件的中间表示，可以简单一些，甚至这个时候可以选择不解析课程消息字符串，而 留着以后解析。
经历上一步的处理，我们成功的把数据选择出来了，但是这个情况下的数据是shtml节点集，
无法直接使用，这一步主要是再次使用 sxpath 函数来选择所需数据，并将数据根据周次
以及时间顺序打上标签。
(define (label-nodes node-strm week-strm)
(define (handle-day node day)
(cons day
(let ((raw-data ((sxpath '(ul (*text* 2))) node)))
(if (null? raw-data)
#f
(string-term-both (car raw-data))))))
(define (handle-time node time)
(cons time
(map handle-day
((filter (sxpath '(@ valign *text*))) node)
(iota 7))))
(define (handle-node-set node week)
(cons week
(map handle-time node (iota 12))))
(stream-map handle-node-set node-strm week-strm))
经过这个函数的处理，原始的shtml数据就被处理为一个便于解析的值了。后续的函数在编 写时，可以较为方便的处理这些值。
7.4. 第四步：转化为事件的中间表示
另外，在这个阶段，我们不聚合数据，也就是说，一个具有三个连续课时的课程，在现在的 表示方法下，是三个独立的课程。
Entry ::= List ( class-info-str,
week-of-semester,
day-of-week,
time-of-day,
duration )
这一步的主要挑战是，如何把原数据中，周数、时间、周几的顺序处理为上述数据结构的顺 序。为了达成这个目标，我们可以定义辅助函数：
(define (make-entry info-str w d t)
(list info-str w d t 1))
在有了这个函数之后，我们应该如何处理数据呢？
这里的难点在于，需要处理的数据类型是一个嵌套的类型，在使用 map 函数进行映射的
时候无法直接把标签的值传入处理函数中。
我们知道，在Scheme编程语言中，常常可以听到“闭包可以捕获环境中的变量”或者类似的 描述，当我们有了捕获环境变量的能力的时候，我们就可以通过闭包捕获的形式把函数包含 在其中。
(define (produce-event label-strm)
(define (handle-week week-time-list-pair)
(let ((week (car week-time-list-pair))
(time-list (cdr week-time-list-pair)))
(define (handle-time time-day-list-pair)
(let ((time (car time-day-list-pair))
(day-list (cdr time-day-list-pair)))
(define (handle-day day-info-pair)
(let ((day (car day-info-pair))
(info (cdr day-info-pair)))
(make-entry info week day time)))
(map handle-day day-list)))
(map handle-time time-list)))
(stream-map handle-week label-strm))
我相信有能力的读者一眼发现了一些问题，嵌套深度达到了惊人的7层，这在实践中是不提 倡的，由此，我们需要拆分层层嵌套的函数，即便其写的长一些也可以。
(define (produce-event label-strm)
(define (handle-day week time)
(lambda (day-info-pair)
(let ((day (car day-info-pair))
(info (cdr day-info-pair)))
(make-entry info week day time))))
(define (handle-time week)
(lambda (time-day-list-pair)
(let ((time (car time-day-list-pair))
(day-list (cdr time-day-list-pair)))
(map (handle-day week time) day-list))))
(define (handle-week week-time-list-pair)
(let ((week (car week-time-list-pair))
(time-list (cdr week-time-list-pair)))
(chain (map (handle-time week) time-list)
(list->stream _))))
(chain label-strm
(stream-map handle-week _)
(stream-concat _)))
像这样，通过函数应用来传递变量来拆分嵌套程序是可行的，这样做，可以让程序分层清晰。
7.5. 第五步：筛选与整合
这一步主要是处理数据流中表示“无课”的条目，以及可以合并为一节课的条目。
首先是筛选，由于之前我们对字符串的存在做了从表到假值或字符串的映射因此这里的代码 可以简单一些：
(define (filter-entry entry-strm)
(define (not-empty entry)
(car entry))
(stream-filter not-empty entry-strm))
其次是整合，对于课程的整合，首先看两个课程是否在可以整合的时间段，比如，第1-5节 课是可以整合的，而对于分别处于第五节，和第六节的课，无论如何也无法聚合。再就是看 课程信息字符串是否是一个字符串。
(define (entry-mergable? entry1 entry2)
(define (handle-each-list entry)
(lambda (mergable-list)
(if (member (cadddr entry) mergable-list)
#t
#f)))
(if (or (null? entry1) (null? entry2))
#f
(chain (values (map (handle-each-list entry1) mergable-time-list)
(map (handle-each-list entry2) mergable-time-list))
(map (lambda (a b) (and a b)) _ _)
(reduce (lambda (a b) (or a b)) #f _)
((lambda (a b) (and a b)) _ (equal? (car entry1)
(car entry2))))))
以上代码中 mergable-time-list 是提前定义的，表示可以合并的时间的列表的列表。这
么说可能有点拗口，以下是这个数据项的一个示例：
(define mergable-time-list
'((0 1 2 3 4)
(5 6 7 8)
(9 10 11)))
在一个列表中的数字代表着这两个事件是可以合并的。
如果这两个事件是可以合并的，那么就构造新的事件：
(define (list-update func lst pos)
(let loop
((prev '())
(curr (car lst))
(post (cdr lst))
(curr-pos 0))
(if (= pos curr-pos)
(append prev (cons (func curr) post))
(loop (append prev (list curr))
(car post)
(cdr post)
(1+ curr-pos)))))
(define (event-merge event1 event2)
(list-update 1+ event1 4))
构建新事件实际上就是把原来事件的第四项也就是课时数增加1。
在构建新事件时，应该创建一个新流，不应该在原有流的基础上进行修改，因为目前没有可
以实现类似功能的函数，只有 stream-fold 函数配合构建新流的函数才能产生我们需要
的数据。
(define (merge-entry entry-strm)
(define (handle-entry seed next)
(cond ((stream-null? seed) (stream-cons next seed))
((entry-mergable? (stream-car seed) next)
(stream-cons (entry-merge (stream-car seed next))
(stream-cdr seed)))
(else
(stream-cons next seed))))
(stream-fold handle-entry stream-null strm))
在合并好之后，就可以进行下一步了。
7.6. 第六步：转变为最终表示
这一步是重构整个事件，使其更容易处理。
一个事件，至少需要两个部分，一个是开始时间，一个是结束时间1。对于这两个元素， 都可以从上一个阶段中构建的事件的中间表示中通过计算获取。开始时间需要通过周数，天 数，开始课时时间来计算，而结束时间需要开始时间加上时间间隔，而时间间隔比较好算， 这里不做陈述。
(define (calc-duration-from-start w d t)
(make-time time-duration
(+ (* w 604800)
(* 86400 d)
(lookup-time t))))
其中 lookup-time 函数可以从全局的设置中查找 t 对应的相对于天的偏移量。
有了相对于开始时间的时间间隔我们就可以将这个时间间隔加到开始时间来计算开始时间了。
(define (calc-time start-date duration)
(add-duration (date->time-tai start-date) duration))
而计算结束时间相对简单：
(define (calc-duration-of-class class-length)
(make-time time-duration
(+ (* class-length 2700)
(* (- class-length 1) 900))))
甚至有一部分代码可以复用上面的代码。
当然，为了方便处理，字符串也需要重构为一个关联列表2，这里我选择使用正则表达 式库来辅助拆分字符串。
(define (prase-info-str-to-alist info-str)
(let* ((regex "^(.*) (.*)\\((.*) (.*)\\)$")
(full-match (string-match regex info-str))
(class-name (match:substring full-match 1))
(teacher-name (match:substring full-match 2))
(including-week (match:substring full-match 3))
(location (match:substring full-match 4)))
(chain '()
(acons 'class-name class-name _)
(acons 'teacher-name teacher-name _)
(acons 'including-week including-week _)
(acons 'location location _)
(acons 'full-string info-str _))))
有了这些函数，我们终于可以构建最终的中间表示了。
(define (produce-event entry-strm start-date)
(define (handle-entry entry)
(let* ((info-str (list-ref entry 0))
(info-alist (prase-info-str-to-alist info-str))
(week (list-ref entry 1))
(day (list-ref entry 2))
(time (list-ref entry 3))
(duration (list-ref entry 4))
(start-offset (calc-duration-from-start week day time))
(end-offset (calc-duration-of-class duration))
(start-time (calc-time start-date start-offset))
(end-time (add-duration start-time end-offset)))
(chain info-alist
(acons 'start-time start-time _)
(acons 'end-time end-time _))))
(stream-map handle-entry))
8. 第四阶段：转化为ICS事件
这个阶段就比较直接，把日期和时间记录转化为一个UTC时间字符串，之后按照之前的解析 数据组合为描述字符串即可。
(define (date->utc-string date)
(date->string date "~Y~m~dT~H~M~SZ"))
(define (time-tai->utc-string time)
(date->utc-string (time-tai->date time 0)))
(define (date->rtime-string date)
(date->string date "~Y~m~dT~H~M~S"))
(define (time-tai->rtime-string time)
(date->rtime-string (time-tai->date time)))
(define (make-prop key val . param)
(make <ics-property> #:type key
#:value val
#:parameters (if (pair? param) (car param) '())))
(define (make-vevent-from-event uid dtstart dtend sum des . rest)
(make <ics-object> #:name "VEVENT"
#:properties
(cons* (make-prop "UID" uid)
(make-prop "DTSTAMP" (date->utc-string (current-date 0)))
(make-prop "DTSTART" dtstart)
(make-prop "DTEND" dtend)
(make-prop "SUMMARY" sum)
(make-prop "DESCRITPION" des)
rest)))
(define (to-ics-vevent event-strm)
(define (handle-event event)
(define (make-uid start-time)
(time-tai->rtime-string start-time))
(define (make-description class-name
teacher-name
including
location
full-str)
(string-append
"课程名称：" class-name "\n"
"教师名称：" teacher-name "\n"
"包括周次：" including-name "\n"
"上课位置：" location "\n"
"原始数据：" full-str)
)
(let ((class-name (assoc-ref event 'class-name))
(teacher-name (assoc-ref event 'teacher-name))
(including (assoc-ref event 'including-week))
(location (assoc-ref event 'location))
(full-str (assoc-ref event 'full-string))
(start-time (assoc-ref event 'start-time))
(end-time (assoc-ref event 'end-time)))
(make-vevent-from-event (make-uid start-time)
(time-tai->rtime-string start-time)
(time-tai->rtime-string end-time)
class-name
(make-description class-name
teacher-name
including
location
full-str))))
(stream-map handle-event event-strm))
而创建好ics事件之后，就是着手把ics事件包装为一个ics日历：
(define (make-vcal vevents . rest)
(make <ics-object> #:type "VCALENDER"
#:properties
(cons* (prop "VERSION" "2.0")
(prop "PRODID" juxfe-prodid)
rest)
#:components
vevents))
(define (warp-in-calender vevent-strm)
(make-vcal (stream->list vevent-strm)))
到了这一步，我们终于可以真正的把我们生成的所有的数据整个写入文件了。
(define (write-to-file vcal output-port)
(scm->ics output-port))
9. 总结
这就是整个程序了。此程序中应用了许多程序编写技巧，包括嵌套优化，流的构造等。
希望这篇文章可以帮助读者增进编程能力。