Created
May 19, 2009 16:53
-
-
Save g000001/114218 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; Lingrのログを適当にhtmlにする | |
;;; ごみのような書捨てコード | |
;;; SLIMEのエディタバッファで直に評価する | |
(defpackage #:lingr-log | |
(:use #:cl #:stp)) | |
(in-package #:lingr-log) | |
(defun url-linkalize (str stream) | |
(let ((re (ppcre:create-scanner "(.*)(https?://[A-z\./0-9&@%-~_+=\?\\[\\]#]*)(.*)"))) | |
(apply #'format stream "~A<a href=\"~A\">~:*~A</a>~A" | |
(COERCE | |
(second (multiple-value-list | |
(ppcre:scan-to-strings re str))) | |
'LIST)))) | |
;; message-000n.xml => message-000n.html | |
(dolist (file (directory "/u/mc/Desktop/rooms/gKpArxPn9wi/mess*.xml")) | |
(let ((names (alexandria:plist-hash-table '("kn8ToAFVD8j" "g000001" | |
"fj79rE6EAdT" "leque" | |
"kS5DzTcB6Yx" "quek" | |
"g7uKV4HrnHk" "naoya_t" | |
"5huYmptY2Yv" "(び)" | |
"9x2dPCc4SFy" "kosh" | |
"2p5nzjurykD" "shiro" | |
"lAk6wOyi1fb" "higepon" | |
"ldazLYIllfL" "zick" | |
"jiRkSI6nft5" "managon" | |
"cRV81wTT7Qk" "haiju" | |
"kMIp9QyaAyW" "yuyam" | |
"ivDxnP9Vdf7" "bulb" | |
"2EmVrzioyMb" "tsz") | |
:test #'equal)) | |
(img (ppcre:create-scanner "http://.*\.(png|jpg|gif)")) | |
(href (ppcre:create-scanner "(.*)(https?://[A-z\./0-9&@%-_+=\?\\[\\]#]*)(.*)")) | |
(outfile (make-pathname :directory '(:absolute "tmp") | |
:name (pathname-name file) | |
:type "html"))) | |
(with-open-file (out outfile :direction :output :if-exists :supersede) | |
(format out "<html><head></head><body>~%") | |
(let (prev-user-id) | |
(do-recursively (n (cxml:parse-file file (make-builder))) | |
(when (typep n 'element) | |
(when (string= "message" (local-name n)) | |
(let ((plist (apply #'append | |
(map-children 'list | |
(lambda (x) | |
(when (typep x 'element) | |
(list (intern (local-name x)) | |
(string-value x)))) | |
n)))) | |
(let ((sv (getf plist '|text|)) | |
(user-id (getf plist '|user_id| "名無しさん"))) | |
;; user_id | |
(or (and (string= prev-user-id user-id)) | |
(format out "<br /><font size='5'>~A</font> <font color='gray'>~A</font>~%<br />" | |
(kmrcl:aif (and user-id (gethash user-id names)) | |
kmrcl:it | |
user-id) | |
(getf plist '|timestamp|))) | |
(setq prev-user-id user-id) | |
;; text | |
(cond ((find #\Linefeed sv) | |
(format out "<pre>~A</pre>~%" sv)) | |
((ppcre:scan img sv) | |
(format out "<img src=\"~A\" /><br />" sv)) | |
((ppcre:scan href sv) | |
(url-linkalize sv out) | |
(format out "<br />~%") | |
#|(format out "<a href=\"~A\">~A</a><br />" sv sv)|#) | |
('T (format out "~A<br />~%" sv))))))))) | |
(format out "</body></html>~%")))) | |
;; | |
(loop :for i :from 1 :to 7 | |
:do (kmrcl:run-shell-command "firefox /tmp/messages-000~A.html" i)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment