navi2ch-multibbs.el

   1 ;;; navi2ch-multibbs.el --- View 2ch like BBS module for Navi2ch. -*-
   2 ;;; coding: iso-2022-7bit; -*-
   3
   4 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2008, 2009 by Navi2ch
   5 ;; Project
   6
   7 ;; Author:
   8 ;; Part5 \e$B%9%l$N\e(B 509 \e$B$NL>L5$7$5$s\e(B
   9 ;; <http://pc.2ch.net/test/read.cgi/unix/1013457056/509>
  10
  11 ;; Keywords: 2ch, network
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This file is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;;
  31
  32 ;;; Code:
  33 (provide 'navi2ch-multibbs)
  34 (defconst navi2ch-multibbs-ident
  35   "$Id$")
  36
  37 (eval-when-compile
  38   (require 'cl-lib)
  39   (require 'navi2ch-inline)
  40   (require 'navi2ch-decls))
  41 (require 'navi2ch-vars)
  42
  43 (defvar navi2ch-multibbs-func-table nil
  44   "BBS \e$B$N<oN`$H4X?t72$N\e(B hash\e$B!#\e(B
  45 BBSTYPE \e$B$r\e(B key \e$B$K\e(B FUNC-TABLE \e$B$,3JG<$5$l$k!#\e(B
  46 BBSTYPE: BBS \e$B$N<oN`$rI=$9%7%s%\%k!#\e(B
  47 FUNC-TABLE: \e$B$=$N\e(B BBS \e$B$G$NF0:n$r;XDj$9$k4X?t72!#\e(B
  48
  49 FUNC-TABLE \e$B$O0J2<$N:8B&$N%7%s%\%k$r\e(B key \e$B$K\e(B
  50 \e$B4X?t$,3JG<$5$l$k!#\e(B
  51 bbs-p                   BBS-P-FUNC
  52 subject-callback        SUBJECT-CALLBACK-FUNC
  53 article-update  ARTICLE-UPDATE-FUNC
  54 article-to-url  ARTICLE-TO-URL-FUNC
  55 url-to-board            URL-TO-BOARD-FUNC
  56 url-to-article  URL-TO-ARTICLE-FUNC
  57 send-message            SEND-MESSAGE-FUNC
  58 extract-post          EXTRACT-POST-FUNC
  59 send-success-p  SEND-MESSAGE-SUCCESS-P-FUNC
  60 error-string            ERROR-STRING-FUNC
  61 board-update            BOARD-UPDATE-FUNC
  62 board-get-file-name     BOARD-GET-FILE-NAME-FUNC
  63
  64 BBS-P-FUNC(URI):
  65     URI \e$B$,$=$N\e(B BBS \e$B$N$b$N$J$i$P\e(B non-nil \e$B$rJV$9!#\e(B
  66
  67 SUBJECT-CALLBACK-FUNC():
  68     subject.txt \e$B$r<hF@$9$k$H$-$K\e(B `navi2ch-net-update-file' \e$B$G;H$o$l$k%3!<\e(B
  69     \e$B%k%P%C%/4X?t\e(B
  70
  71 ARTICLE-UPDATE-FUNC(BOARD ARTICLE START):
  72     BOARD ARTICLE \e$B$GI=$5$l$k%U%!%$%k$r99?7$9$k!#\e(B
  73     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
  74
  75 ARTICLE-TO-URL-FUNC(BOARD ARTICLE
  76                     &OPTIONAL START END NOFIRST):
  77     BOARD, ARTICLE \e$B$+$i\e(B url \e$B$KJQ49$9$k!#\e(B
  78
  79 URL-TO-BOARD-FUNC(URL):
  80 URL \e$B$+$i\e(B board \e$B$KJQ49$9$k!#\e(B
  81
  82 URL-TO-ARTICLE-FUNC(URL):
  83 URL \e$B$+$i\e(B article \e$B$KJQ49$9$k!#\e(B
  84
  85 SEND-MESSAGE-FUNC(FROM MAIL MESSAGE
  86                   SUBJECT BBS KEY TIME BOARD ARTICLE POST):
  87     MESSAGE \e$B$rAw?.$9$k!#\e(B
  88
  89 EXTRACT-POST-FUNC(OLD-POST BUFFER):
  90     MESSAGE \e$B$N:FAw?.$K;H$&>pJs$r<h$j=P$9!#<h$j=P$7$?%G!<%?$r\e(B
  91     \e$BJV$jCM$H$7$FJV$9$H!":FAw$N$?$a$K\e(BSEND-MESSAGE-FUNC\e$B$r8F$S=P$9\e(B
  92     \e$B$H$-$K!"$=$NCM$,\e(BPOST\e$B0z?t$KB+G{$5$l$^$9!#\e(B
  93
  94     BUFFER\e$B$K$O!"\e(BSEND-MESSAGE-FUNC\e$B$,JV$7$?\e(BPROC\e$B$+$i<h$j=P$7$?%3%s\e(B
  95     \e$B%F%s%D$r%G%3!<%I$7$?$b$N$,A^F~$5$l$F$$$^$9!#:FAw$r7+$jJV$9\e(B
  96     \e$B>l9g!":G8e$K\e(BEXTRACT-POST-FUNC\e$B$,JV$7$?CM$,\e(BOLD-POST\e$B$KB+G{$5$l\e(B
  97     \e$B$F$$$^$9!#\e(B
  98
  99 SEND-MESSAGE-SUCCESS-P-FUNC(PROC):
 100     PROC \e$B$NAw?.%;%C%7%g%s$,@.8y$7$F$$$l$P\e(B non-nil \e$B$r!"\e(B
 101     \e$B<:GT$7$?$i\e(B nil \e$B$r!":F;n9T2DG=$J<:GT$J$i\e(B 'retry \e$B$rJV$9!#\e(B
 102
 103 ERROR-STRING-FUNC(PROC):
 104     PROC \e$B$NAw?.%;%C%7%g%s$,<:GT$7$?$H$-$N%(%i!<%a%C%;!<%8$rJV$9!#\e(B
 105
 106 BOARD-UPDATE-FUNC(BOARD):
 107     BOARD \e$B$GI=$5$l$k%U%!%$%k$r99?7$9$k!#\e(B
 108
 109 BOARD-GET-FILE-NAME-FUNC(BOARD &optional FILE-NAME)
 110     BOARD \e$B$N>pJs$rJ]B8$9$k%G%#%l%/%H%j$r4p=`$H$7$F!"\e(BFILE-NAME \e$B$N\e(B
 111     \e$B@dBP%Q%9$rJV$9!#\e(B")
 112
 113 (defvar navi2ch-multibbs-variable-alist nil
 114   "BBS \e$B$N<oN`$HJQ?t72$N\e(B alist\e$B!#\e(B
 115 \e$B3FMWAG$O\e(B
 116 \(BBSTYPE . FUNC-ALIST)
 117 BBSTYPE: BBS \e$B$N<oN`$rI=$9%7%s%\%k!#\e(B
 118 VARIABLE-ALIST: \e$B$=$N\e(B BBS \e$B$N@_Dj$r;XDj$9$kJQ?t72!#\e(B
 119
 120 VARIABLE-ALIST \e$B$O0J2<$NDL$j\e(B
 121 \((coding-system                . CODING-SYSTEM-VAR))
 122
 123 CODING-SYSTEM-VAR:
 124     \e$B$=$N\e(B BBS \e$B$N%U%!%$%k$NJ8;z%3!<%I\e(B")
 125
 126 (defvar navi2ch-2ch-board-file-name-cache nil)
 127 (defvar navi2ch-2ch-board-file-name-cache-limit 1000)
 128
 129 (defun navi2ch-multibbs-get-bbstype-subr (uri table)
 130   (when (hash-table-p table)
 131     (catch 'loop
 132       (maphash (lambda (type func-table)
 133                  (let ((func (gethash 'bbs-p func-table)))
 134                    (when (and func (funcall func uri))
 135                      (throw 'loop type))))
 136                table))))
 137
 138 (defun navi2ch-multibbs-set-bbstype (board type)
 139   (when (consp board)
 140     (setcdr board
 141             (cons (cons 'bbstype type) (cdr board)))))
 142
 143 (defun navi2ch-multibbs-subject-callback (board)
 144   (navi2ch-multibbs-get-func
 145    (navi2ch-multibbs-get-bbstype board)
 146    'subject-callback 'navi2ch-2ch-subject-callback))
 147
 148 (defun navi2ch-multibbs-article-update (board article start)
 149   (let* ((bbstype (navi2ch-multibbs-get-bbstype board))
 150          (func    (navi2ch-multibbs-get-func
 151                    bbstype 'article-update 'navi2ch-2ch-article-update)))
 152     (funcall func board article start)))
 153
 154 (defun navi2ch-multibbs-regist (bbstype func-alist variable-alist)
 155   (unless navi2ch-multibbs-func-table
 156     (setq navi2ch-multibbs-func-table
 157           (make-hash-table :size 6))) ;FIXME: 6 \e$B$G$?$j$k$H;W$&$1$I$I$&$9$+$M!#\e(B
 158   (puthash bbstype
 159            (navi2ch-alist-to-hash func-alist)
 160            navi2ch-multibbs-func-table)
 161   (setq navi2ch-multibbs-variable-alist
 162         (cons (cons bbstype variable-alist)
 163               navi2ch-multibbs-variable-alist)))
 164
 165 (defun navi2ch-multibbs-get-variable
 166   (bbstype variable &optional default-value)
 167   (or (cdr (assq variable
 168                  (cdr (assq bbstype
 169                             navi2ch-multibbs-variable-alist))))
 170       default-value))
 171
 172 (defun navi2ch-multibbs-url-to-bbstype (url)
 173   (or
 174    (and url
 175         (navi2ch-multibbs-get-bbstype-subr url navi2ch-multibbs-func-table))
 176    'unknown))
 177
 178 (defun navi2ch-multibbs-url-to-article (url)
 179   (let* ((bbstype (navi2ch-multibbs-url-to-bbstype url))
 180          (func    (navi2ch-multibbs-get-func
 181                    bbstype 'url-to-article 'navi2ch-2ch-url-to-article)))
 182     (funcall func url)))
 183
 184 (defun navi2ch-multibbs-url-to-board (url)
 185   (let* ((bbstype (navi2ch-multibbs-url-to-bbstype url))
 186          (func    (navi2ch-multibbs-get-func
 187                    bbstype 'url-to-board 'navi2ch-2ch-url-to-board)))
 188     (funcall func url)))
 189
 190 (defun navi2ch-multibbs-article-to-url
 191   (board article &optional start end nofirst)
 192   "BOARD, ARTICLE \e$B$+$i\e(B url \e$B$KJQ49!#\e(B
 193 START, END, NOFIRST \e$B$GHO0O$r;XDj$9$k\e(B"
 194   (let ((func (navi2ch-multibbs-get-func-from-board
 195                board 'article-to-url 'navi2ch-2ch-article-to-url)))
 196     (funcall func board article start end nofirst)))
 197
 198 (defun navi2ch-multibbs-get-message-time-field ()
 199   (if (stringp navi2ch-net-last-date)
 200       (navi2ch-http-date-decode navi2ch-net-last-date)
 201     (let* ((now (current-time))
 202            (lag 300)                    ; \e$B$:$i$9IC?t\e(B
 203            (h (nth 0 now))
 204            (l (- (nth 1 now) lag)))
 205       (when (< l 0)
 206         (setq l (+ l 65536)
 207               h (- h 0)))
 208       (cons h l))))
 209
 210 (defun navi2ch-multibbs-send-message-error-string (board proc)
 211   (let* ((func (navi2ch-multibbs-get-func
 212                 (navi2ch-multibbs-get-bbstype board)
 213                 'error-string
 214                 'navi2ch-2ch-send-message-error-string))
 215          (err (funcall func proc)))
 216     (or err
 217         (let ((status (and proc (navi2ch-net-get-status proc))))
 218           (when status
 219             (concat "HTTP status: " status))))))
 220
 221 (defun navi2ch-multibbs-send-message
 222   (from mail message subject board article)
 223   (let* ((bbstype      (navi2ch-multibbs-get-bbstype board))
 224          (send         (navi2ch-multibbs-get-func
 225                         bbstype 'send-message 'navi2ch-2ch-send-message))
 226          (extract-post (navi2ch-multibbs-get-func
 227                         bbstype 'extract-post 'navi2ch-2ch-extract-post))
 228          (success-p    (navi2ch-multibbs-get-func
 229                         bbstype 'send-success-p
 230                         'navi2ch-2ch-send-message-success-p))
 231          (bbs          (let ((uri (navi2ch-board-get-uri board)))
 232                          (string-match "\\([^/]+\\)/$" uri)
 233                          (match-string 1 uri)))
 234          (key          (cdr (assq 'artid article)))
 235          (time         (format-time-string
 236                         "%s" (navi2ch-multibbs-get-message-time-field)))
 237          (navi2ch-net-http-proxy (and navi2ch-net-send-message-use-http-proxy
 238                                       (or navi2ch-net-http-proxy-for-send-message
 239                                           navi2ch-net-http-proxy)))
 240          (navi2ch-net-http-proxy-userid (if navi2ch-net-http-proxy-for-send-message
 241                                             navi2ch-net-http-proxy-userid-for-send-message
 242                                           navi2ch-net-http-proxy-userid))
 243          (navi2ch-net-http-proxy-password (if navi2ch-net-http-proxy-for-send-message
 244                                               navi2ch-net-http-proxy-password-for-send-message
 245                                             navi2ch-net-http-proxy-password))
 246          (tries 2)                      ; \e$BAw?.;n9T$N:GBg2s?t\e(B
 247          (message-str "send message...")
 248          (result 'retry)
 249          (post-data nil))
 250     (cl-dotimes (i tries)
 251       (let ((proc (funcall send from mail message subject bbs key time
 252                            board article post-data)))
 253         (message message-str)
 254         (setq result (funcall success-p proc))
 255         (cond ((eq result 'retry)
 256                (save-window-excursion
 257                  (with-temp-buffer
 258                    (insert (decode-coding-string
 259                             (navi2ch-net-get-content proc)
 260                             (navi2ch-board-get-coding-system board)))
 261                    (setq post-data (funcall extract-post post-data (current-buffer)))
 262                    (navi2ch-replace-html-tag-with-buffer)
 263                    (goto-char (point-min))
 264                    (while (re-search-forward "[ \t]*\n\\([ \t]*\n\\)*" nil t)
 265                      (replace-match "\n"))
 266                    (delete-other-windows)
 267                    (switch-to-buffer (current-buffer))
 268                    (unless (y-or-n-p "Retry? ")
 269                      (cl-return nil))))
 270                (sit-for navi2ch-message-retry-wait-time)
 271                (setq message-str "re-send message..."))
 272               (result
 273                (message (concat message-str "succeed"))
 274                (cl-return result))
 275               (t
 276                (let ((err (navi2ch-multibbs-send-message-error-string board proc)))
 277                  (if (stringp err)
 278                      (message (concat message-str "failed: %s") err)
 279                    (message (concat message-str "failed")))
 280                  ;;\e$B%(%i!<%a%C%;!<%8$+$i\e(Bsamba\e$BIC?t<hF@\e(B
 281                  ;;(2ch\e$B0MB8$N\e(Bnavi2ch-multibbs-send-message-error-string\e$B$N1|$NJ}$G8F$VJ}$,H~$7$$5$$,\e(B)
 282                  (if (and (stringp err) navi2ch-message-samba24-show)
 283                      (navi2ch-message-samba24-modify-by-error bbs err))
 284                  )
 285                (cl-return nil)))))))
 286
 287 ;;;-----------------------------------------------
 288
 289 (defun navi2ch-2ch-article-update (board article start)
 290   "BOARD, ARTICLE \e$B$KBP1~$9$k%U%!%$%k$r99?7$9$k!#\e(B
 291 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
 292 \e$BJV$jCM$O\e(B HEADER\e$B!#\e(B"
 293   (let* ((file (navi2ch-article-get-file-name board article))
 294         (time (cdr (assq 'time article)))
 295          (url (navi2ch-article-get-url board article))
 296          (header (if start
 297                      (navi2ch-net-update-file-diff url file time)
 298                    (navi2ch-net-update-file url file time))))
 299
 300     (if (navi2ch-net-get-state 'error header)
 301       (cl-dolist (disable '(nil (gz) (https) (gz https)) header)
 302         (let ((url (navi2ch-article-get-kako-url board article disable))
 303               (others (and (memq 'gz disable)
 304                            '(nil nil nil nil (("Accept-Encoding" . "gzip, deflate")))))
 305               header)
 306
 307           (message "%strying oyster with%s..." (current-message) disable)
 308           (navi2ch-log 'LOG_INFO "%s" (current-message))
 309
 310           (if url
 311               (progn
 312                 (setq header (apply #'navi2ch-net-update-file url file others))
 313       (unless (navi2ch-net-get-state 'error header)
 314                   (message "%ssuccess" (current-message))
 315                   (navi2ch-log 'LOG_INFO "%s" (current-message))
 316                   (dolist (c disable)
 317                     (navi2ch-article-board-disable-capability board 'oyster c))
 318                   (navi2ch-net-add-state 'kako header)
 319                   (cl-return header)))
 320             (message "%sfailed..." (current-message))
 321             (navi2ch-log 'LOG_INFO "%s" (current-message)))))
 322       ; else
 323       header)))
 324
 325 (defun navi2ch-2ch-url-to-board (url)
 326   (let ((lst
 327     (cond ((or (string-match
 328                      "\\(https?\\)://\\(.+\\)/test/\\(read\\.cgi\\|r\\.i\\).*bbs=\\([^&]+\\)" url)
 329                (string-match
 330                      "\\(https?\\)://\\(.+\\)/test/\\(read\\.cgi\\|r\\.i\\)/\\([^/]+\\)/" url))
 331                 (list (match-string 1 url)
 332                       (match-string 2 url)
 333                       (match-string 4 url)))
 334           ((or (string-match
 335                      "\\(https?\\)://\\(.+\\)/\\([^/]+\\)/\\(?:kako\\|oyster\\)/[0-9]+/" url)
 336                (string-match
 337                      "\\(https?\\)://\\(.+\\)/\\([^/]+\\)/i/" url)
 338                (string-match
 339                      "\\(https?\\)://\\(.+\\)/\\([^/]+\\)" url))
 340                 (list (match-string 1 url)
 341                       (match-string 2 url)
 342                       (match-string 3 url))))))
 343     (when lst
 344       (list (cons 'uri
 345                   (format "%s://%s/%s/"
 346                           (nth 0 lst)
 347                           (nth 1 lst)
 348                           (nth 2 lst)))
 349             (cons 'id (nth 2 lst))))))
 350
 351 (defun navi2ch-2ch-url-to-article (url)
 352   "URL \e$B$+$i\e(B article \e$B$KJQ49!#\e(B"
 353   (let (artid number kako)
 354     (cond ((string-match
 355             "https?://.+/test/read\\.cgi.*&key=\\([0-9]+\\)" url)
 356            (setq artid (match-string 1 url))
 357            (when (string-match "&st=\\([0-9]+\\)" url)
 358              (setq number (string-to-number (match-string 1 url)))))
 359           ;; http://pc.2ch.net/test/read.cgi/unix/1065246418/ \e$B$H$+!#\e(B
 360           ((string-match
 361             "https?://.+/test/\\(read\\.cgi\\|r\\.i\\)/[^/]+/\\([^/]+\\)" url)
 362            (setq artid (match-string 2 url))
 363            (when (string-match
 364                   "https?://.+/test/\\(read\\.cgi\\|r\\.i\\)/[^/]+/[^/]+/[ni.]?\\([0-9]+\\)[^/]*$" url)
 365              (setq number (string-to-number (match-string 2 url)))))
 366           ;; "http://pc.2ch.net/unix/kako/999/999166513.html" \e$B$H$+!#\e(B
 367           ;; "http://pc.2ch.net/unix/kako/1009/10093/1009340234.html" \e$B$H$+!#\e(B
 368           ((or (string-match
 369                 "https?://.+/\\(?:kako\\|oyster\\)/[0-9]+/\\([0-9]+\\)\\.\\(dat\\|html\\)" url)
 370                (string-match
 371                 "https?://.+/kako/[0-9]+/[0-9]+/\\([0-9]+\\)\\.\\(dat\\|html\\)" url))
 372            (setq artid (match-string 1 url))
 373            (setq kako t))
 374           ((string-match
 375             "https?://.+/\\([0-9]+\\)\\.\\(dat\\|html\\)" url)
 376            (setq artid (match-string 1 url))))
 377     (let (list)
 378       (when artid
 379         (setq list (cons (cons 'artid artid) list))
 380         (when number
 381           (setq list (cons (cons 'number number) list)))
 382         (when kako
 383           (setq list (cons (cons 'kako kako) list)))
 384         list))))
 385
 386 (defvar navi2ch-2ch-send-message-last-board nil)
 387
 388 (defun navi2ch-2ch-send-message
 389   (from mail message subject bbs key time board article &optional post)
 390   (when (navi2ch-message-samba24-check board)
 391     (let* ((url         (navi2ch-board-get-bbscgi-url board))
 392            (referer     (navi2ch-board-get-uri board))
 393            (param-alist (list
 394                          (cons "submit" "\e$B=q$-9~$`\e(B")
 395                          (cons "FROM"   (or from ""))
 396                          (cons "mail"   (or mail ""))
 397                          (cons "bbs"    bbs)
 398                          (cons "time"   time)
 399                          (cons "MESSAGE" message)
 400                          (if subject
 401                              (cons "subject" subject)
 402                            (cons "key"    key))))
 403            (coding-system (navi2ch-board-get-coding-system board))
 404            (cookies (navi2ch-net-match-cookies url)))
 405       (dolist (param post)
 406         (unless (assoc (car param) param-alist)
 407           (push param param-alist)))
 408       (setq navi2ch-2ch-send-message-last-board board)
 409       (let ((proc
 410              (navi2ch-net-send-request
 411               url "POST"
 412               (list (cons "Content-Type" "application/x-www-form-urlencoded")
 413                     (cons "Cookie"
 414                           (navi2ch-net-cookie-string cookies coding-system))
 415                     (cons "Referer" referer))
 416               (navi2ch-net-get-param-string param-alist
 417                                             coding-system))))
 418         (navi2ch-net-update-cookies url proc coding-system)
 419         (navi2ch-net-save-cookies)
 420         proc))))
 421
 422 (defun navi2ch-2ch-article-to-url
 423   (board article &optional start end nofirst)
 424   "BOARD, ARTICLE \e$B$+$i\e(B url \e$B$KJQ49!#\e(B
 425 START, END, NOFIRST \e$B$GHO0O$r;XDj$9$k\e(B"
 426   (let ((uri (navi2ch-board-get-uri board))
 427         (start (if (numberp start)
 428                    (number-to-string start)
 429                  start))
 430         (end (if (numberp end)
 431                  (number-to-string end)
 432                end)))
 433     (if (string-match "\\(.+\\)/\\([^/]+\\)/$" uri)
 434         (format "%s/test/read.cgi/%s/%s/%s"
 435                 (match-string 1 uri) (match-string 2 uri)
 436                 (cdr (assq 'artid article))
 437                 (if (equal start end)
 438                     (or start "")
 439                   (concat start (and (or start end) "-") end
 440                           (and nofirst "n")))))))
 441
 442 (defun navi2ch-2ch-send-message-success-p (proc)
 443   (navi2ch-net-send-message-success-p
 444    proc
 445    (navi2ch-board-get-coding-system
 446     navi2ch-2ch-send-message-last-board)))
 447
 448 (defun navi2ch-2ch-send-message-error-string (proc)
 449   (navi2ch-net-send-message-error-string
 450    proc
 451    (navi2ch-board-get-coding-system
 452     navi2ch-2ch-send-message-last-board)))
 453
 454 (defun navi2ch-2ch-board-update (board)
 455   (let ((file (navi2ch-board-get-file-name board))
 456         (time (cdr (assq 'time board))))
 457     (let ((url (navi2ch-board-get-url
 458                 board (if navi2ch-board-use-subback-html
 459                           navi2ch-board-subback-file-name)))
 460           (func (navi2ch-multibbs-subject-callback board)))
 461       (navi2ch-net-update-file url file time func))))
 462
 463 (defun navi2ch-2ch-board-get-file-name (board &optional file-name)
 464   (let ((uri (navi2ch-board-get-uri board))
 465         (file-name (or file-name
 466                        navi2ch-board-subject-file-name)))
 467     (when uri
 468       (or navi2ch-2ch-board-file-name-cache
 469           (setq navi2ch-2ch-board-file-name-cache
 470                 (navi2ch-make-cache navi2ch-2ch-board-file-name-cache-limit
 471                                     'equal)))
 472       (navi2ch-cache-get
 473        (cons uri file-name)
 474        (cond ((string-match "https?://\\(?:[^@/]+@\\)?\\(.+\\)" uri)
 475               (navi2ch-expand-file-name
 476                (concat (match-string 1 uri)
 477                        file-name)))
 478              ((string-match "file://\\(.+\\)" uri)
 479               (expand-file-name file-name
 480                                 (match-string 1 uri))))
 481        navi2ch-2ch-board-file-name-cache))))
 482
 483 (defun navi2ch-2ch-extract-post (old-post buffer)
 484   ;; Get hana and mogera from following string.
 485   ;; <input type=hidden name="hana" value="mogera">
 486   (with-current-buffer buffer
 487     (save-excursion
 488       (save-match-data
 489         (goto-char (point-min))
 490         (let ((case-fold-search t)
 491               (re "\\<%s=\\(\"\\([^\"]*\\)\"\\|[^\"> \r\n\t]*\\)")
 492               r)
 493           (while (re-search-forward "<input\\>[^>]+>" nil t)
 494             (let ((str (match-string 0)) name value)
 495               (and (string-match (format re "name") str)
 496                    (setq name (or (match-string 2 str)
 497                                   (match-string 1 str)))
 498                    (string-match (format re "value") str)
 499                    (setq value (or (match-string 2 str)
 500                                    (match-string 1 str)))
 501                    (setq name (navi2ch-replace-html-tag name)
 502                          value (navi2ch-replace-html-tag value))
 503                    (push (cons name value) r))))
 504           (nreverse r))))))
 505
 506 ;;; navi2ch-multibbs.el ends here