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