1;;; sb-tech-on.el --- shimbun backend for Tech-On! -*- coding: utf-8 -*- 2 3;; Copyright (C) 2007-2011, 2019 Katsumi Yamaoka 4 5;; Author: Katsumi Yamaoka <yamaoka@jpl.org> 6;; Keywords: news 7 8;; This program is free software; you can redistribute it and/or modify 9;; it under the terms of the GNU General Public License as published by 10;; the Free Software Foundation; either version 2, or (at your option) 11;; any later version. 12 13;; This program is distributed in the hope that it will be useful, 14;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16;; GNU General Public License for more details. 17 18;; You should have received a copy of the GNU General Public License 19;; along with this program; see the file COPYING. If not, write to 20;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 21;; Boston, MA 02110-1301, USA. 22 23;;; Commentary: 24 25;;; Code: 26 27(require 'sb-rss) 28(require 'sb-multi) 29 30(luna-define-class shimbun-tech-on (shimbun-multi shimbun-rss) ()) 31 32(defvar shimbun-tech-on-user-name 'none 33 "*User name to log in on Tech-On! with. 34If it is nil, you will be prompted for a user name when logging in on 35Tech-On! with. If it is a string, it will be used as a user name and 36you will never be prompted. If it is neither nil nor a string, you 37will never log in. See also `shimbun-tech-on-password'.") 38 39(defvar shimbun-tech-on-password 'none 40 "*Password to use to log in on Tech-On! with. 41If it is nil, you will be prompted for a password when logging in on 42Tech-On! with. If it is a string, it will be used as a password and 43you will never be prompted. If it is neither nil nor a string, you 44will never log in. See also `shimbun-tech-on-user-name'.") 45 46(defvar shimbun-tech-on-url "http://techon.nikkeibp.co.jp/") 47 48(defvar shimbun-tech-on-group-table 49 '(("latestnews" "Tech-On！" "/rss/index.rdf") 50 ("mobile" "モバイル" "/mobile/index.rdf") 51 ("bbint" "通信" "/bbint/index.rdf") 52 ("d-ce" "デジタル家電" "/d-ce/index.rdf") 53 ("AT" "Automotive Technology" "/AT/index.rdf") 54 ("edaonline" "EDA Online" "/edaonline/index.rdf") 55 ("device" "電子部品テクノロジ" "/device/index.rdf") 56 ("lsi" "LSI情報局" "/lsi/index.rdf") 57 ("silicon" "Silicon Online" "/silicon/index.rdf") 58 ("observer" "産業動向オブザーバ" "/observer/index.rdf") 59 ("fpd" "FPD International" "/fpd/index.rdf") 60 ("mono" "ものづくりとIT" "/mono/index.rdf") 61 ("embedded" "組み込み開発" "/embedded/index.rdf") 62 ("mecha" "機械・メカトロニクス" "/mecha/index.rdf") 63 ("MEMS" "MEMS International" "/MEMS/index.rdf") 64 ("nano" "ナノテク･新素材" "/nano/index.rdf") 65 ("carele" "カーエレクトロニクス" "/carele/index.rdf") 66 ("board" "日経ボード情報" "/board/index.rdf") 67 ("mcu" "マイコン" "/mcu/index.rdf") 68 ("PLM" "PLM" "/PLM/index.rdf") 69 ("memory" "メモリ" "/memory/index.rdf") 70 ("measurement" "計測" "/measurement/index.rdf") 71 ("column.mot" "技術経営戦略考" "/column/mot/index.rdf"))) 72 73(defvar shimbun-tech-on-server-name "Tech-On!") 74 75(defvar shimbun-tech-on-x-face-alist 76 '(("default" . "\ 77Face: iVBORw0KGgoAAAANSUhEUgAAACAAAAAgAgMAAAAOFJJnAAAADFBMVEUAAAB/gP+ttr7///8 78 c6BRHAAAAnUlEQVQY02XNPQpCMQwA4NBs9jDvCJ5CXEVv4dJQLyKuHbyCl3i4Cl3EsSA8+l6NoU0 79 HMVk+8gsEa2b2DP94rs7DYyCExZIlJCMw6NF7AaI5VZgOQMOtEhQYTOjDXuH7FrU7ZG9W8LlOkuE 80 FrPGD0TFnQdlsmSfB240KyYo7F9dxtIrdRbAAln1SHJK2GmQ9ptwOxsTtRawteTrn6QtRz6k/Cwl 81 XeQAAAABJRU5ErkJggg=="))) 82 83(defvar shimbun-tech-on-expiration-days 7) 84 85(luna-define-method shimbun-groups ((shimbun shimbun-tech-on)) 86 (mapcar 'car shimbun-tech-on-group-table)) 87 88(luna-define-method shimbun-current-group-name ((shimbun shimbun-tech-on)) 89 (nth 1 (assoc (shimbun-current-group-internal shimbun) 90 shimbun-tech-on-group-table))) 91 92(luna-define-method shimbun-from-address ((shimbun shimbun-tech-on)) 93 (concat shimbun-tech-on-server-name 94 " (" (shimbun-current-group-name shimbun) ")")) 95 96(luna-define-method shimbun-index-url ((shimbun shimbun-tech-on)) 97 (shimbun-expand-url (nth 2 (assoc (shimbun-current-group-internal shimbun) 98 shimbun-tech-on-group-table)) 99 shimbun-tech-on-url)) 100 101(luna-define-method shimbun-rss-build-message-id ((shimbun shimbun-tech-on) 102 url date) 103 (let ((start 0) 104 rest) 105 (while (string-match "[0-9]+" url start) 106 (push (match-string 0 url) rest) 107 (setq start (match-end 0))) 108 (if rest 109 (concat "<" (mapconcat 'identity (nreverse rest) ".") 110 "." (shimbun-current-group-internal shimbun) 111 "%techon.nikkeibp.co.jp>") 112 (error "Cannot find message-id base")))) 113 114(defvar shimbun-tech-on-logged-in nil) 115 116(defun shimbun-tech-on-login () 117 "Log in on Tech-On! with." 118 (interactive) 119 (when (or (shimbun-interactive-p) 120 (not shimbun-tech-on-logged-in)) 121 (let ((user (cond ((stringp shimbun-tech-on-user-name) 122 shimbun-tech-on-user-name) 123 (shimbun-tech-on-user-name 124 nil) 125 (t 126 (condition-case nil 127 (let (inhibit-quit) 128 (read-string "[Tech-On!] User name: ")) 129 (quit nil))))) 130 pass) 131 (when (and user 132 (not (string-match "\\`[\t ]*\\'" user)) 133 (setq pass (cond ((stringp shimbun-tech-on-password) 134 shimbun-tech-on-password) 135 (shimbun-tech-on-password 136 nil) 137 (t 138 (condition-case nil 139 (let (inhibit-quit) 140 (read-passwd "[Tech-On!] Password: ")) 141 (quit nil))))) 142 (not (string-match "\\`[\t ]*\\'" pass))) 143 (with-temp-buffer 144 (set-buffer-multibyte t) 145 (shimbun-retrieve-url 146 (concat "https://techon.nikkeibp.co.jp/login/login.jsp" 147 "?MODE=LOGIN_EXEC" 148 "&USERID=" user 149 "&PASSWORD=" pass) 150 t) 151 (goto-char (point-min)) 152 (setq shimbun-tech-on-logged-in 153 (not (re-search-forward "\ 154\\(?:ユーザー名\\|パスワード\\).*に誤りがあります。\ 155\\|会員登録が行われていません。\ 156\\|ACTION=\"/login/login\\.jsp\\?MODE=LOGIN_EXEC\"" 157 nil t)))) 158 (if shimbun-tech-on-logged-in 159 (when (shimbun-interactive-p) 160 (message "[Tech-On!] Logged in")) 161 (when (prog2 162 (message nil) 163 (y-or-n-p "[Tech-On!] Login failed; retry? ") 164 (message nil)) 165 (setq shimbun-tech-on-user-name nil 166 shimbun-tech-on-password nil) 167 (shimbun-tech-on-login))))))) 168 169(luna-define-method shimbun-multi-next-url ((shimbun shimbun-tech-on) 170 header url) 171 (goto-char (point-min)) 172 (when (re-search-forward "[\t\n ]*\\(?:（[\t\n ]*\\)*<a[\t\n ]+\ 173\\(?:[^\t\n >]+[\t\n ]+\\)*href=\"\\([^\"]+\\)\"\ 174\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]*>[\t\n ]*次の?ページへ[^<]*</a>" 175 nil t) 176 (shimbun-expand-url (match-string 1) url))) 177 178(luna-define-method shimbun-multi-clear-contents :around ((shimbun 179 shimbun-tech-on) 180 header 181 has-previous-page 182 has-next-page) 183 (when (luna-call-next-method) 184 ;; Insert page delimiter. 185 (when has-previous-page 186 (goto-char (point-min)) 187 (insert "\n") 188 ;; Remove tags that likely cause a newline preceding a page. 189 (when (and (looking-at "[\t\n ]*<\\(h[0-9]+\\|p\\)[\t\n >]") 190 (shimbun-end-of-tag (match-string 1) t)) 191 (replace-match "\n\\3\n"))) 192 t)) 193 194(luna-define-method shimbun-clear-contents :around ((shimbun shimbun-tech-on) 195 header) 196 (let ((author (when (and (re-search-forward "\ 197<div[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*class=\"author\"" nil t) 198 (shimbun-end-of-tag "div" t)) 199 (match-string 2)))) 200 (goto-char (point-min)) 201 (when (and (re-search-forward "\ 202<div[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*id=\"kiji\"" nil t) 203 (shimbun-end-of-tag "div" t)) 204 (delete-region (match-end 1) (point-max)) 205 (insert "\n") 206 (delete-region (point-min) (match-beginning 1)) 207 ;; Remove repeated <p>s. 208 (goto-char (point-min)) 209 (while (re-search-forward "<p>\\([\t\n ]*<p>\\)+" nil t) 210 (delete-region (match-beginning 1) (match-end 0))) 211 ;; Remove useless tags. 212 (shimbun-remove-tags 213 "\\(div\\)[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*class=\"bpimage_click\"" t) 214 (when author 215 (goto-char (point-min)) 216 (insert "<p>" author "</p>\n")) 217 t))) 218 219(luna-define-method shimbun-footer :around ((shimbun shimbun-tech-on) 220 header &optional html) 221 (concat "<div align=\"left\">\n-- <br>\n\ 222この記事の著作権は日経BP社、またはその情報提供者に帰属します。\ 223原物は<a href=\"" 224 (shimbun-article-base-url shimbun header) 225 "\"><u>ここ</u></a>で公開されています。\n</div>\n")) 226 227(luna-define-method shimbun-article :before ((shimbun shimbun-tech-on) 228 &rest args) 229 (shimbun-tech-on-login)) 230 231(luna-define-method shimbun-close :after ((shimbun shimbun-tech-on)) 232 (setq shimbun-tech-on-logged-in nil)) 233 234(provide 'sb-tech-on) 235 236;;; sb-tech-on.el ends here 237