1;;; navi2ch-jbbs-net.el --- View jbbs.net module for Navi2ch. -*- coding: iso-2022-7bit; -*-
2
3;; Copyright (C) 2002, 2003, 2004 by Navi2ch Project
4
5;; Author:
6;; Part5 $B%9%l$N(B 509 $B$NL>L5$7$5$s(B
7;; <http://pc.2ch.net/test/read.cgi/unix/1013457056/509>
8
9;; Keywords: 2ch, network
10
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)
14;; any later version.
15
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.
20
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.
25
26;;; Commentary:
27
28;;
29
30;;; Code:
31(provide 'navi2ch-jbbs-net)
32(defconst navi2ch-jbbs-net-ident
33  "$Id$")
34
35(require 'navi2ch-multibbs)
36
37(defvar navi2ch-jbbs-func-alist
38  '((bbs-p		. navi2ch-jbbs-p)
39    (subject-callback	. navi2ch-jbbs-subject-callback)
40    (article-update 	. navi2ch-jbbs-article-update)
41    (article-to-url 	. navi2ch-jbbs-article-to-url)
42    (send-message   	. navi2ch-jbbs-send-message)
43    (send-success-p 	. navi2ch-jbbs-send-message-success-p)
44    (board-update	. navi2ch-jbbs-board-update)))
45
46(defvar navi2ch-jbbs-variable-alist
47  (list (cons 'coding-system navi2ch-coding-system)))
48
49(navi2ch-multibbs-regist 'jbbs-net
50			 navi2ch-jbbs-func-alist
51			 navi2ch-jbbs-variable-alist)
52
53;;-------------
54
55(defun navi2ch-jbbs-p (uri)
56  "URI $B$,(B jbbs.net $B$J$i(B non-nil$B$rJV$9!#(B"
57  (string-match "http://[^\\.]+\\.jbbs\\.net/" uri))
58
59(navi2ch-multibbs-defcallback navi2ch-jbbs-subject-callback (jbbs-net)
60  "subject.txt $B$r<hF@$9$k$H$-(B navi2ch-net-update-file
61$B$G;H$o$l$k%3!<%k%P%C%/4X?t(B"
62  (while (re-search-forward "\\([0-9]+\\.\\)cgi\\([^\n]+\n\\)" nil t)
63    (replace-match "\\1dat\\2"))
64  (re-search-backward "\\(\n.*\n\\)")
65  (replace-match "\n"))
66
67(defun navi2ch-jbbs-article-update (board article start)
68  "BOARD ARTICLE $B$N5-;v$r99?7$9$k!#(B
69START $B$,(B non-nil $B$J$i$P%l%9HV9f(B START $B$+$i$N:9J,$r<hF@$9$k!#(B
70$BJV$jCM$O(B HEADER$B!#(B"
71  (let ((file (navi2ch-article-get-file-name board article))
72	(time (cdr (assq 'time article)))
73	(url  (navi2ch-jbbs-get-offlaw-url board article))
74	(func (and start 'navi2ch-jbbs-article-callback)))
75    (navi2ch-net-update-file url file time func nil start)))
76
77(defun navi2ch-jbbs-get-offlaw-url (board article)
78  (let ((uri (cdr (assq 'uri board))))
79    (string-match "\\(http://[^/]+/[^/]+/\\)\\([0-9]+\\)" uri )
80    (format "%sbbs/offlaw.cgi?BBS=%s&KEY=%s"
81	    (match-string 1  uri) (match-string 2 uri)
82	    (cdr (assq 'artid article)))))
83
84(defun navi2ch-jbbs-article-to-url (board article &optional start end nofirst)
85  "BOARD, ARTICLE $B$+$i(B url $B$KJQ49!#(B
86START, END, NOFIRST $B$GHO0O$r;XDj$9$k(B"
87  (let ((uri   (cdr (assq 'uri board)))
88	(artid (cdr (assq 'artid article))))
89    (string-match "\\(.*\\)\\/\\([^/]*\\)\\/" uri)
90    (concat
91     (format "%s/bbs/read.cgi?BBS=%s&KEY=%s"
92	     (match-string 1 uri) (match-string 2 uri) artid)
93     (if (and (stringp start)
94	      (string-match "l\\([0-9]+\\)" start))
95	 (format "&LAST=%s" (match-string 1 start))
96       (concat
97	(and start (format "&START=%d" start))
98	(and end (format "&END=%d" end))))
99     (and nofirst
100	  (not (eq start 1))
101	  "&NOFIRST=TRUE"))))
102
103(defconst navi2ch-jbbs-url-regexp
104  ;;    prefix   $B%+%F%4%j(B     BBS$BHV9f(B
105  "\\`\\(.+\\)/\\([^/]+\\)/\\([^/]+\\)/\\'")
106
107(defun navi2ch-jbbs-get-writecgi-url (board)
108  "write.cgi $B$N(B url $B$rJV$9!#(B"
109  (let ((uri (navi2ch-board-get-uri board)))
110    (and (string-match navi2ch-jbbs-url-regexp uri)
111	 (format "%s/%s/bbs/write.cgi"
112		 (match-string 1 uri)
113		 (match-string 2 uri)))))
114
115(defun navi2ch-jbbs-send-message
116  (from mail message subject bbs key time board article &optional post)
117  (let ((url         (navi2ch-jbbs-get-writecgi-url board))
118	(referer     (navi2ch-board-get-uri board))
119	(param-alist (list
120		      (cons "submit" "$B=q$-9~$`(B")
121		      (cons "NAME" (or from ""))
122		      (cons "MAIL" (or mail ""))
123		      (cons "MESSAGE" message)
124		      (cons "BBS" bbs)
125		      (cons "KEY" key)
126		      (cons "TIME" time))))
127    (navi2ch-net-send-request
128     url "POST"
129     (list (cons "Content-Type" "application/x-www-form-urlencoded")
130	   (cons "Cookie" (concat "NAME=" from "; MAIL=" mail))
131	   (cons "Referer" referer))
132     (navi2ch-net-get-param-string param-alist))))
133
134(defun navi2ch-jbbs-send-message-success-p (proc)
135  (string-match "302 Found" (navi2ch-net-get-content proc)))
136
137;;-------------
138(defvar navi2ch-jbbs-parse-regexp "\
139<dt>\\([0-9]+\\) $BL>A0!'(B\\(<a href=\"mailto:\\([^\"]*\\)\">\\|<[^>]+>\\)\
140<b> \\(.*\\) </b><[^>]+> $BEj9FF|!'(B \\(.*\\)<br><dd>\\(.*\\)<br><br>\n")
141
142(defun navi2ch-jbbs-parse ()
143  (let ((case-fold-search t))
144    (re-search-forward navi2ch-jbbs-parse-regexp nil t)))
145
146(defun navi2ch-jbbs-make-article ()
147  (let ((mail (match-string 3))
148	(name (match-string 4))
149	(date (match-string 5))
150	(contents (match-string 6)))
151    ;; $B:9J,$NA0$N%;%Q%l!<%?$,(B "," $B$G8e$,(B "<>" $B$K$J$k$N$,$A$g$C$H%$%d!#(B
152    (format "%s<>%s<>%s<>%s<>\n"
153	    name (or mail "") date contents )))
154
155(navi2ch-multibbs-defcallback navi2ch-jbbs-article-callback (jbbs-net)
156  (let ((beg (point))
157	(max-num 0)
158	alist num min-num)
159    (while (navi2ch-jbbs-parse)
160      (setq num (string-to-number (match-string 1))
161	    min-num (or min-num num)
162	    max-num (max max-num num)
163	    alist (cons (cons (string-to-number (match-string 1))
164			      (navi2ch-jbbs-make-article))
165			alist)))
166    (delete-region beg (point-max))
167    (when (and min-num max-num)
168      (let ((i min-num))
169	(while (<= i max-num)
170	  (insert (or (cdr (assoc i alist))
171		      "$B$"$\!<$s(B<>$B$"$\!<$s(B<>$B$"$\!<$s(B<>$B$"$\!<$s(B<>\n"))
172	  (setq i (1+ i)))))))
173
174(defun navi2ch-jbbs-board-update (board)
175  (let ((url (navi2ch-board-get-url board))
176	(file (navi2ch-board-get-file-name board))
177	(time (cdr (assq 'time board)))
178	(func (navi2ch-multibbs-subject-callback board)))
179    (navi2ch-net-update-file url file time func)))
180
181;;; navi2ch-jbbs-net.el ends here
182