2011年5月25日水曜日

Hunchentoot で2chブラウザ その2


このエントリーをはてなブックマークに追加


すこし改良してみた。

javascriptをいじってたらIEで動かなくなってしまった。

Win7 64nit + CCL + Chrome で動作確認。

いまいちセッションの取り扱いがわからない。
一人用だし、グローバル変数にぶち込んで使うのもありかな?

parenscriptを使ってみようと呼び出してるけど使っていない。

*default-directory* を設定して、ファイルを配置して load したら、(2ch-editor:start-2ch-server)で localhost:8080で使用可能。

名前がeditorってなってるのは、まとめブログの支援ツールにしようと思ったんだけど、セッションがわからなかったので断念したから。。。


2ch-view.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :hunchentoot)
  (require :cl-who)
  (require :drakma)
  (require :jp)
  (require :cl-ppcre)
  (require :parenscript))

(defpackage :2ch-editor
  (:use :cl :hunchentoot :cl-who :drakma :jp :cl-ppcre :parenscript)
  (:shadow :COOKIE-VALUE
     :*HEADER-STREAM*
     :PARAMETER-ERROR
     :COOKIE-NAME
     :COOKIE-DOMAIN
     :COOKIE-PATH
     :COOKIE-EXPIRES)
  (:export #:main #:start-2ch-server #:stop-2ch-server))

;;  参考
;;  Common Lisp で Web アプリを作るためのブランクプロジェクト
;;  http://read-eval-print.blogspot.com/2011/02/common-lisp-web.html

(in-package :2ch-editor)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 環境設定
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *default-directory*
  (pathname "c:/export/home/clisp/2ch-web/")
  "このファイルがあるディレクトリを指定")

(defparameter *js-path*  (merge-pathnames "js/" *default-directory*)
  "JavaScript 用ディレクトリ")
(defparameter *css-path* (merge-pathnames "css/" *default-directory*)
  "スタイルシート用ディレクトリ")


;; 文字コードを設定
(setf
 ;; for utf-8
 hunchentoot:*hunchentoot-default-external-format* (flexi-streams:make-external-format :utf-8)
 hunchentoot:*default-content-type* "text/html; charset=utf-8"
 ;; for debug
 hunchentoot:*catch-errors-p* nil)


;; スタイルシートと、javascriptディレクトリをアクセス可能にする。
(setf hunchentoot:*dispatch-table*
      (list
       'hunchentoot:dispatch-easy-handlers
       (hunchentoot:create-folder-dispatcher-and-handler "/css/" *css-path*)
       (hunchentoot:create-folder-dispatcher-and-handler "/js/" *js-path*)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 汎用関数
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *port8080-acceptor* (make-instance 'hunchentoot:acceptor :port 8080)
  "hunchentootの起動ポートを指定する")

(defun start-2ch-server ()
  "Web サーバ起動"
  (start *port8080-acceptor*))

(defun stop-2ch-server ()
  "Web サーバ停止"
  (stop *port8080-acceptor*))


(defmacro with-default-template ((&key (title "題名")
                                       (charset "UTF-8")) &body body)
  "ページのテンプレート"
  `(with-html-output-to-string (out nil :indent t :prologue t)
     (htm (:html :lang "ja"
                 (:head
                  (:meta :charset ,charset :http-equiv "Content-Type" :content="text/html")
                  (:title ,title)
                  (:link :rel "stylesheet" :href "css/main.css" :media "all")
                  (:script :type "text/javascript" :scr "js/prototype.js")
      (:script :type "text/javascript" :src "js/main.js"))
                 (:body ,@body)))))


;; 各スレッドの情報を格納する
(defclass res ()
  ((num   :initarg :num)
   (name  :initarg :name)
   (mail  :initarg :mail)
   (date  :initarg :date)
   (text  :initarg :text)
   (flag  :initarg :flag)))

(defun http-request-jp (url)
  "ページをバイナリで取得しデコードして表示する。たまに変な文字コードが混ざるので消しておく"
  (delete #\Return (jp:decode (http-request url :force-binary t) :guess)))

(defun delete-html-tag (text)
  "タグを除去する"
  (cl-ppcre:regex-replace-all "<[/a-zA-Z]+>" text ""))


(defvar *thread-db* nil
  "編集済みのスレッド情報を格納する変数")

(defvar *thread-db-path* "thread.db"
  "スレッドDBのパス")

(defun load-thread-db ()
  "スレッドDBをロードする。"
  )

(defun save-thread-db ()
  "スレッドDBをセーブする。"
  )

(defun main ()
  "メイン処理を開始する"
  (load-thread-db)
  (start-2ch-server))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; トップページ /
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun get-bbslist-from-bbmenu ()
  "bbsmenuから余分なHTMLを削除したリストのリストを得る。この時点ではアンカータグは残っている"
  (mapcar #'(lambda (x) (cl-ppcre:split #\Linefeed x))
    (remove-if #'(lambda (x) (cl-ppcre:scan "(<HTML>|</HTML>|まちBBS|ツール類|チャット|-->)" x))
      (cl-ppcre:split "<BR><BR>" (http-request-jp "http://menu.2ch.net/bbsmenu.html")))))

(defun edit-bbssublist (bbslist)
  "カテゴリ別のリストを受け取り、タグを削除する"
  (loop for i in bbslist
  collect (mapcar #'(lambda (x) (delete-tag-from-a-bbsmenu x)) i)))

(defun delete-tag-from-a-bbsmenu (text)
  "BBSMENUのタグを削除する"
  (cond
 ((cl-ppcre:scan "(<B>|</B>)" text)
  (cl-ppcre:register-groups-bind (first) ("<B>(.+)</B>" text)
    first))

 ((cl-ppcre:scan "<A HREF=http://.+\\.2ch\\.net/.+/>" text)
  (cl-ppcre:register-groups-bind (url bkey name) ("<A HREF=(http://.+\\.2ch\\.net/)(.+)/>(.+)</A>" text)
    (list name url bkey)))

 ((cl-ppcre:scan "<A HREF=http://.+\\.bbspink\\.com/.+>" text)
  (cl-ppcre:register-groups-bind (url bkey name) ("<A HREF=(http://.+\\.bbspink\\.com/)(.+)/>(.+)</A>" text)
    (list name url bkey)))
 (t nil)))

(defun root-html ()
  "トップページを生成"
    (with-default-template (:title "板一覧")
   (loop for category in (edit-bbssublist (get-bbslist-from-bbmenu))
      for counter from 1 to 1000
   do (progn
     (htm
      (:table :border 0 ;; :style "float:left;"
        (loop for i in category
        for j from 1 to 1000
        do (if i
         (if (not (listp i))
          (htm (:tr (:td (:div :onclick (concatenate 'string
                    "javascript:menushow(" (princ-to-string counter) ");")
                (:b (:font :color "gray" (str "■") (str i)))))))
          (htm (:tr :style "display:none;"
              :name (concatenate 'string "counter" (princ-to-string counter))
              :id   (concatenate 'string "counter_" (princ-to-string counter) "_" (princ-to-string j))
              (:td (:a :href (concatenate 'string
                     "index?url="
                     (url-encode (second i))
                     "&bkey="
                     (url-encode (third  i))
                     "&title="
                     (url-encode (first  i)))
              (str (first i)))))))))))
     ))))


;; トップページを作成
(define-easy-handler (top :uri "/") ()
  (setf (hunchentoot:content-type*) "text/html; charset=utf-8")
  (root-html))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; スレッド一覧 /index
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun get-thread-subject (url bkey)
  "スレッド一覧を取得する"
  (let ((burl (concatenate 'string url bkey "/subject.txt")))
 (http-request-jp burl)))

(defun make-thread-list (text)
  "取得したスレッドをリストに分解する"
  (let ((var (mapcar #'(lambda (x) (cl-ppcre:split "<>" x))
      (cl-ppcre:split #\LineFeed text))))
 (loop for i in var
    collect (cl-ppcre:register-groups-bind (title num)
       ("\(\^.+\)\\(\([0-9]+\)\\)$" (second i))
     (list (first i) title num)))))

(defun make-thread-html (list url bkey title)
  "スレッド一覧を表示するHTMLを構築"
  (with-default-template (:title "スレッド一覧")
 (htm (:font :color "red" (str title)) :br)
 (htm (:table :border 0
     (loop for (dat title num) in list
     do (htm (:tr
        :onmouseover "this.style.background=\"#FFFACD\""
        :onmouseout  "this.style.background=\"#ffffff\""

        (htm (:td :align "right" (str num)))
;;         (htm (:td (:a :href (concatenate 'string "edit?"
;;                  "dat=" (url-encode dat)
;;                  "&url=" (url-encode url)
;;                  "&bkey=" (url-encode bkey))
;;              :target "_blank" (:font :size "-1" (str "編集")))))
        (htm (:td))
        (htm (:td (:a :href (concatenate 'string "view?"
                 "dat=" (url-encode dat)
                 "&url=" (url-encode url)
                 "&bkey=" (url-encode bkey))
             :target "_blank" (str title)))))))
     ))))

(defun index-html (url bkey title)
  "スレッド一覧を表示する。"
  (make-thread-html (make-thread-list (get-thread-subject url bkey)) url bkey title))

(define-easy-handler (index :uri "/index") (url bkey title)
  (setf (hunchentoot:content-type*) "text/html; charset=utf-8")
  (index-html url bkey title))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; スレッドビュー /view
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun get-thread-dat (url bkey dat)
  "スレッドDATを取得する。"
  (let ((burl (concatenate 'string
         (url-decode url)
         (url-decode bkey) "/dat/"
         (url-decode dat))))
 (http-request-jp burl)))

(defun make-thread-res-list (text)
  "DATを分解して配列に格納する。"
  (let ((i 1)
  (result nil))
    (loop for res in (cl-ppcre:split #\LineFeed text)
       do (let ((temp (cl-ppcre:split "<>" res)))
   (when (= i 1)
     (push (make-instance 'res :num 0 :text (car (last temp))) result)
     (push (make-instance 'res
           :num  i
           :name (delete-html-tag (first  temp))
           :mail (second temp)
           :date (third  temp)
           :text (fourth temp)
           :flag nil)         result))
   (when (not (= i 1))
     (push (make-instance 'res
           :num  i
           :name (delete-html-tag (first  temp))
           :mail (second temp)
           :date (third  temp)
           :text (fourth temp)
           :flag nil) result))
   (incf i)))
    (reverse result)))

(defun thread-html (url bkey dat)
  "スレッドを展開してHTML化"
  (let ((res (make-thread-res-list (get-thread-dat url bkey dat))))
 (setf (session-value 'thread-data) res)
 (with-default-template (:title "スレエディット")
   (htm
    (loop for i in res
    do (cond
      ((= 0 (slot-value i 'num))
    (htm (:a :href 
       (concatenate 'string url "test/read.cgi/" bkey "/" (cl-ppcre:regex-replace "\\.dat$" dat ""))
       :target "_blank"
       (:font :color "red" (:b (str (slot-value i 'text)))) :br :br)))
      (t (progn
     (htm (:hr)
       (:div :id (concatenate 'string "thread" (princ-to-string (slot-value i 'num)))
          :onmouseover "this.style.background=\"#FFFACD\""
          :onmouseout  "this.style.background=\"#ffffff\""
          (:dl (:dt

          (htm (str (slot-value i 'num))
            (:b :style "color:forestgreen;" (str (slot-value i 'name)))
            (str (concatenate 'string "[" (slot-value i 'mail) "] "))
            (str (slot-value i 'date)) :br))
         (htm (:dd (str (slot-value i 'text)) :br :br)))))))))))))


(define-easy-handler (view :uri "/view") (url bkey dat)
  (setf (hunchentoot:content-type*) "text/html; charset=utf-8")
  (thread-html url bkey dat))


main.js
function resDispSwitch(num)
{
 var foo = document.getElementById('thread' + num);

 foo.style.display =
        (foo.style.display == 'none')
        ? 'block' : 'none';
}

function selectRes(num)
{
 var foo = document.getElementById('selectRes' + num);
 foo.checked =
  (foo.checked == true)
  ? false : true;
}

function menushow(num)
{
 var elements = document.getElementsByName('counter' + num);

 for (var i = 0; i < elements.length; i ++) {
  elements[i].style.display =
   (elements[i].style.display == 'none' )
   ? 'block' : 'none';
 }
}

0 件のコメント:

コメントを投稿