Index: lang/gauche/irc-logger/trunk/logger-bot.scm
===================================================================
--- lang/gauche/irc-logger/trunk/logger-bot.scm (revision 43)
+++ lang/gauche/irc-logger/trunk/logger-bot.scm (revision 43)
@@ -0,0 +1,102 @@
+;;
+;; extract from OKUYAMA Atsushi's "IRCBOT", http://homepage3.nifty.com/oatu/gauche/try.html
+;;
+(use gauche.net)
+(use gauche.logger)
+(use gauche.threads)
+(use gauche.charconv)
+(use file.util)
+(use srfi-19)
+
+(require "./setting")
+
+;; ===============================================
+;; util
+
+(define (guard-read-line port)
+  (guard (exc
+          ((<read-error> exc) "read error.")
+          (else "error."))
+         (read-line port))
+  )
+
+;; ===============================================
+;; logging
+
+(define (make-log-path)
+  (build-path log-dir (date->string (current-date) "~Y-~m-~d.log"))
+  )
+
+(define log-drain (make <log-drain> :path (make-log-path) :prefix "~T: "))
+
+(define (write-log . msg)
+  (let1 msg1 (apply string-append msg)
+    (display msg1)
+    (newline)
+    (let1 path (make-log-path)
+      ;; log rotate
+      (unless
+          (string=? path (slot-ref log-drain 'path))
+        (set! log-drain (make <log-drain> :path path :prefix "~T: "))
+        ))
+    (log-format log-drain "~a" (ces-convert msg1 "*JP" log-encoding))))
+
+(define (write-debug-log . msg)
+  (when debug
+    (let1 msg1 (apply string-append msg)
+      (write-log "[DEBUG] " msg1))))
+
+;; ===============================================
+;; irc
+
+(define irc-socket
+  (make-client-socket 'inet irc-server irc-server-port))
+
+(define irc-socket-input-port
+  (open-input-conversion-port
+   (socket-input-port irc-socket :buffering #f)
+   irc-in-encoding))
+
+(define irc-socket-output-port
+  (open-output-conversion-port
+   (socket-output-port irc-socket :buffering #f)
+   irc-out-encoding))
+
+(define (irc-send-body . msg)
+  (let1 msg1 (apply string-append msg)
+    (display (string-append msg1 "\r\n") irc-socket-output-port)
+    (flush irc-socket-output-port)))
+
+(define (irc-send-internal . msg)
+  (let1 msg1 (apply string-append msg)
+    (write-debug-log "[SEND] " msg1)
+    (irc-send-body msg1)))
+
+(define (irc-send . msg)
+  (let1 msg1 (apply string-append msg)
+    (write-log "[SEND] " msg1)
+    (irc-send-body msg1)))
+
+;;;
+;;;
+;;;
+(irc-send "NICK " bot-nick)
+(irc-send "USER " bot-nick " " irc-server " " irc-client-address " " bot-nick)
+(irc-send "JOIN " irc-channel)
+
+(let loop ((str (string-incomplete->complete (guard-read-line irc-socket-input-port))))
+  (if (eof-object? str)
+      (begin (socket-close irc-socket))
+      (begin
+        (let ((str-list (string-split str " ")))
+          (cond ((string=? "PING" (list-ref str-list 0))
+                 (write-debug-log "[PING RECEIVED]" str)
+                 (irc-send-internal "PONG " (list-ref str-list 1)))
+                ((and (string=? "PRIVMSG" (list-ref str-list 1))
+                      (string=? bot-nick (list-ref str-list 2)))
+                 (write-log (string-append "msg got from " ((#/^[^!]*!/ (list-ref str-list 0)))))
+                 )
+                (else (write-log "[RECEIVED] " str)))
+          )
+        (loop (string-incomplete->complete (guard-read-line irc-socket-input-port))))
+      ))
Index: lang/gauche/irc-logger/trunk/rssfeed-gen.scm
===================================================================
--- lang/gauche/irc-logger/trunk/rssfeed-gen.scm (revision 43)
+++ lang/gauche/irc-logger/trunk/rssfeed-gen.scm (revision 43)
@@ -0,0 +1,96 @@
+;;;
+;;; generate rss-1.0 from recent logs
+;;;
+;;; (c)2008 naoya_t
+;;;
+(require "./setting")
+(require "./lib/rawlog")
+
+(use srfi-19) ; date
+
+(define today-jd (date->julian-day (current-date)))
+
+(define (rss-1.0 links items)
+  (string-append
+   "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+<?xml-stylesheet href=\"./rdf.xsl\" type=\"text/xsl\"?>
+<rdf:RDF xmlns:image=\"http://purl.org/rss/1.0/modules/image/\"
+  xmlns:taxo=\"http://purl.org/rss/1.0/modules/taxonomy/\"
+  xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
+  xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\"
+  xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
+  xmlns:content=\"http://purl.org/rss/1.0/modules/content/\"
+  xmlns:trackback=\"http://madskills.com/public/xml/rss/module/trackback/\"
+  xmlns=\"http://purl.org/rss/1.0/\">
+  <channel rdf:about=\"" rss-output-dir-url "\">
+    <title>IRC " irc-channel " log</title>
+    <link>" logview-root-url "</link>
+    <description>" irc-channel " on " irc-server "</description>
+    <items>
+      <rdf:Seq>
+"
+   (string-join (map (cut format "        <rdf:li resource=\"~a\"/>\n" <>) links) "")
+"     </rdf:Seq>
+    </items>
+    <taxo:topics>
+      <rdf:Bag/>
+    </taxo:topics>
+  </channel>
+"
+  (string-join items "")
+"
+</rdf:RDF>"))
+
+(define (hh:mm:dd->sec hh:mm:dd)
+  (fold (lambda (x y) (+ x (* y 60))) 0 (map string->number (string-split hh:mm:dd ":"))))
+
+(let loop ([ofs 1] [links '()] [items '()])
+  (let ([last_t 86399]
+		[sep #f])
+	(define (plain-filter timestamp user cmd room msg)
+	  (let1 msg (regexp-replace #/</ msg "&lt;")
+		(case cmd
+		  [(JOIN PART QUIT) #f]
+		  [(PRIVMSG)
+		   (let1 t (hh:mm:dd->sec timestamp)
+			 (let1 s (format "~a~a &lt;~a&gt; ~a<br/>\n"
+							 (if (< (+ last_t 3600) t) "<hr>\n" "") ; separator
+							 timestamp user msg)
+			   (set! last_t t)
+			   s))]
+		  [(NICK)
+		   (format "~a &lt;~a =&gt; ~a&gt;<br/>\n" timestamp user msg)]
+		  [(TOPIC)
+		   (format "~a &lt;~a&gt; TOPIC => ~a><br/>\n" timestamp user msg)]
+		  [else #f])))
+	
+	(let* ([d (julian-day->date (- today-jd ofs))]
+		   [date-str (date->string d "~Y-~m-~d")] ;;(format "~4,'0d-~2,'0d-~2,'0d" (date-year d) (date-month d) (date-day d))]
+		   [content (daily-log date-str plain-filter)])
+		   (if (and (<= ofs 3) content)
+			   (let* ([link (logview-url date-str)]
+					  [description (string-append (substring content 0 (min (string-length content) 100)) " ...")]
+					  [content-br (regexp-replace #/\n/ content "<br/>\n")]
+					  [title date-str]
+					  [subject date-str]
+					  [item (format
+"  <item rdf:about=\"~a\">
+    <title>~a</title>
+    <link>~a</link>
+    <description>~a</description>
+    <dc:subject>~a</dc:subject>
+    <dc:date>~aT00:05:00+09:00</dc:date>
+    <taxo:topics>
+      <rdf:Bag/>
+    </taxo:topics>
+    <content:encoded><![CDATA[~a]]></content:encoded>
+  </item>" link title link description subject date-str content-br)
+							])
+				 (loop (+ ofs 1)
+					   (cons link links)
+					   (cons item items)))
+			   (with-output-to-file (string-append rss-output-dir "/" rdf-name)
+				 (lambda ()
+				   (print (rss-1.0 (reverse! links) (reverse! items)))
+				   ))
+			   ))))
Index: lang/gauche/irc-logger/trunk/htdocs/rdf.xsl
===================================================================
--- lang/gauche/irc-logger/trunk/htdocs/rdf.xsl (revision 43)
+++ lang/gauche/irc-logger/trunk/htdocs/rdf.xsl (revision 43)
@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0"
+  xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
+  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+  xmlns:dc="http://purl.org/dc/elements/1.1/"
+  xmlns:rss="http://purl.org/rss/1.0/"
+  xmlns:content="http://purl.org/rss/1.0/modules/content/"
+  exclude-result-prefixes="rdf rss dc content">
+
+  <xsl:output method="html" />
+
+  <xsl:template match="/">
+    <xsl:apply-templates/>
+  </xsl:template>
+
+  <xsl:template match="rdf:RDF">
+    <html xml:lang="ja" lang="ja">
+    <head>
+      <title>RSS from <xsl:value-of select="/rdf:RDF/rss:channel/rss:title"/></title>
+      <meta http-equiv="Content-Style-Type" conent="text/css"/>
+    </head>
+    <body>
+      <h2><a>
+        <xsl:attribute name="href">
+          <xsl:value-of select="//rss:link"/>
+        </xsl:attribute><xsl:value-of select="//rss:title"/>
+      </a></h2>
+      <p>
+        <!--<a>
+          <xsl:attribute name="href">
+            <xsl:value-of select="//rss:link"/>
+          </xsl:attribute>
+          <xsl:value-of select="//rss:title"/>
+        </a>-->
+        最終更新日：<xsl:value-of select="//dc:date"/>
+      </p>
+      <hr color="orange"/>
+      <xsl:apply-templates select="rss:item"/>
+    </body>
+    </html>
+  </xsl:template>
+
+  <xsl:template match="rss:item">
+    <div bgcolor="red">
+          <h2>
+          <a>
+            <xsl:attribute name="href">
+              <xsl:value-of select="rss:link"/>
+            </xsl:attribute>
+            <xsl:value-of select="rss:title"/>
+          </a>
+          </h2>
+          <!-- <pre><xsl:value-of select="rss:description"/></pre> -->
+         <xsl:value-of select="content:encoded" disable-output-escaping="yes"/>
+      <hr color="orange"/>
+    </div>
+  </xsl:template>
+</xsl:stylesheet>
Index: lang/gauche/irc-logger/trunk/htdocs/index.cgi
===================================================================
--- lang/gauche/irc-logger/trunk/htdocs/index.cgi (revision 43)
+++ lang/gauche/irc-logger/trunk/htdocs/index.cgi (revision 43)
@@ -0,0 +1,34 @@
+#!/usr/bin/env gosh
+;;
+;; index.cgi - listing logs
+;;
+(require "../setting")
+
+(sys-chdir log-dir)
+
+(display "Content-type: text/html\r\n\r\n")
+(print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+       \"http://www.w3.org/TR/html4/loose.dtd\">
+<html>
+<head>
+<title>" irc-channel "</title>
+<link rel=\"stylesheet\" href=\"wiliki.css\" type=\"text/css\" />
+<link rel=\"alternate\" type=\"application/rss+xml\" title=\"RSS\" href=\"/" rdf-name "\" />
+</head>
+<body>
+<h1>" irc-channel " IRC logs</h1>
+
+<hr />
+<ul>
+"
+
+(string-join (map (lambda (path)
+                    (let1 date-str (regexp-replace #/\.log$/ path "")
+                      #`"<li><a href=\"logview.cgi?,|date-str|\">,|date-str|</a></li>\n"))
+                  (reverse! (glob "20[0-9][0-9]-[01][0-9]-[0-3][0-9].log")) ""))
+
+"</ul>
+<hr />
+
+</body>
+</html>")
Index: lang/gauche/irc-logger/trunk/htdocs/logview.cgi
===================================================================
--- lang/gauche/irc-logger/trunk/htdocs/logview.cgi (revision 43)
+++ lang/gauche/irc-logger/trunk/htdocs/logview.cgi (revision 43)
@@ -0,0 +1,61 @@
+#!/usr/bin/env gosh
+;;
+;; logview.cgi
+;;
+(require "../setting")
+(require "../lib/rawlog")
+
+(define (it s) #`"<i>,|s|</i>")
+(define (tt s) #`"<tt>,|s|</tt>")
+(define (brown s) #`"<font color=\"#cc9999\">,|s|</font>")
+(define (green s) #`"<font color=\"#339966\">,|s|</font>")
+(define (gray s) #`"<font color=\"#999999\">,|s|</font>")
+
+(define (logview-filter timestamp user cmd room msg)
+    (case cmd
+      [(JOIN)
+       (string-append (brown timestamp) " "
+                      (gray (tt #`"[,|user|'in]"))
+                      "<br>\n")]
+      [(PART QUIT)
+       (string-append (brown timestamp) " "
+                      (gray (tt #`"[,|user|'out]"))
+                      (gray (it #`" ; ,|msg|"))
+                      "<br>\n")]
+      [(PRIVMSG)
+       (string-append (brown timestamp) " "
+                      (green #`"&lt;,|user|&gt; ,|msg|")
+                      "<br>\n")]
+      [(NICK)
+       (string-append (brown timestamp) " "
+                      (gray (it "&lt;,|user| =&gt; |msg|&gt;"))
+                      "<br>\n")]
+      [(TOPIC)
+       (string-append (brown timestamp) " "
+                      (green (string-append "&lt;" user "&gt; "
+                                            #`"TOPIC =&gt; ,|msg|"))
+                      "<br>\n")]
+      [else #f]))
+  
+(define query-string (sys-getenv "QUERY_STRING"))
+
+(unless (and query-string (rxmatch #/^20[0-9][0-9]-[01][0-9]-[0-3][0-9]$/ query-string))
+  (display "Content-type: text/html") (newline) (newline)
+  (error "invalid query string"))
+
+(define date-str query-string)
+
+(display "Content-type: text/html\r\n\r\n")
+(print "<html>
+<head>
+<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">
+<title>" irc-channel " : " date-str "</title>
+</head>
+<body>
+"
+
+(daily-log date-str logview-filter)
+
+"
+</body>
+</html>")
Index: lang/gauche/irc-logger/trunk/lib/rawlog.scm
===================================================================
--- lang/gauche/irc-logger/trunk/lib/rawlog.scm (revision 43)
+++ lang/gauche/irc-logger/trunk/lib/rawlog.scm (revision 43)
@@ -0,0 +1,61 @@
+;(require "./setting")
+
+(use srfi-1)
+(use file.util)
+
+(define (daily-log date-str filter-proc)
+  ;; date-str must be in %Y-%m-%d format
+  (define (uncolon s)
+	(cond [(string=? "" s)
+		   ""]
+		  [(eq? #\: (string-ref s 0))
+		   (substring s 1 -1)]
+		  [else s]))
+  (define (unquote s)
+	(cond [(string=? "" s)
+		   ""]
+		  [(eq? #\" (string-ref s 0))
+		   (substring s 1 (- (string-length s) 1))]
+		  [else s]))
+
+  (define (month-abbrev->number s)
+	(case (string->symbol s)
+	  [(Jan) 1] [(Feb) 2] [(Mar) 3] [(Apr) 4] [(May) 5] [(Jun) 6]
+	  [(Jul) 7] [(Aug) 8] [(Sep) 9] [(Oct) 10] [(Nov) 11] [(Dec) 12]
+	  [else #f]))
+
+  (let1 raw-log-path (string-append log-dir "/" date-str ".log")
+	(if (file-exists? raw-log-path)
+		(string-join
+		 (filter identity
+				 (map (lambda (line)
+						(let (;;[month (month-abbrev->number (substring line 0 3))]
+							  ;;[day (string->number (substring line 4 6))]
+							  [timestamp (substring line 7 15)]
+							  [f (string-split (substring line 17 -1) " ")])
+						  (if (string=? "[RECEIVED]" (car f))
+							  (let ([user (uncolon (regexp-replace #/!.*$/ (second f) ""))]
+									[cmd (string->symbol (third f))]
+									[room (uncolon (fourth f))])
+								(case cmd
+								  [(JOIN)
+								   (filter-proc timestamp user cmd room "")]
+								  [(PART)
+								   (filter-proc timestamp user cmd room
+												(unquote (uncolon (string-join (cddddr f) " "))))]
+								  [(QUIT)
+								   (filter-proc timestamp user cmd #f
+												(unquote (uncolon (string-join (cdddr f) " "))))]
+								  [(PRIVMSG)
+								   (filter-proc timestamp user cmd room (uncolon (string-join (cddddr f) " ")))]
+								  [(NICK)
+								   (filter-proc timestamp user cmd #f (uncolon (string-join (cdddr f) " ")))]
+								  [(TOPIC)
+								 (filter-proc timestamp user cmd #f (uncolon (string-join (cdddr f) " ")))]
+								  [else
+								   (filter-proc timestamp user cmd room (uncolon (string-join (cddddr f) " ")))]
+								  ))
+							  #f)))
+					  (file->string-list raw-log-path))
+				 ) "")
+		#f)))
Index: lang/gauche/irc-logger/trunk/README
===================================================================
--- lang/gauche/irc-logger/trunk/README (revision 43)
+++ lang/gauche/irc-logger/trunk/README (revision 43)
@@ -0,0 +1,22 @@
+==================
+IRCロガーキット 0.1
+==================
+  // 取りまとめed by naoya_t
+
+- ロガーボット本体部分は、OKUYAMA Atsushi氏によるIRCBOTから名前付きパイプの機能を削ったもの
+  → http://homepage3.nifty.com/oatu/gauche/try.html#ircbot
+
+- ログビューアとかRSS生成部分は by @naoya_t
+- もともとawkとかrubyで書いてた各パーツを（単に練習のために）gaucheに移植
+
+- gauche 0.8.13で動作確認
+- irc.freenode.net でテスト
+- とりあえず utf-8 しか試してない
+
+- setting.scm で設定をいじる
+- htdocs に入ってるCGIファイルで２つのファイルを require しているが、適宜パスを合わせて
+
+- crontab に
+5 0 * * * /usr/local/bin/gosh rssfeed-gen.scm &> /dev/null
+とか適宜セットして
+
Index: lang/gauche/irc-logger/trunk/setting.scm
===================================================================
--- lang/gauche/irc-logger/trunk/setting.scm (revision 43)
+++ lang/gauche/irc-logger/trunk/setting.scm (revision 43)
@@ -0,0 +1,25 @@
+;;
+;; settings
+;;
+(define debug #f)
+
+(define irc-server "irc.server.host")
+(define irc-server-port 6667)
+(define irc-channel "#ChannelName")
+(define bot-nick "UNIQUE_BOTNAME")
+
+(define irc-client-address "localhost")
+
+(define rdf-name "irclog.rdf")
+(define log-dir "/PATH/TO/RAW/LOG/DIRECTORY") ;; absolute path
+
+(define rss-output-dir "/PATH/TO/RSS/OUTPUT/DIRECTORY") ;; absolute path
+(define rss-output-dir-url "http://www.example.com/")
+(define logview-root-url "http://www.example.com/LOGVIEW_DIR/")
+
+(define (logview-url date-str) ;; date-str must be in YYYY-MM-DD
+  (string-append logview-root-url "logview.cgi?" date-str)) ;;
+
+(define log-encoding "utf-8")
+(define irc-in-encoding "utf-8")
+(define irc-out-encoding "utf-8")