root/lang/gauche/irc-logger/trunk/rssfeed-gen.scm @ 45

Revision 43, 3.1 kB (checked in by naoya_t, 16 years ago)

irc-logger in Gauche : first import

Line 
1;;;
2;;; generate rss-1.0 from recent logs
3;;;
4;;; (c)2008 naoya_t
5;;;
6(require "./setting")
7(require "./lib/rawlog")
8
9(use srfi-19) ; date
10
11(define today-jd (date->julian-day (current-date)))
12
13(define (rss-1.0 links items)
14  (string-append
15   "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
16<?xml-stylesheet href=\"./rdf.xsl\" type=\"text/xsl\"?>
17<rdf:RDF xmlns:image=\"http://purl.org/rss/1.0/modules/image/\"
18  xmlns:taxo=\"http://purl.org/rss/1.0/modules/taxonomy/\"
19  xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
20  xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\"
21  xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
22  xmlns:content=\"http://purl.org/rss/1.0/modules/content/\"
23  xmlns:trackback=\"http://madskills.com/public/xml/rss/module/trackback/\"
24  xmlns=\"http://purl.org/rss/1.0/\">
25  <channel rdf:about=\"" rss-output-dir-url "\">
26    <title>IRC " irc-channel " log</title>
27    <link>" logview-root-url "</link>
28    <description>" irc-channel " on " irc-server "</description>
29    <items>
30      <rdf:Seq>
31"
32   (string-join (map (cut format "        <rdf:li resource=\"~a\"/>\n" <>) links) "")
33"     </rdf:Seq>
34    </items>
35    <taxo:topics>
36      <rdf:Bag/>
37    </taxo:topics>
38  </channel>
39"
40  (string-join items "")
41"
42</rdf:RDF>"))
43
44(define (hh:mm:dd->sec hh:mm:dd)
45  (fold (lambda (x y) (+ x (* y 60))) 0 (map string->number (string-split hh:mm:dd ":"))))
46
47(let loop ([ofs 1] [links '()] [items '()])
48  (let ([last_t 86399]
49                [sep #f])
50        (define (plain-filter timestamp user cmd room msg)
51          (let1 msg (regexp-replace #/</ msg "&lt;")
52                (case cmd
53                  [(JOIN PART QUIT) #f]
54                  [(PRIVMSG)
55                   (let1 t (hh:mm:dd->sec timestamp)
56                         (let1 s (format "~a~a &lt;~a&gt; ~a<br/>\n"
57                                                         (if (< (+ last_t 3600) t) "<hr>\n" "") ; separator
58                                                         timestamp user msg)
59                           (set! last_t t)
60                           s))]
61                  [(NICK)
62                   (format "~a &lt;~a =&gt; ~a&gt;<br/>\n" timestamp user msg)]
63                  [(TOPIC)
64                   (format "~a &lt;~a&gt; TOPIC => ~a><br/>\n" timestamp user msg)]
65                  [else #f])))
66       
67        (let* ([d (julian-day->date (- today-jd ofs))]
68                   [date-str (date->string d "~Y-~m-~d")] ;;(format "~4,'0d-~2,'0d-~2,'0d" (date-year d) (date-month d) (date-day d))]
69                   [content (daily-log date-str plain-filter)])
70                   (if (and (<= ofs 3) content)
71                           (let* ([link (logview-url date-str)]
72                                          [description (string-append (substring content 0 (min (string-length content) 100)) " ...")]
73                                          [content-br (regexp-replace #/\n/ content "<br/>\n")]
74                                          [title date-str]
75                                          [subject date-str]
76                                          [item (format
77"  <item rdf:about=\"~a\">
78    <title>~a</title>
79    <link>~a</link>
80    <description>~a</description>
81    <dc:subject>~a</dc:subject>
82    <dc:date>~aT00:05:00+09:00</dc:date>
83    <taxo:topics>
84      <rdf:Bag/>
85    </taxo:topics>
86    <content:encoded><![CDATA[~a]]></content:encoded>
87  </item>" link title link description subject date-str content-br)
88                                                        ])
89                                 (loop (+ ofs 1)
90                                           (cons link links)
91                                           (cons item items)))
92                           (with-output-to-file (string-append rss-output-dir "/" rdf-name)
93                                 (lambda ()
94                                   (print (rss-1.0 (reverse! links) (reverse! items)))
95                                   ))
96                           ))))
Note: See TracBrowser for help on using the browser.