1 ;;; nnwfm.el --- interfacing with a web forum
2 ;; Copyright (C) 2000 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
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)
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.
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.
26 ;; Note: You need to have `url' and `w3' installed for this
31 (eval-when-compile (require 'cl))
42 ;; Report failure to find w3 at load time if appropriate.
43 (eval '(require 'nnweb))
47 (defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/")
48 "Where nnwfm will save its files.")
50 (defvoo nnwfm-address ""
51 "The address of the Ultimate bulletin board.")
53 ;;; Internal variables
55 (defvar nnwfm-groups-alist nil)
56 (defvoo nnwfm-groups nil)
57 (defvoo nnwfm-headers nil)
58 (defvoo nnwfm-articles nil)
59 (defvar nnwfm-table-regexp
60 "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
62 ;;; Interface functions
64 (nnoo-define-basics nnwfm)
66 (deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old)
67 (nnwfm-possibly-change-server group server)
68 (unless gnus-nov-is-evil
69 (let* ((last (car (last articles)))
72 (entry (assoc group nnwfm-groups))
74 (topics (nth 4 entry))
75 (mapping (nth 5 entry))
76 (old-total (or (nth 6 entry) 1))
77 (nnwfm-table-regexp "Thread.asp")
78 headers article subject score from date lines parent point
79 contents tinfo fetchers map elem a href garticles topic old-max
80 inc datel table string current-page total-contents pages
81 farticles forum-contents parse furl-fetched mmap farticle
82 thread-id tables hstuff bstuff time)
84 (while (and (setq article (car articles))
87 (or (> article (caar map))
88 (< (cadar map) (caar map))))
90 (when (setq mmap (car map))
93 (<= article (nth 1 mmap)))
94 ;; Do we already have a fetcher for this topic?
95 (if (setq elem (assq (nth 2 mmap) fetchers))
96 ;; Yes, so we just add the spec to the end.
97 (nconc elem (list (cons article
98 (+ (nth 3 mmap) (incf farticle)))))
99 ;; No, so we add a new one.
100 (push (list (nth 2 mmap)
102 (+ (nth 3 mmap) (incf farticle))))
105 (setq article (car articles)))))
106 ;; Now we have the mapping from/to Gnus/nnwfm article numbers,
107 ;; so we start fetching the topics that we need to satisfy the
111 (set-buffer nntp-server-buffer)
113 (setq nnwfm-articles nil)
114 (mm-with-unibyte-buffer
115 (dolist (elem fetchers)
117 (setq subject (nth 2 (assq (car elem) topics))
118 thread-id (nth 0 (assq (car elem) topics)))
120 (concat nnwfm-address
121 (format "Item.asp?GroupID=%d&ThreadID=%d" sid
123 (goto-char (point-min))
125 (ignore-errors (w3-parse-buffer (current-buffer))))
126 (setq tables (caddar (caddar (cdr (caddar (caddar contents))))))
127 (setq tables (cdr (caddar (memq (assq 'div tables) tables))))
129 (dolist (table tables)
130 (setq table (caddar (caddar (caddr table)))
131 hstuff (delete ":link" (nnweb-text (car table)))
132 bstuff (car (caddar (cdr table)))
135 (setq time (nnwfm-date-to-time (nth 2 hstuff)))
136 (push (list from time bstuff) contents)))
137 (setq contents (nreverse contents))
138 (dolist (art (cdr elem))
139 (push (list (car art)
140 (nth (1- (cdr art)) contents)
144 (sort nnwfm-articles 'car-less-than-car))
145 ;; Now we have all the articles, conveniently in an alist
146 ;; where the key is the Gnus article number.
147 (dolist (articlef nnwfm-articles)
148 (setq article (nth 0 articlef)
149 contents (nth 1 articlef)
150 subject (nth 2 articlef))
151 (setq from (nth 0 contents)
152 date (message-make-date (nth 1 contents)))
156 (make-full-mail-header
159 (concat "<" (number-to-string sid) "%"
160 (number-to-string article)
163 (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) ""))
167 (setq nnwfm-headers (sort headers 'car-less-than-car))
169 (set-buffer nntp-server-buffer)
170 (mm-with-unibyte-current-buffer
172 (dolist (header nnwfm-headers)
173 (nnheader-insert-nov (cdr header))))))
176 (deffoo nnwfm-request-group (group &optional server dont-check)
177 (nnwfm-possibly-change-server nil server)
178 (when (not nnwfm-groups)
179 (nnwfm-request-list))
181 (nnwfm-create-mapping group))
182 (let ((elem (assoc group nnwfm-groups)))
185 (nnheader-report 'nnwfm "Group does not exist"))
187 (nnheader-report 'nnwfm "Opened group %s" group)
189 "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
190 (prin1-to-string group))))))
192 (deffoo nnwfm-request-close ()
193 (setq nnwfm-groups-alist nil
196 (deffoo nnwfm-request-article (article &optional group server buffer)
197 (nnwfm-possibly-change-server group server)
198 (let ((contents (cdr (assq article nnwfm-articles))))
199 (when (setq contents (nth 2 (car contents)))
201 (set-buffer (or buffer nntp-server-buffer))
203 (nnweb-insert-html contents)
204 (goto-char (point-min))
205 (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
206 (let ((header (cdr (assq article nnwfm-headers))))
207 (mm-with-unibyte-current-buffer
208 (nnheader-insert-header header)))
209 (nnheader-report 'nnwfm "Fetched article %s" article)
210 (cons group article)))))
212 (deffoo nnwfm-request-list (&optional server)
213 (nnwfm-possibly-change-server nil server)
214 (mm-with-unibyte-buffer
216 (if (string-match "/$" nnwfm-address)
217 (concat nnwfm-address "Group.asp")
219 (let* ((nnwfm-table-regexp "Thread.asp")
220 (contents (w3-parse-buffer (current-buffer)))
221 sid elem description articles a href group forum
223 (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table
225 (setq row (nth 2 row))
226 (when (setq a (nnweb-parse-find 'a row))
227 (setq group (car (last (nnweb-text a)))
228 href (cdr (assq 'href (nth 1 a))))
229 (setq description (car (last (nnweb-text (nth 1 row)))))
232 (nnweb-replace-in-string
233 (car (last (nnweb-text (nth 3 row)))) "," "")))
235 (string-match "GroupId=\\([0-9]+\\)" href))
236 (setq forum (string-to-number (match-string 1 href)))
237 (if (setq elem (assoc group nnwfm-groups))
238 (setcar (cdr elem) articles)
239 (push (list group articles forum description nil nil nil nil)
242 (nnwfm-generate-active)
245 (deffoo nnwfm-request-newgroups (date &optional server)
246 (nnwfm-possibly-change-server nil server)
247 (nnwfm-generate-active)
250 (nnoo-define-skeleton nnwfm)
252 ;;; Internal functions
254 (defun nnwfm-new-threads-p (group time)
255 "See whether we want to fetch the threads for GROUP written before TIME."
256 (let ((old-time (nth 7 (assoc group nnwfm-groups))))
258 (time-less-p old-time time))))
260 (defun nnwfm-create-mapping (group)
261 (let* ((entry (assoc group nnwfm-groups))
263 (topics (nth 4 entry))
264 (mapping (nth 5 entry))
265 (old-total (or (nth 6 entry) 1))
266 (current-time (current-time))
267 (nnwfm-table-regexp "Thread.asp")
268 (furls (list (concat nnwfm-address
269 (format "Thread.asp?GroupId=%d" sid))))
271 contents forum-contents a subject href
272 garticles topic tinfo old-max inc parse elem date
274 (mm-with-unibyte-buffer
277 (push (car furls) fetched-urls)
278 (nnweb-insert (pop furls))
279 (goto-char (point-min))
280 (while (re-search-forward " wr(" nil t)
282 (setq elem (message-tokenize-header
289 (string-to-number (nth 1 elem))
290 (nnweb-replace-in-string (nth 2 elem) "\"" "")
291 (string-to-number (nth 5 elem)))
293 (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)"
295 (setq url (match-string 1)
296 time (nnwfm-date-to-time (url-unhex-string (match-string 2))))
297 (when (and (nnwfm-new-threads-p group time)
301 (nnweb-decode-entities-string url)))
304 ;; The main idea here is to map Gnus article numbers to
305 ;; nnwfm article numbers. Say there are three topics in
306 ;; this forum, the first with 4 articles, the seconds with 2,
307 ;; and the third with 1. Then this will translate into 7 Gnus
308 ;; article numbers, where 1-4 comes from the first topic, 5-6
309 ;; from the second and 7 from the third. Now, then next time
310 ;; the group is entered, there's 2 new articles in topic one
311 ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
312 ;; in topic one and 10 will be the 2 in topic three.
313 (dolist (elem (nreverse forum-contents))
314 (setq subject (nth 1 elem)
316 garticles (nth 2 elem))
317 (if (setq tinfo (assq topic topics))
319 (setq old-max (cadr tinfo))
320 (setcar (cdr tinfo) garticles))
322 (push (list topic garticles subject) topics)
323 (setcar (nthcdr 4 entry) topics))
324 (when (not (= old-max garticles))
325 (setq inc (- garticles old-max))
326 (setq mapping (nconc mapping
329 old-total (1- (incf old-total inc))
330 topic (1+ old-max)))))
332 (setcar (nthcdr 5 entry) mapping)
333 (setcar (nthcdr 6 entry) old-total))))
334 (setcar (nthcdr 7 entry) current-time)
335 (setcar (nthcdr 1 entry) (1- old-total))
339 (defun nnwfm-possibly-change-server (&optional group server)
342 (not (nnwfm-server-opened server)))
343 (nnwfm-open-server server))
344 (unless nnwfm-groups-alist
346 (setq nnwfm-groups (cdr (assoc nnwfm-address
347 nnwfm-groups-alist)))))
349 (deffoo nnwfm-open-server (server &optional defs connectionless)
350 (nnheader-init-server-buffer)
351 (if (nnwfm-server-opened server)
353 (unless (assq 'nnwfm-address defs)
354 (setq defs (append defs (list (list 'nnwfm-address server)))))
355 (nnoo-change-server 'nnwfm server defs)))
357 (defun nnwfm-read-groups ()
358 (setq nnwfm-groups-alist nil)
359 (let ((file (expand-file-name "groups" nnwfm-directory)))
360 (when (file-exists-p file)
361 (mm-with-unibyte-buffer
362 (insert-file-contents file)
363 (goto-char (point-min))
364 (setq nnwfm-groups-alist (read (current-buffer)))))))
366 (defun nnwfm-write-groups ()
367 (setq nnwfm-groups-alist
368 (delq (assoc nnwfm-address nnwfm-groups-alist)
370 (push (cons nnwfm-address nnwfm-groups)
372 (with-temp-file (expand-file-name "groups" nnwfm-directory)
373 (prin1 nnwfm-groups-alist (current-buffer))))
375 (defun nnwfm-init (server)
376 "Initialize buffers and such."
377 (unless (file-exists-p nnwfm-directory)
378 (gnus-make-directory nnwfm-directory)))
380 (defun nnwfm-generate-active ()
382 (set-buffer nntp-server-buffer)
384 (dolist (elem nnwfm-groups)
385 (insert (prin1-to-string (car elem))
386 " " (number-to-string (cadr elem)) " 1 y\n"))))
388 (defun nnwfm-find-forum-table (contents)
390 (nnwfm-find-forum-table-1 contents)))
392 (defun nnwfm-find-forum-table-1 (contents)
393 (dolist (element contents)
394 (unless (stringp element)
395 (when (and (eq (car element) 'table)
396 (nnwfm-forum-table-p element))
397 (throw 'found element))
398 (when (nth 2 element)
399 (nnwfm-find-forum-table-1 (nth 2 element))))))
401 (defun nnwfm-forum-table-p (parse)
402 (when (not (apply 'gnus-or
405 (nnweb-parse-find 'table p))
407 (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
409 (when (and href (string-match nnwfm-table-regexp href))
412 (defun nnwfm-date-to-time (date)
413 (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]"))))
414 (encode-time 0 (nth 4 time) (nth 3 time)
415 (nth 0 time) (nth 1 time)
416 (if (< (nth 2 time) 70)
417 (+ 2000 (nth 2 time))
418 (+ 1900 (nth 2 time))))))
423 ;; coding: iso-8859-1
426 ;;; nnwfm.el ends here