1 |
|
;;; nnwfm.el --- interfacing with a web forum |
2 |
|
;; Copyright (C) 2000 Free Software Foundation, Inc. |
3 |
|
|
4 |
|
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
5 |
|
;; Keywords: news |
6 |
|
|
7 |
|
;; This file is part of GNU Emacs. |
8 |
|
|
9 |
|
;; GNU Emacs is free software; you can redistribute it and/or modify |
10 |
|
;; it under the terms of the GNU General Public License as published by |
11 |
|
;; the Free Software Foundation; either version 2, or (at your option) |
12 |
|
;; any later version. |
13 |
|
|
14 |
|
;; GNU Emacs is distributed in the hope that it will be useful, |
15 |
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
16 |
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
17 |
|
;; GNU General Public License for more details. |
18 |
|
|
19 |
|
;; You should have received a copy of the GNU General Public License |
20 |
|
;; along with GNU Emacs; see the file COPYING. If not, write to the |
21 |
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
22 |
|
;; Boston, MA 02111-1307, USA. |
23 |
|
|
24 |
|
;;; Commentary: |
25 |
|
|
26 |
|
;; Note: You need to have `url' and `w3' installed for this |
27 |
|
;; backend to work. |
28 |
|
|
29 |
|
;;; Code: |
30 |
|
|
31 |
|
(eval-when-compile (require 'cl)) |
32 |
|
|
33 |
|
(require 'nnoo) |
34 |
|
(require 'message) |
35 |
|
(require 'gnus-util) |
36 |
|
(require 'gnus) |
37 |
|
(require 'nnmail) |
38 |
|
(require 'mm-util) |
39 |
|
(require 'mm-url) |
40 |
|
(require 'nnweb) |
41 |
|
(autoload 'w3-parse-buffer "w3-parse") |
42 |
|
|
43 |
|
(nnoo-declare nnwfm) |
44 |
|
|
45 |
|
(defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/") |
46 |
|
"Where nnwfm will save its files.") |
47 |
|
|
48 |
|
(defvoo nnwfm-address "" |
49 |
|
"The address of the Ultimate bulletin board.") |
50 |
|
|
51 |
|
;;; Internal variables |
52 |
|
|
53 |
|
(defvar nnwfm-groups-alist nil) |
54 |
|
(defvoo nnwfm-groups nil) |
55 |
|
(defvoo nnwfm-headers nil) |
56 |
|
(defvoo nnwfm-articles nil) |
57 |
|
(defvar nnwfm-table-regexp |
58 |
|
"postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") |
59 |
|
|
60 |
|
;;; Interface functions |
61 |
|
|
62 |
|
(nnoo-define-basics nnwfm) |
63 |
|
|
64 |
|
(deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old) |
65 |
|
(nnwfm-possibly-change-server group server) |
66 |
|
(unless gnus-nov-is-evil |
67 |
|
(let* ((last (car (last articles))) |
68 |
|
(did nil) |
69 |
|
(start 1) |
70 |
|
(entry (assoc group nnwfm-groups)) |
71 |
|
(sid (nth 2 entry)) |
72 |
|
(topics (nth 4 entry)) |
73 |
|
(mapping (nth 5 entry)) |
74 |
|
(old-total (or (nth 6 entry) 1)) |
75 |
|
(nnwfm-table-regexp "Thread.asp") |
76 |
|
headers article subject score from date lines parent point |
77 |
|
contents tinfo fetchers map elem a href garticles topic old-max |
78 |
|
inc datel table string current-page total-contents pages |
79 |
|
farticles forum-contents parse furl-fetched mmap farticle |
80 |
|
thread-id tables hstuff bstuff time) |
81 |
|
(setq map mapping) |
82 |
|
(while (and (setq article (car articles)) |
83 |
|
map) |
84 |
|
(while (and map |
85 |
|
(or (> article (caar map)) |
86 |
|
(< (cadar map) (caar map)))) |
87 |
|
(pop map)) |
88 |
|
(when (setq mmap (car map)) |
89 |
|
(setq farticle -1) |
90 |
|
(while (and article |
91 |
|
(<= article (nth 1 mmap))) |
92 |
|
;; Do we already have a fetcher for this topic? |
93 |
|
(if (setq elem (assq (nth 2 mmap) fetchers)) |
94 |
|
;; Yes, so we just add the spec to the end. |
95 |
|
(nconc elem (list (cons article |
96 |
|
(+ (nth 3 mmap) (incf farticle))))) |
97 |
|
;; No, so we add a new one. |
98 |
|
(push (list (nth 2 mmap) |
99 |
|
(cons article |
100 |
|
(+ (nth 3 mmap) (incf farticle)))) |
101 |
|
fetchers)) |
102 |
|
(pop articles) |
103 |
|
(setq article (car articles))))) |
104 |
|
;; Now we have the mapping from/to Gnus/nnwfm article numbers, |
105 |
|
;; so we start fetching the topics that we need to satisfy the |
106 |
|
;; request. |
107 |
|
(if (not fetchers) |
108 |
|
(save-excursion |
109 |
|
(set-buffer nntp-server-buffer) |
110 |
|
(erase-buffer)) |
111 |
|
(setq nnwfm-articles nil) |
112 |
|
(mm-with-unibyte-buffer |
113 |
|
(dolist (elem fetchers) |
114 |
|
(erase-buffer) |
115 |
|
(setq subject (nth 2 (assq (car elem) topics)) |
116 |
|
thread-id (nth 0 (assq (car elem) topics))) |
117 |
|
(mm-url-insert |
118 |
|
(concat nnwfm-address |
119 |
|
(format "Item.asp?GroupID=%d&ThreadID=%d" sid |
120 |
|
thread-id))) |
121 |
|
(goto-char (point-min)) |
122 |
|
(setq tables (caddar |
123 |
|
(caddar |
124 |
|
(cdr (caddar |
125 |
|
(caddar |
126 |
|
(ignore-errors |
127 |
|
(w3-parse-buffer (current-buffer))))))))) |
128 |
|
(setq tables (cdr (caddar (memq (assq 'div tables) tables)))) |
129 |
|
(setq contents nil) |
130 |
|
(dolist (table tables) |
131 |
|
(when (eq (car table) 'table) |
132 |
|
(setq table (caddar (caddar (caddr table))) |
133 |
|
hstuff (delete ":link" (nnweb-text (car table))) |
134 |
|
bstuff (car (caddar (cdr table))) |
135 |
|
from (car hstuff)) |
136 |
|
(when (nth 2 hstuff) |
137 |
|
(setq time (nnwfm-date-to-time (nth 2 hstuff))) |
138 |
|
(push (list from time bstuff) contents)))) |
139 |
|
(setq contents (nreverse contents)) |
140 |
|
(dolist (art (cdr elem)) |
141 |
|
(push (list (car art) |
142 |
|
(nth (1- (cdr art)) contents) |
143 |
|
subject) |
144 |
|
nnwfm-articles)))) |
145 |
|
(setq nnwfm-articles |
146 |
|
(sort nnwfm-articles 'car-less-than-car)) |
147 |
|
;; Now we have all the articles, conveniently in an alist |
148 |
|
;; where the key is the Gnus article number. |
149 |
|
(dolist (articlef nnwfm-articles) |
150 |
|
(setq article (nth 0 articlef) |
151 |
|
contents (nth 1 articlef) |
152 |
|
subject (nth 2 articlef)) |
153 |
|
(setq from (nth 0 contents) |
154 |
|
date (message-make-date (nth 1 contents))) |
155 |
|
(push |
156 |
|
(cons |
157 |
|
article |
158 |
|
(make-full-mail-header |
159 |
|
article subject |
160 |
|
from (or date "") |
161 |
|
(concat "<" (number-to-string sid) "%" |
162 |
|
(number-to-string article) |
163 |
|
"@wfm>") |
164 |
|
"" 0 |
165 |
|
(/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) "")) |
166 |
|
70) |
167 |
|
nil nil)) |
168 |
|
headers)) |
169 |
|
(setq nnwfm-headers (sort headers 'car-less-than-car)) |
170 |
|
(save-excursion |
171 |
|
(set-buffer nntp-server-buffer) |
172 |
|
(mm-with-unibyte-current-buffer |
173 |
|
(erase-buffer) |
174 |
|
(dolist (header nnwfm-headers) |
175 |
|
(nnheader-insert-nov (cdr header)))))) |
176 |
|
'nov))) |
177 |
|
|
178 |
|
(deffoo nnwfm-request-group (group &optional server dont-check) |
179 |
|
(nnwfm-possibly-change-server nil server) |
180 |
|
(when (not nnwfm-groups) |
181 |
|
(nnwfm-request-list)) |
182 |
|
(unless dont-check |
183 |
|
(nnwfm-create-mapping group)) |
184 |
|
(let ((elem (assoc group nnwfm-groups))) |
185 |
|
(cond |
186 |
|
((not elem) |
187 |
|
(nnheader-report 'nnwfm "Group does not exist")) |
188 |
|
(t |
189 |
|
(nnheader-report 'nnwfm "Opened group %s" group) |
190 |
|
(nnheader-insert |
191 |
|
"211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) |
192 |
|
(prin1-to-string group)))))) |
193 |
|
|
194 |
|
(deffoo nnwfm-request-close () |
195 |
|
(setq nnwfm-groups-alist nil |
196 |
|
nnwfm-groups nil)) |
197 |
|
|
198 |
|
(deffoo nnwfm-request-article (article &optional group server buffer) |
199 |
|
(nnwfm-possibly-change-server group server) |
200 |
|
(let ((contents (cdr (assq article nnwfm-articles)))) |
201 |
|
(when (setq contents (nth 2 (car contents))) |
202 |
|
(save-excursion |
203 |
|
(set-buffer (or buffer nntp-server-buffer)) |
204 |
|
(erase-buffer) |
205 |
|
(nnweb-insert-html contents) |
206 |
|
(goto-char (point-min)) |
207 |
|
(insert "Content-Type: text/html\nMIME-Version: 1.0\n") |
208 |
|
(let ((header (cdr (assq article nnwfm-headers)))) |
209 |
|
(mm-with-unibyte-current-buffer |
210 |
|
(nnheader-insert-header header))) |
211 |
|
(nnheader-report 'nnwfm "Fetched article %s" article) |
212 |
|
(cons group article))))) |
213 |
|
|
214 |
|
(deffoo nnwfm-request-list (&optional server) |
215 |
|
(nnwfm-possibly-change-server nil server) |
216 |
|
(mm-with-unibyte-buffer |
217 |
|
(mm-url-insert |
218 |
|
(if (string-match "/$" nnwfm-address) |
219 |
|
(concat nnwfm-address "Group.asp") |
220 |
|
nnwfm-address)) |
221 |
|
(let* ((nnwfm-table-regexp "Thread.asp") |
222 |
|
(contents (w3-parse-buffer (current-buffer))) |
223 |
|
sid elem description articles a href group forum |
224 |
|
a1 a2) |
225 |
|
(dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table |
226 |
|
contents)))))) |
227 |
|
(setq row (nth 2 row)) |
228 |
|
(when (setq a (nnweb-parse-find 'a row)) |
229 |
|
(setq group (car (last (nnweb-text a))) |
230 |
|
href (cdr (assq 'href (nth 1 a)))) |
231 |
|
(setq description (car (last (nnweb-text (nth 1 row))))) |
232 |
|
(setq articles |
233 |
|
(string-to-number |
234 |
|
(gnus-replace-in-string |
235 |
|
(car (last (nnweb-text (nth 3 row)))) "," ""))) |
236 |
|
(when (and href |
237 |
|
(string-match "GroupId=\\([0-9]+\\)" href)) |
238 |
|
(setq forum (string-to-number (match-string 1 href))) |
239 |
|
(if (setq elem (assoc group nnwfm-groups)) |
240 |
|
(setcar (cdr elem) articles) |
241 |
|
(push (list group articles forum description nil nil nil nil) |
242 |
|
nnwfm-groups)))))) |
243 |
|
(nnwfm-write-groups) |
244 |
|
(nnwfm-generate-active) |
245 |
|
t)) |
246 |
|
|
247 |
|
(deffoo nnwfm-request-newgroups (date &optional server) |
248 |
|
(nnwfm-possibly-change-server nil server) |
249 |
|
(nnwfm-generate-active) |
250 |
|
t) |
251 |
|
|
252 |
|
(nnoo-define-skeleton nnwfm) |
253 |
|
|
254 |
|
;;; Internal functions |
255 |
|
|
256 |
|
(defun nnwfm-new-threads-p (group time) |
257 |
|
"See whether we want to fetch the threads for GROUP written before TIME." |
258 |
|
(let ((old-time (nth 7 (assoc group nnwfm-groups)))) |
259 |
|
(or (null old-time) |
260 |
|
(time-less-p old-time time)))) |
261 |
|
|
262 |
|
(defun nnwfm-create-mapping (group) |
263 |
|
(let* ((entry (assoc group nnwfm-groups)) |
264 |
|
(sid (nth 2 entry)) |
265 |
|
(topics (nth 4 entry)) |
266 |
|
(mapping (nth 5 entry)) |
267 |
|
(old-total (or (nth 6 entry) 1)) |
268 |
|
(current-time (current-time)) |
269 |
|
(nnwfm-table-regexp "Thread.asp") |
270 |
|
(furls (list (concat nnwfm-address |
271 |
|
(format "Thread.asp?GroupId=%d" sid)))) |
272 |
|
fetched-urls |
273 |
|
contents forum-contents a subject href |
274 |
|
garticles topic tinfo old-max inc parse elem date |
275 |
|
url time) |
276 |
|
(mm-with-unibyte-buffer |
277 |
|
(while furls |
278 |
|
(erase-buffer) |
279 |
|
(push (car furls) fetched-urls) |
280 |
|
(mm-url-insert (pop furls)) |
281 |
|
(goto-char (point-min)) |
282 |
|
(while (re-search-forward " wr(" nil t) |
283 |
|
(forward-char -1) |
284 |
|
(setq elem (message-tokenize-header |
285 |
|
(gnus-replace-in-string |
286 |
|
(buffer-substring |
287 |
|
(1+ (point)) |
288 |
|
(progn |
289 |
|
(forward-sexp 1) |
290 |
|
(1- (point)))) |
291 |
|
"\\\\[\"\\\\]" ""))) |
292 |
|
(push (list |
293 |
|
(string-to-number (nth 1 elem)) |
294 |
|
(gnus-replace-in-string (nth 2 elem) "\"" "") |
295 |
|
(string-to-number (nth 5 elem))) |
296 |
|
forum-contents)) |
297 |
|
(when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)" |
298 |
|
nil t) |
299 |
|
(setq url (match-string 1) |
300 |
|
time (nnwfm-date-to-time (gnus-url-unhex-string |
301 |
|
(match-string 2)))) |
302 |
|
(when (and (nnwfm-new-threads-p group time) |
303 |
|
(not (member |
304 |
|
(setq url (concat |
305 |
|
nnwfm-address |
306 |
|
(mm-url-decode-entities-string url))) |
307 |
|
fetched-urls))) |
308 |
|
(push url furls)))) |
309 |
|
;; The main idea here is to map Gnus article numbers to |
310 |
|
;; nnwfm article numbers. Say there are three topics in |
311 |
|
;; this forum, the first with 4 articles, the seconds with 2, |
312 |
|
;; and the third with 1. Then this will translate into 7 Gnus |
313 |
|
;; article numbers, where 1-4 comes from the first topic, 5-6 |
314 |
|
;; from the second and 7 from the third. Now, then next time |
315 |
|
;; the group is entered, there's 2 new articles in topic one |
316 |
|
;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 |
317 |
|
;; in topic one and 10 will be the 2 in topic three. |
318 |
|
(dolist (elem (nreverse forum-contents)) |
319 |
|
(setq subject (nth 1 elem) |
320 |
|
topic (nth 0 elem) |
321 |
|
garticles (nth 2 elem)) |
322 |
|
(if (setq tinfo (assq topic topics)) |
323 |
|
(progn |
324 |
|
(setq old-max (cadr tinfo)) |
325 |
|
(setcar (cdr tinfo) garticles)) |
326 |
|
(setq old-max 0) |
327 |
|
(push (list topic garticles subject) topics) |
328 |
|
(setcar (nthcdr 4 entry) topics)) |
329 |
|
(when (not (= old-max garticles)) |
330 |
|
(setq inc (- garticles old-max)) |
331 |
|
(setq mapping (nconc mapping |
332 |
|
(list |
333 |
|
(list |
334 |
|
old-total (1- (incf old-total inc)) |
335 |
|
topic (1+ old-max))))) |
336 |
|
(incf old-max inc) |
337 |
|
(setcar (nthcdr 5 entry) mapping) |
338 |
|
(setcar (nthcdr 6 entry) old-total)))) |
339 |
|
(setcar (nthcdr 7 entry) current-time) |
340 |
|
(setcar (nthcdr 1 entry) (1- old-total)) |
341 |
|
(nnwfm-write-groups) |
342 |
|
mapping)) |
343 |
|
|
344 |
|
(defun nnwfm-possibly-change-server (&optional group server) |
345 |
|
(nnwfm-init server) |
346 |
|
(when (and server |
347 |
|
(not (nnwfm-server-opened server))) |
348 |
|
(nnwfm-open-server server)) |
349 |
|
(unless nnwfm-groups-alist |
350 |
|
(nnwfm-read-groups) |
351 |
|
(setq nnwfm-groups (cdr (assoc nnwfm-address |
352 |
|
nnwfm-groups-alist))))) |
353 |
|
|
354 |
|
(deffoo nnwfm-open-server (server &optional defs connectionless) |
355 |
|
(nnheader-init-server-buffer) |
356 |
|
(if (nnwfm-server-opened server) |
357 |
|
t |
358 |
|
(unless (assq 'nnwfm-address defs) |
359 |
|
(setq defs (append defs (list (list 'nnwfm-address server))))) |
360 |
|
(nnoo-change-server 'nnwfm server defs))) |
361 |
|
|
362 |
|
(defun nnwfm-read-groups () |
363 |
|
(setq nnwfm-groups-alist nil) |
364 |
|
(let ((file (expand-file-name "groups" nnwfm-directory))) |
365 |
|
(when (file-exists-p file) |
366 |
|
(mm-with-unibyte-buffer |
367 |
|
(insert-file-contents file) |
368 |
|
(goto-char (point-min)) |
369 |
|
(setq nnwfm-groups-alist (read (current-buffer))))))) |
370 |
|
|
371 |
|
(defun nnwfm-write-groups () |
372 |
|
(setq nnwfm-groups-alist |
373 |
|
(delq (assoc nnwfm-address nnwfm-groups-alist) |
374 |
|
nnwfm-groups-alist)) |
375 |
|
(push (cons nnwfm-address nnwfm-groups) |
376 |
|
nnwfm-groups-alist) |
377 |
|
(with-temp-file (expand-file-name "groups" nnwfm-directory) |
378 |
|
(prin1 nnwfm-groups-alist (current-buffer)))) |
379 |
|
|
380 |
|
(defun nnwfm-init (server) |
381 |
|
"Initialize buffers and such." |
382 |
|
(unless (file-exists-p nnwfm-directory) |
383 |
|
(gnus-make-directory nnwfm-directory))) |
384 |
|
|
385 |
|
(defun nnwfm-generate-active () |
386 |
|
(save-excursion |
387 |
|
(set-buffer nntp-server-buffer) |
388 |
|
(erase-buffer) |
389 |
|
(dolist (elem nnwfm-groups) |
390 |
|
(insert (prin1-to-string (car elem)) |
391 |
|
" " (number-to-string (cadr elem)) " 1 y\n")))) |
392 |
|
|
393 |
|
(defun nnwfm-find-forum-table (contents) |
394 |
|
(catch 'found |
395 |
|
(nnwfm-find-forum-table-1 contents))) |
396 |
|
|
397 |
|
(defun nnwfm-find-forum-table-1 (contents) |
398 |
|
(dolist (element contents) |
399 |
|
(unless (stringp element) |
400 |
|
(when (and (eq (car element) 'table) |
401 |
|
(nnwfm-forum-table-p element)) |
402 |
|
(throw 'found element)) |
403 |
|
(when (nth 2 element) |
404 |
|
(nnwfm-find-forum-table-1 (nth 2 element)))))) |
405 |
|
|
406 |
|
(defun nnwfm-forum-table-p (parse) |
407 |
|
(when (not (apply 'gnus-or |
408 |
|
(mapcar |
409 |
|
(lambda (p) |
410 |
|
(nnweb-parse-find 'table p)) |
411 |
|
(nth 2 parse)))) |
412 |
|
(let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) |
413 |
|
case-fold-search) |
414 |
|
(when (and href (string-match nnwfm-table-regexp href)) |
415 |
|
t)))) |
416 |
|
|
417 |
|
(defun nnwfm-date-to-time (date) |
418 |
|
(let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]")))) |
419 |
|
(encode-time 0 (nth 4 time) (nth 3 time) |
420 |
|
(nth 0 time) (nth 1 time) |
421 |
|
(if (< (nth 2 time) 70) |
422 |
|
(+ 2000 (nth 2 time)) |
423 |
|
(+ 1900 (nth 2 time)))))) |
424 |
|
|
425 |
|
(provide 'nnwfm) |
426 |
|
|
427 |
|
;; Local Variables: |
428 |
|
;; coding: iso-8859-1 |
429 |
|
;; End: |
430 |
|
|
431 |
|
;;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536 |
432 |
|
;;; nnwfm.el ends here |