1 ;;; navi2ch-megabbs.el --- View megabbs.net module for Navi2ch. -*- coding: iso-2022-7bit; -*-
3 ;; Copyright (C) 2002, 2004, 2006 by Navi2ch Project
6 ;; Part5 \e$B%9%l$N\e(B 509 \e$B$NL>L5$7$5$s\e(B
7 ;; <http://pc.2ch.net/test/read.cgi/unix/1013457056/509>
9 ;; Keywords: 2ch, network
11 ;; This file is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This file is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
29 ;;; ----------\e$BNc\e(B----------
30 ;;; \e$BIaDL$K1\Mw$7$?$H$-\e(B
31 ;;; http://www.megabbs.com/egame/index.html
33 ;;; \e$B%9%l0lMw$NA4$F\e(B (\e$B2a5n%m%0%a%K%e!<\e(B)
34 ;;; http://www.megabbs.com/cgi-bin/readtitle.cgi?bo=egame&br=off
35 ;;; html \e$B$GMn$A$F$/$k!%\e(B`br' \e$B$O\e(B <br> \e$B$NM-L5\e(B[on|off]\e$B!%\e(B
37 ;;; http://www.megabbs.com/egame/egame_newb.txt
38 ;;; text \e$B$GMn$A$F$/$k!%\e(B1 \e$B9TL\$H:G8e$N9T$OITMW!%\e(B
40 ;;; \e$B%9%l\e(B (\e$B%l%9$rA4It8+$k\e(B)
41 ;;; http://www.megabbs.com/cgi-bin/readres.cgi?bo=egame&vi=1080276946
42 ;;; html \e$B$GMn$A$F$/$k!%\e(B
44 ;;; \e$B%9%l\e(B (\e$B:G?7\e(B 100 \e$B7o\e(B)
45 ;;; http://www.megabbs.com/cgi-bin/readres.cgi?bo=egame&vi=1080276946&rm=100
46 ;;; html \e$B$GMn$A$F$/$k!%\e(B
48 ;;; readres.cgi \e$B$K$F!$\e(B>>1\e$B$r=|5n\e(B
51 ;;; readres.cgi \e$B$K$F!$\e(B>>30\e$B$N$_\e(B
55 (provide 'navi2ch-megabbs
)
56 (defconst navi2ch-megabbs-ident
61 (require 'navi2ch-decls
)
62 (require 'navi2ch-inline
))
63 (require 'navi2ch-vars
)
65 (defvar navi2ch-megabbs-func-alist
66 '((bbs-p . navi2ch-megabbs-p
)
67 (subject-callback . navi2ch-megabbs-subject-callback
)
68 (article-update . navi2ch-megabbs-article-update
)
69 (article-to-url . navi2ch-megabbs-article-to-url
)
70 (url-to-board . navi2ch-megabbs-url-to-board
)
71 (url-to-article . navi2ch-megabbs-url-to-article
)
72 (send-message . navi2ch-megabbs-send-message
)
73 (send-success-p . navi2ch-megabbs-send-message-success-p
)
74 ; (error-string . navi2ch-megabbs-send-message-error-string)
75 (board-update . navi2ch-megabbs-board-update
)
76 (board-get-file-name . navi2ch-megabbs-board-get-file-name
)))
78 (defvar navi2ch-megabbs-variable-alist
79 (list (cons 'coding-system navi2ch-coding-system
)))
81 (navi2ch-multibbs-regist 'megabbs
82 navi2ch-megabbs-func-alist
83 navi2ch-megabbs-variable-alist
)
85 (defgroup navi2ch-megabbs nil
87 :prefix
"navi2ch-megabbs-"
90 (defcustom navi2ch-megabbs-max-articles
300
91 "\e$B%9%l0lMw$N:GBgCM!%\e(B"
92 :type
'(choice (const :tag
"\e$BL5@)8B\e(B" 0)
93 (integer :tag
"\e$B@)8BCM\e(B"))
94 :group
'navi2ch-megabbs
)
98 (defun navi2ch-megabbs-p (uri)
99 "URI \e$B$,\e(B megabbs.net \e$B$J$i\e(B non-nil\e$B$rJV$9!#\e(B"
100 (string-match "^http://www.megabbs.com/" uri
))
102 (navi2ch-multibbs-defcallback navi2ch-megabbs-subject-callback
(megabbs)
103 "subject.txt \e$B$r<hF@$9$k$H$-\e(B navi2ch-net-update-file
104 \e$B$G;H$o$l$k%3!<%k%P%C%/4X?t\e(B"
105 (progn (re-search-forward "[^\n]*\n" nil t
) (replace-match ""))
106 (if (= navi2ch-megabbs-max-articles
0)
107 (while (navi2ch-megabbs-subject-callback-sub))
108 (let ((n navi2ch-megabbs-max-articles
))
109 (while (and (not (zerop n
))
110 (navi2ch-megabbs-subject-callback-sub))
112 (delete-region (point) (point-max)))
114 (defun navi2ch-megabbs-subject-callback-sub ()
115 (when (re-search-forward "\\([0-9]+\\)<>\\(.*\\)<>\\(.*\\)\n" nil t
)
116 (replace-match "\\1.dat,\\2(\\3)\n" t
)
119 (defun navi2ch-megabbs-article-update (board article start
)
120 "BOARD ARTICLE \e$B$N5-;v$r99?7$9$k!#\e(B
121 START \e$B$,\e(B non-nil \e$B$J$i$P%l%9HV9f\e(B START \e$B$+$i$N:9J,$r<hF@$9$k!#\e(B
122 \e$BJV$jCM$O\e(B HEADER\e$B!#\e(B"
123 (let ((file (navi2ch-article-get-file-name board article
))
124 (time (cdr (assq 'time article
)))
125 (url (navi2ch-megabbs-article-to-url board article start nil start
))
126 (func (if start
'navi2ch-megabbs-article-callback-diff
127 'navi2ch-megabbs-article-callback
)))
128 (navi2ch-net-update-file url file time func nil start
)))
130 (defmacro navi2ch-megabbs-with-board
(uri id board
&rest body
)
131 (let ((alist (make-symbol "alist")))
132 `(let* ((,alist
(navi2ch-megabbs-url-to-board
133 (cdr (assq 'uri
,board
))))
134 (,uri
(cdr (assq 'uri
,alist
)))
136 `((,id
(cdr (assq 'id
,alist
))))))
139 (defun navi2ch-megabbs-article-to-url (board article
&optional start end nofirst
)
140 "BOARD, ARTICLE \e$B$+$i\e(B url \e$B$KJQ49!#\e(B
141 START, END, NOFIRST \e$B$GHO0O$r;XDj$9$k\e(B"
142 (navi2ch-megabbs-with-board
144 (let ((artid (cdr (assq 'artid article
))))
146 (progn (string-match "\\(http://[^/]+\\)/" uri
)
147 (format "%s/cgi-bin/readres.cgi?bo=%s&vi=%s"
148 (match-string 1 uri
) id artid
))
149 (cond ((and (stringp start
))
150 (string-match "l\\([0-9]+\\)" start
)
151 (format "&rm=%s" (match-string 1 start
)))
152 ((and start end
(= (- end start
) 1))
153 (format "&res=%d" start
))
155 (and start
(format "&rs=%d" start
))
156 (and end
(format "&re=%d" end
)))))
161 (defun navi2ch-megabbs-url-to-board (url)
162 "url \e$B$+$i\e(B BOARD \e$B$KJQ49!#\e(B"
164 ;; http://www.megabbs.com/cgi-bin/readtitle.cgi?bo=hoge&br=off
166 "http://\\([^/]+\\)/cgi-bin/[^?]*\\?.*bo=\\([^&]*\\)"
168 (list (cons 'uri
(format "http://%s/%s/"
170 (match-string 2 url
)))
171 (cons 'id
(match-string 2 url
))))
172 ;; http://www.megabbs.com/egame/index.html
174 "http://\\([^/]+\\)/\\([^/]+\\)"
176 (list (cons 'uri
(format "http://%s/%s/"
178 (match-string 2 url
)))
179 (cons 'id
(match-string 2 url
))))))
181 (defun navi2ch-megabbs-url-to-article (url)
183 "http://.+/cgi-bin/readres\\.cgi.*vi=\\([0-9]+\\)"
185 (list (cons 'artid
(match-string 1 url
))))))
188 ;------------------------------
190 (defconst navi2ch-megabbs-url-regexp
191 ;; prefix \e$B%+%F%4%j\e(B BBS\e$BHV9f\e(B
192 "\\`\\(.+\\)/\\([^/]+\\)/\\([^/]+\\)/\\'")
194 (defun navi2ch-megabbs-get-writecgi-url (board)
195 "write.cgi \e$B$N\e(B url \e$B$rJV$9!#\e(B"
196 (let* ((alist (navi2ch-megabbs-url-to-board (cdr (assq 'uri board
))))
197 (uri (cdr (assq 'uri alist
))))
198 (string-match "\\(http://[^/]*/\\)" uri
)
199 (format "%s/cgi-bin/megabbs.cgi"
200 (match-string 1 uri
))))
202 ;;; (defun navi2ch-megabbs-get-writecgi-url (board)
203 ;;; "write.cgi \e$B$N\e(B url \e$B$rJV$9!#\e(B"
204 ;;; (let ((uri (navi2ch-board-get-uri board)))
205 ;;; (and (string-match navi2ch-megabbs-url-regexp uri)
206 ;;; (format "%s/%s/bbs/write.cgi"
207 ;;; (match-string 1 uri)
208 ;;; (match-string 2 uri)))))
210 (defun navi2ch-megabbs-send-message
211 (from mail message subject bbs key time board article
)
212 (let ((url (navi2ch-megabbs-get-writecgi-url board
))
213 (referer (navi2ch-board-get-uri board
))
215 (cons "submit" "\e$B=q$-9~$`\e(B")
219 (cons "name" (or from
""))
220 (cons "email" (or mail
""))
225 (navi2ch-net-send-request
227 (list (cons "Content-Type" "application/x-www-form-urlencoded")
228 (cons "Cookie" (concat "NAME=" from
"; MAIL=" mail
))
229 (cons "Referer" referer
))
230 (navi2ch-net-get-param-string param-alist
))))
232 (defun navi2ch-megabbs-send-message-success-p (proc)
233 (string-match "302 Found" (navi2ch-net-get-content proc
)))
237 (defvar navi2ch-megabbs-parse-regexp
239 ;; 2. (mail? + name?)
241 ;; 4. (id + contents)
242 "<dt><a href[^>]*>\\([0-9]+\\)</a>[^<]*<b>\\(.*\\)</b>[ \e$B!!\e(B]*\
243 \\([^<]*\\).*\n<dd>\\(.*\\)<hr[^>]*>$"
246 (defvar navi2ch-megabbs-parse-subject-regexp
"<title>\\(.*\\)</title>")
248 (defun navi2ch-megabbs-parse-subject ()
249 (let ((case-fold-search t
))
250 (re-search-forward navi2ch-megabbs-parse-subject-regexp nil t
)
253 (defun navi2ch-megabbs-parse ()
254 (let ((case-fold-search t
))
255 (re-search-forward navi2ch-megabbs-parse-regexp nil t
)))
257 (defun navi2ch-megabbs-make-article (&optional subject
)
258 (let* ((mail+name
(match-string 2))
259 (date (match-string 3))
260 (contents-with-id (match-string 4))
263 (setq mail
+name
(navi2ch-replace-string
264 "<font[^>]*>\\|</font>\\|</a>\\|<b>\\|</b>"
266 (string-match "\\(<a href=\"mailto:\\([^\"]*\\)[ ]*\">\\(.*\\)\\|\\(.*\\)\\)"
268 (setq mail
(match-string 2 mail
+name
))
269 (setq name
(match-string (if mail
3 4) mail
+name
)))
270 (let ((m (string-match "^<!-- para=\\([^>]*\\)-->" contents-with-id
)))
271 (setq id
(and m
(match-string 1 contents-with-id
))))
272 (format "%s<>%s<>%s<>%s<>%s\n"
274 (concat date
(and id
" ID:") (or id
""))
275 contents-with-id
(or subject
""))))
277 (navi2ch-multibbs-defcallback navi2ch-megabbs-article-callback
278 (megabbs &optional diff
)
281 subject alist num min-num
)
283 (setq subject
(navi2ch-megabbs-parse-subject)))
284 (while (navi2ch-megabbs-parse)
285 (setq num
(string-to-number (match-string 1))
286 min-num
(or min-num num
)
287 max-num
(max max-num num
)
288 alist
(cons (cons (string-to-number (match-string 1))
289 (navi2ch-megabbs-make-article subject
))
292 (delete-region beg
(point-max))
293 (when (and min-num max-num
)
295 (while (<= i max-num
)
296 (insert (or (cdr (assoc i alist
))
297 "\e$B$"$\
!<$s
\e(B<>\e$B$
"$\!<$s\e(B<>\e$B$"$\
!<$s
\e(B<>\e$B$
"$\!<$s\e(B<>\n"))
300 (defun navi2ch-megabbs-article-callback-diff ()
301 (navi2ch-megabbs-article-callback t
))
303 ;------------------------------
305 (defun navi2ch-megabbs-board-update (board)
306 (let ((url (navi2ch-megabbs-util-article-list-url board
))
307 (file (navi2ch-megabbs-board-get-file-name board
))
308 (time (cdr (assq 'time board
)))
309 (func (navi2ch-multibbs-subject-callback board
)))
310 (navi2ch-net-update-file url file time func
)))
312 (defun navi2ch-megabbs-util-article-list-url (board)
313 (navi2ch-megabbs-with-board
315 (concat url id
"_newb.txt")))
317 (defun navi2ch-megabbs-board-get-file-name (board &optional file-name
)
318 (navi2ch-megabbs-with-board
320 (string-match "http://\\(.+\\)" uri
)
321 (navi2ch-expand-file-name
322 (concat (match-string 1 uri
)
323 (or file-name navi2ch-board-subject-file-name
)))))
325 ;;; navi2ch-megabbs.el ends here