1;;; sb-cgi-board.el --- Shimbun backend for CGI_Board bulletin board systems 2 3;; Copyright (C) 2004, 2006, 2009, 2019 4;; TSUCHIYA Masatoshi <tsuchiya@namazu.org> 5 6;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org> 7;; Keywords: shimbun 8 9;; This file is a part of shimbun. 10 11;; This program 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 program 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 this program; see the file COPYING. If not, write to 23;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; This is a shimbun backend to browse CGI_Board bulletin board 29;; systems, developed by KUROKI Gen <kuroki@math.tohoku.ac.jp>. 30 31;;; Code: 32 33(require 'cl-lib) ;; cl-incf, cl-multiple-value-bind, cl-values-list 34 35(require 'shimbun) 36 37(defcustom shimbun-cgi-board-group-alist 38 '(("support" . 39 "http://www.math.tohoku.ac.jp/~kuroki/support/BBS.cgi?b=cgi_board") 40 ("kuroki.a" . 41 "http://www.math.tohoku.ac.jp/~kuroki/keijiban/BBS.cgi?b=a") 42 ("kuroki.b" . 43 "http://www.math.tohoku.ac.jp/~kuroki/keijiban/BBS.cgi?b=b") 44 ("kuroki.c" . 45 "http://www.math.tohoku.ac.jp/~kuroki/keijiban/BBS.cgi?b=c") 46 ("kuroki.e" . 47 "http://www.math.tohoku.ac.jp/~kuroki/keijiban/BBS.cgi?b=e") 48 ("nojiri" . 49 "http://njb.virtualave.net/BBS.cgi?b=nmain") 50 ("yamagata" . 51 "http://ruitomo.com/~hiroo/bbs/BBS.cgi?b=kohobu")) 52 "An alist of CGI_Board bulletin board systems and their URLs." 53 :group 'shimbun 54 :type '(repeat 55 (cons :format "%v" :indent 4 56 (string :tag "Name") 57 (string :tag " URL")))) 58 59(luna-define-class shimbun-cgi-board (shimbun) ()) 60 61(luna-define-method shimbun-groups ((shimbun shimbun-cgi-board)) 62 (mapcar 'car shimbun-cgi-board-group-alist)) 63 64(defsubst shimbun-cgi-board-base-url (shimbun) 65 (cdr (assoc (shimbun-current-group-internal shimbun) 66 shimbun-cgi-board-group-alist))) 67 68(luna-define-method shimbun-index-url ((shimbun shimbun-cgi-board)) 69 (concat (shimbun-cgi-board-base-url shimbun) "&old")) 70 71(luna-define-method shimbun-x-face ((shimbun shimbun-cgi-board)) 72 nil) 73 74(luna-define-method shimbun-get-headers ((shimbun shimbun-cgi-board) 75 &optional range) 76 (catch 'found 77 (let ((base (shimbun-cgi-board-base-url shimbun)) 78 (no-cache t) 79 (headers)) 80 (dolist (page (shimbun-cgi-board-get-pages range)) 81 (let (buffer header) 82 (unwind-protect 83 (with-temp-buffer 84 (when (shimbun-fetch-url shimbun 85 (shimbun-expand-url page base) 86 no-cache) 87 (goto-char (point-min)) 88 (while (re-search-forward 89 "\n<!--\\([^: \t\r\f\n]+\\):--><hr noshade>\n" nil t) 90 (let* ((fragment (match-string 1)) 91 (id (shimbun-cgi-board-make-message-id base 92 fragment))) 93 (when (shimbun-search-id shimbun id) 94 (throw 'found headers)) 95 (unless buffer 96 (with-current-buffer 97 (setq buffer (generate-new-buffer " *temp*")) 98 (shimbun-fetch-url shimbun 99 (concat base "&thread&_f=" page)))) 100 (when (setq header 101 (with-current-buffer buffer 102 (shimbun-cgi-board-extract-header base 103 fragment))) 104 (push header headers)))))) 105 (when buffer 106 (kill-buffer buffer)))) 107 (setq no-cache nil)) 108 headers))) 109 110(defconst shimbun-cgi-board-thread-regexp "\\( *\\)\\[\\([^]]+\\)\\] *\ 111<a name=\"\\([^\"]+\\)\" href=\"\\([^\"]+\\)\" target=\"article\">\\([^<]*\\)\ 112</a> *<small>(\\(.+\\))</small>") 113 114(defun shimbun-cgi-board-extract-header (base fragment) 115 (let (header) 116 (goto-char (point-min)) 117 (while (and (not header) (search-forward fragment nil t)) 118 (forward-line 0) 119 (if (and (looking-at shimbun-cgi-board-thread-regexp) 120 (equal fragment (match-string 3))) 121 (let ((level (length (match-string 1))) 122 (url (shimbun-expand-url (match-string 4) base))) 123 (setq header 124 (shimbun-create-header 125 0 126 (let ((subject (match-string 5))) 127 (if (equal subject fragment) "" subject)) 128 (match-string 2) 129 (shimbun-cgi-board-make-date-string (match-string 6)) 130 (shimbun-cgi-board-make-message-id base (match-string 3)) 131 nil nil nil url)) 132 (when (> level 0) 133 ;; Search a parent article. 134 (while (and (not (shimbun-header-references header)) 135 (zerop (forward-line 1)) 136 (not (looking-at "^$"))) 137 (when (and (looking-at shimbun-cgi-board-thread-regexp) 138 (< (length (match-string 1)) level)) 139 (shimbun-header-set-references 140 header 141 (shimbun-cgi-board-make-message-id base 142 (match-string 3))))))) 143 (forward-line 1))) 144 header)) 145 146(defun shimbun-cgi-board-make-date-string (string) 147 (save-match-data 148 (if (string-match 149 "\\`\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\) \\([0-9:]+\\)\\'" string) 150 (shimbun-make-date-string (string-to-number (match-string 1 string)) 151 (string-to-number (match-string 2 string)) 152 (string-to-number (match-string 3 string)) 153 (match-string 4 string)) 154 (cl-multiple-value-bind (sec min hour day month year dow dst zone) 155 (cl-values-list (decode-time (shimbun-time-parse-string string))) 156 (setq zone (/ zone 60)) 157 (shimbun-make-date-string year month day 158 (format "%02d:%02d" hour min) 159 (format "%s%02d%02d" 160 (if (>= zone 0) "+" "-") 161 (/ zone 60) 162 (% zone 60))))))) 163 164(defun shimbun-cgi-board-get-pages (&optional range) 165 "Return a list of splited index pages." 166 (let ((pages) 167 (count 0) 168 (limit (shimbun-header-index-pages range))) 169 (goto-char (point-min)) 170 (while (and (or (not limit) (<= (cl-incf count) limit)) 171 (re-search-forward 172 "<a href=\"\\./\\([^.]+\\.html\\)\" target=\"article\">" 173 nil t)) 174 (push (match-string 1) pages)) 175 (nreverse pages))) 176 177(defun shimbun-cgi-board-make-message-id (url &optional fragment) 178 (save-match-data 179 (format "<%s@%s>" 180 (or fragment 181 (progn 182 (string-match "\\`[^#]*#" url) 183 (substring url (match-end 0)))) 184 (progn 185 (string-match "\\`[^:/#?]+://\\([^/#?]+\\)/" url) 186 (match-string 1 url))))) 187 188(luna-define-method shimbun-clear-contents ((shimbun shimbun-cgi-board) header) 189 (let ((id (shimbun-header-id header))) 190 (when (string-match "\\`<\\([^@]+\\)@" id) 191 (goto-char (point-min)) 192 (let (start) 193 (when (and (search-forward 194 (concat "\n<!--" (match-string 1 id) ":-->") nil t) 195 (setq start (match-end 0)) 196 (re-search-forward "<!--[^-]*-->\n" nil t)) 197 (delete-region (match-beginning 0) (point-max)) 198 (delete-region (point-min) start) 199 (goto-char (point-min)) 200 (when (looking-at "<hr[^>]*>") 201 (delete-region (match-beginning 0) (match-end 0))) 202 t))))) 203 204(provide 'sb-cgi-board) 205 206;;; sb-cgi-board.el ends here 207