[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
sb-geocrawler.el
- From: NOKUBI Takatsugu <knok@xxxxxxxxxxxxx>
- Date: Fri, 10 May 2002 17:25:32 +0900
- X-ml-name: emacs-w3m
- X-mail-count: 03362
At Thu, 18 Apr 2002 14:19:25 +0900,
TSUCHIYA Masatoshi wrote:
> P.S.
> どなたか，sourceforge.net で公開されている mailing list archives 用の
> shimbun backend を作成されませんか?
sf.net の ML archives は(多分全部?) geocrawer.com にも archive され
ているようです。どうせならそちらに対応した方が読める ML が増えて嬉しい
だろうと思い、sb-mhonarc をベースにみようみまねでいじってみました。
とりあえずスレッド一覧までは見られるようになったものの、記事の取得が
うまくゆきません... 自分でももうちょっとあがくつもりではいますが、とり
あえずこちらに post してみます。
--
NOKUBI Takatsugu
E-mail: knok@daionet.gr.jp
knok@namazu.org / knok@debian.org
;;; sb-geocrawler.el --- shimbun backend class for geocrawler
;; The file is based on sb-mhonarc.el.
;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 2001 Akihiro Arisawa <ari@mbf.sphere.ne.jp>
;; Copyright (C) 2002 NOKUBI Takatsugu <knok@daionet.gr.jp>
;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>,
;; Akihiro Arisawa <ari@mbf.sphere.ne.jp>,
;; Yuuichi Teranishi <teranisi@gohome.org>
;; NOKUBI Takatsugu <knok@daionet.gr.jp>
;; Keywords: news
;; This file is a part of shimbun.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Original code was nnshimbun.el written by
;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
;;; Code:
(require 'shimbun)
(eval-and-compile
(luna-define-class shimbun-geocrawler (shimbun)
(reverse-flag litemplate-regexp))
(luna-define-internal-accessors 'shimbun-geocrawler))
(defvar shimbun-geocrawler-litemplate-regexp
" <A HREF=\"\\([0-9]+\\)/\"><IMG SRC=\"/img/msg.gif\" HEIGHT=[0-9]+ WIDTH=[0-9]+ BORDER=[0-9]+> \\([^<]+\\)</TD><TD>\\([^<]+\\)</TD><TD>\\([^<]+\\)</TD>")
;; articleno, subject, from, "mm/dd/yyyy hh:mm:dd"
;; mhonarc: artno, url, subject, from
(luna-define-method initialize-instance :after ((shimbun shimbun-geocrawler)
&rest init-args)
(shimbun-geocrawler-set-reverse-flag-internal
shimbun
(symbol-value
(intern-soft (concat "shimbun-" (shimbun-server-internal shimbun)
"-reverse-flag"))))
(shimbun-geocrawler-set-litemplate-regexp-internal
shimbun
(symbol-value
(intern-soft (concat "shimbun-" (shimbun-server-internal shimbun)
"-litemplate-regexp"))))
shimbun)
(defun shimbun-geocrawler-replace-newline-to-space (string)
(let ((i (length string)))
(while (> i 0)
(setq i (1- i))
(when (eq (aref string i) ?\n)
(aset string i ? )))
string))
(defmacro shimbun-geocrawler-extract-header-values (shimbun url headers aux)
(` (let ((id (format "<%s%s%%%s>"
(or (, aux) "")
(match-string 1)
(shimbun-current-group-internal (, shimbun))))
(url (shimbun-expand-url (match-string 1) (, url)))
(subject (shimbun-geocrawler-replace-newline-to-space (match-string 2)))
(from (shimbun-geocrawler-replace-newline-to-space (match-string 3))))
(if (shimbun-search-id (, shimbun) id)
(throw 'stop (, headers))
(push (shimbun-make-header 0
(shimbun-mime-encode-string subject)
(shimbun-mime-encode-string from)
"" id "" 0 0 url)
(, headers))))))
(defmacro shimbun-geocrawler-get-headers (shimbun url headers &optional aux)
(` (let ((case-fold-search t)
(regexp (or (shimbun-geocrawler-litemplate-regexp-internal (, shimbun))
shimbun-geocrawler-litemplate-regexp)))
(if (shimbun-geocrawler-reverse-flag-internal (, shimbun))
(progn
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(shimbun-geocrawler-extract-header-values (, shimbun) (, url)
(, headers) (, aux))
(forward-line 1)))
(goto-char (point-max))
(while (re-search-backward regexp nil t)
(shimbun-geocrawler-extract-header-values (, shimbun) (, url)
(, headers) (, aux))
(forward-line 0)))
(, headers))))
(luna-define-method shimbun-get-headers ((shimbun shimbun-geocrawler)
&optional range)
(let (headers)
(catch 'stop
(shimbun-geocrawler-get-headers shimbun (shimbun-index-url shimbun)
headers))))
;(defvar shimbun-geocrawler-optional-headers
; '("x-ml-count" "x-mail-count" "x-ml-name" "user-agent"))
(luna-define-method shimbun-make-contents ((shimbun shimbun-geocrawler)
header)
(if (search-forward "<TR><TD><PRE>FROM: " nil t)
(progn
;; Processing headers.
(save-restriction
(narrow-to-region (point-min) (point))
(shimbun-decode-entities)
(goto-char (point-min))
(while (search-forward "<BR>" nil t)
(replace-match "\n"))
(goto-char (point-min))
(let (buf refs reply-to)
; (while (not (eobp))
(progn (looking-at "Message: [0-9]+</TD></TR>")
(delete-region (point) (progn (forward-line 1) (point))))
(progn (looking-at "\t+<TR><TD><PRE>FROM: +")
(shimbun-header-set-from header
(shimbun-mime-encode-string
(shimbun-header-field-value)))
(delete-region (point) (progn (forward-line 1) (point))))
(progn (looking-at "DATE: +")
(let ((date (shimbun-header-field-value)))
(shimbun-header-set-date
header
(if (string-match "\\([0-9][0-9]/[0-9][0-9]/[0-9][0-9][0-9][0-9] [0-9][0-9]:[0-9][0-9]:[0-9][0-9]\\)"
date)
(substring date 0 (match-end 1))
date)))
(delete-region (point) (progn (forward-line 1) (point))))
(progn (looking-at "SUBJECT: +")
(shimbun-header-set-subject header
(shimbun-mime-encode-string
(shimbun-header-field-value)))
(delete-region (point) (progn (forward-line 1) (point))))
(if (setq reply-to (shimbun-reply-to shimbun))
(insert "Reply-To: " reply-to "\n"))
(insert "MIME-Version: 1.0\n")
(insert "Content-Type: text/html; charset=ISO-2022-JP\n")
(if refs
(shimbun-header-set-references header
(mapconcat 'identity
(reverse refs) " ")))
(insert "\n")
(goto-char (point-min))
(shimbun-header-insert shimbun header))
(goto-char (point-max)))
;; Processing body.
(save-restriction
(narrow-to-region (point) (point-max))
(when (search-forward "\t+<PRE></TD>" nil t)
(forward-line -1)
(delete-region (point) (point-max)))))
(goto-char (point-min))
(shimbun-header-insert shimbun header)
(insert
"Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n"))
(encode-coding-string (buffer-string)
(mime-charset-to-coding-system "ISO-2022-JP")))
(provide 'sb-geocrawler)
;;; sb-geocrawler.el ends here
; sb-qpe.el
(require 'shimbun)
(require 'sb-geocrawler)
(luna-define-class shimbun-qpe (shimbun-geocrawler) ())
;(defvar shimbun-qpe-url "http://www.geocrawler.com/archives/3/")
(defvar shimbun-qpe-url "http://www.geocrawler.com/lists/3/SourceForge/")
(defconst shimbun-qpe-group-path-alist
'(("qpe-devel" . "10638")))
(defvar shimbun-qpe-groups
(mapcar 'car shimbun-qpe-group-path-alist))
;(luna-define-method shimbun-index-url ((shimbun shimbun-geocrawler))
; (concat (shimbun-url-internal shimbun) "/"
; (cdr (assoc (shimbun-current-group-internal shimbun)
; shimbun-qpe-group-path-alist))))
(luna-define-method shimbun-index-url ((shimbun shimbun-qpe))
(concat (shimbun-url-internal shimbun)
(cdr (assoc (shimbun-current-group-internal shimbun)
shimbun-qpe-group-path-alist)) "/0/"))
(provide 'sb-qpe)