1;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system 2 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; Keywords: news 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs 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;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; Note: You need to have `url' and `w3' installed for this 29;; backend to work. 30 31;;; Code: 32 33(eval-when-compile (require 'cl)) 34 35(require 'nnoo) 36(require 'message) 37(require 'gnus-util) 38(require 'gnus) 39(require 'nnmail) 40(require 'mm-util) 41(require 'mm-url) 42(require 'nnweb) 43(require 'parse-time) 44(autoload 'w3-parse-buffer "w3-parse") 45 46(nnoo-declare nnultimate) 47 48(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/") 49 "Where nnultimate will save its files.") 50 51(defvoo nnultimate-address "" 52 "The address of the Ultimate bulletin board.") 53 54;;; Internal variables 55 56(defvar nnultimate-groups-alist nil) 57(defvoo nnultimate-groups nil) 58(defvoo nnultimate-headers nil) 59(defvoo nnultimate-articles nil) 60(defvar nnultimate-table-regexp 61 "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") 62 63;;; Interface functions 64 65(nnoo-define-basics nnultimate) 66 67(deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old) 68 (nnultimate-possibly-change-server group server) 69 (unless gnus-nov-is-evil 70 (let* ((last (car (last articles))) 71 (did nil) 72 (start 1) 73 (entry (assoc group nnultimate-groups)) 74 (sid (nth 2 entry)) 75 (topics (nth 4 entry)) 76 (mapping (nth 5 entry)) 77 (old-total (or (nth 6 entry) 1)) 78 (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000") 79 (furls (list (concat nnultimate-address (format furl sid)))) 80 (nnultimate-table-regexp 81 "postings.*editpost\\|forumdisplay\\|getbio") 82 headers article subject score from date lines parent point 83 contents tinfo fetchers map elem a href garticles topic old-max 84 inc datel table current-page total-contents pages 85 farticles forum-contents parse furl-fetched mmap farticle) 86 (setq map mapping) 87 (while (and (setq article (car articles)) 88 map) 89 ;; Skip past the articles in the map until we reach the 90 ;; article we're looking for. 91 (while (and map 92 (or (> article (caar map)) 93 (< (cadar map) (caar map)))) 94 (pop map)) 95 (when (setq mmap (car map)) 96 (setq farticle -1) 97 (while (and article 98 (<= article (nth 1 mmap))) 99 ;; Do we already have a fetcher for this topic? 100 (if (setq elem (assq (nth 2 mmap) fetchers)) 101 ;; Yes, so we just add the spec to the end. 102 (nconc elem (list (cons article 103 (+ (nth 3 mmap) (incf farticle))))) 104 ;; No, so we add a new one. 105 (push (list (nth 2 mmap) 106 (cons article 107 (+ (nth 3 mmap) (incf farticle)))) 108 fetchers)) 109 (pop articles) 110 (setq article (car articles))))) 111 ;; Now we have the mapping from/to Gnus/nnultimate article numbers, 112 ;; so we start fetching the topics that we need to satisfy the 113 ;; request. 114 (if (not fetchers) 115 (save-excursion 116 (set-buffer nntp-server-buffer) 117 (erase-buffer)) 118 (setq nnultimate-articles nil) 119 (mm-with-unibyte-buffer 120 (dolist (elem fetchers) 121 (setq pages 1 122 current-page 1 123 total-contents nil) 124 (while (<= current-page pages) 125 (erase-buffer) 126 (setq subject (nth 2 (assq (car elem) topics))) 127 (setq href (nth 3 (assq (car elem) topics))) 128 (if (= current-page 1) 129 (mm-url-insert href) 130 (string-match "\\.html$" href) 131 (mm-url-insert (concat (substring href 0 (match-beginning 0)) 132 "-" (number-to-string current-page) 133 (match-string 0 href)))) 134 (goto-char (point-min)) 135 (setq contents 136 (ignore-errors (w3-parse-buffer (current-buffer)))) 137 (setq table (nnultimate-find-forum-table contents)) 138 (goto-char (point-min)) 139 (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t) 140 (setq pages (string-to-number (match-string 1)))) 141 (setq contents (cdr (nth 2 (car (nth 2 table))))) 142 (setq total-contents (nconc total-contents contents)) 143 (incf current-page)) 144 (when t 145 (let ((i 0)) 146 (dolist (co total-contents) 147 (push (list (or (nnultimate-topic-article-to-article 148 group (car elem) (incf i)) 149 1) 150 co subject) 151 nnultimate-articles)))) 152 (when nil 153 (dolist (art (cdr elem)) 154 (when (nth (1- (cdr art)) total-contents) 155 (push (list (car art) 156 (nth (1- (cdr art)) total-contents) 157 subject) 158 nnultimate-articles)))))) 159 (setq nnultimate-articles 160 (sort nnultimate-articles 'car-less-than-car)) 161 ;; Now we have all the articles, conveniently in an alist 162 ;; where the key is the Gnus article number. 163 (dolist (articlef nnultimate-articles) 164 (setq article (nth 0 articlef) 165 contents (nth 1 articlef) 166 subject (nth 2 articlef)) 167 (setq from (mapconcat 'identity 168 (nnweb-text (car (nth 2 contents))) 169 " ") 170 datel (nnweb-text (nth 2 (car (cdr (nth 2 contents)))))) 171 (while datel 172 (when (string-match "Posted" (car datel)) 173 (setq date (substring (car datel) (match-end 0)) 174 datel nil)) 175 (pop datel)) 176 (when date 177 (setq date (delete "" (split-string date "[-, \n\t\r ���]"))) 178 (setq date 179 (if (or (member "AM" date) 180 (member "PM" date)) 181 (format 182 "%s %s %s %s" 183 (nth 1 date) 184 (if (and (>= (length (nth 0 date)) 3) 185 (assoc (downcase 186 (substring (nth 0 date) 0 3)) 187 parse-time-months)) 188 (substring (nth 0 date) 0 3) 189 (car (rassq (string-to-number (nth 0 date)) 190 parse-time-months))) 191 (nth 2 date) (nth 3 date)) 192 (format "%s %s %s %s" 193 (car (rassq (string-to-number (nth 1 date)) 194 parse-time-months)) 195 (nth 0 date) (nth 2 date) (nth 3 date))))) 196 (push 197 (cons 198 article 199 (make-full-mail-header 200 article subject 201 from (or date "") 202 (concat "<" (number-to-string sid) "%" 203 (number-to-string article) 204 "@ultimate." server ">") 205 "" 0 206 (/ (length (mapconcat 207 'identity 208 (nnweb-text 209 (cdr (nth 2 (nth 1 (nth 2 contents))))) 210 "")) 211 70) 212 nil nil)) 213 headers)) 214 (setq nnultimate-headers (sort headers 'car-less-than-car)) 215 (save-excursion 216 (set-buffer nntp-server-buffer) 217 (mm-with-unibyte-current-buffer 218 (erase-buffer) 219 (dolist (header nnultimate-headers) 220 (nnheader-insert-nov (cdr header)))))) 221 'nov))) 222 223(defun nnultimate-topic-article-to-article (group topic article) 224 (catch 'found 225 (dolist (elem (nth 5 (assoc group nnultimate-groups))) 226 (when (and (= topic (nth 2 elem)) 227 (>= article (nth 3 elem)) 228 (< article (+ (- (nth 1 elem) (nth 0 elem)) 1 229 (nth 3 elem)))) 230 (throw 'found 231 (+ (nth 0 elem) (- article (nth 3 elem)))))))) 232 233(deffoo nnultimate-request-group (group &optional server dont-check) 234 (nnultimate-possibly-change-server nil server) 235 (when (not nnultimate-groups) 236 (nnultimate-request-list)) 237 (unless dont-check 238 (nnultimate-create-mapping group)) 239 (let ((elem (assoc group nnultimate-groups))) 240 (cond 241 ((not elem) 242 (nnheader-report 'nnultimate "Group does not exist")) 243 (t 244 (nnheader-report 'nnultimate "Opened group %s" group) 245 (nnheader-insert 246 "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) 247 (prin1-to-string group)))))) 248 249(deffoo nnultimate-request-close () 250 (setq nnultimate-groups-alist nil 251 nnultimate-groups nil)) 252 253(deffoo nnultimate-request-article (article &optional group server buffer) 254 (nnultimate-possibly-change-server group server) 255 (let ((contents (cdr (assq article nnultimate-articles)))) 256 (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents)))))) 257 (when contents 258 (save-excursion 259 (set-buffer (or buffer nntp-server-buffer)) 260 (erase-buffer) 261 (nnweb-insert-html (cons 'p (cons nil (list contents)))) 262 (goto-char (point-min)) 263 (insert "Content-Type: text/html\nMIME-Version: 1.0\n") 264 (let ((header (cdr (assq article nnultimate-headers)))) 265 (mm-with-unibyte-current-buffer 266 (nnheader-insert-header header))) 267 (nnheader-report 'nnultimate "Fetched article %s" article) 268 (cons group article))))) 269 270(deffoo nnultimate-request-list (&optional server) 271 (nnultimate-possibly-change-server nil server) 272 (mm-with-unibyte-buffer 273 (mm-url-insert 274 (if (string-match "/$" nnultimate-address) 275 (concat nnultimate-address "Ultimate.cgi") 276 nnultimate-address)) 277 (let ((contents (nth 2 (car (nth 2 278 (nnultimate-find-forum-table 279 (w3-parse-buffer (current-buffer))))))) 280 sid elem description articles a href group forum 281 a1 a2) 282 (dolist (row contents) 283 (setq row (nth 2 row)) 284 (when (setq a (nnweb-parse-find 'a row)) 285 (setq group (car (last (nnweb-text a))) 286 href (cdr (assq 'href (nth 1 a)))) 287 (setq description (car (last (nnweb-text (nth 1 row))))) 288 (setq a1 (car (last (nnweb-text (nth 2 row))))) 289 (setq a2 (car (last (nnweb-text (nth 3 row))))) 290 (when (string-match "^[0-9]+$" a1) 291 (setq articles (string-to-number a1))) 292 (when (and a2 (string-match "^[0-9]+$" a2)) 293 (setq articles (max articles (string-to-number a2)))) 294 (when href 295 (string-match "number=\\([0-9]+\\)" href) 296 (setq forum (string-to-number (match-string 1 href))) 297 (if (setq elem (assoc group nnultimate-groups)) 298 (setcar (cdr elem) articles) 299 (push (list group articles forum description nil nil nil nil) 300 nnultimate-groups)))))) 301 (nnultimate-write-groups) 302 (nnultimate-generate-active) 303 t)) 304 305(deffoo nnultimate-request-newgroups (date &optional server) 306 (nnultimate-possibly-change-server nil server) 307 (nnultimate-generate-active) 308 t) 309 310(nnoo-define-skeleton nnultimate) 311 312;;; Internal functions 313 314(defun nnultimate-prune-days (group time) 315 "Compute the number of days to fetch info for." 316 (let ((old-time (nth 7 (assoc group nnultimate-groups)))) 317 (if (null old-time) 318 1000 319 (- (time-to-days time) (time-to-days old-time))))) 320 321(defun nnultimate-create-mapping (group) 322 (let* ((entry (assoc group nnultimate-groups)) 323 (sid (nth 2 entry)) 324 (topics (nth 4 entry)) 325 (mapping (nth 5 entry)) 326 (old-total (or (nth 6 entry) 1)) 327 (current-time (current-time)) 328 (furl 329 (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune=" 330 (number-to-string 331 (nnultimate-prune-days group current-time)))) 332 (furls (list (concat nnultimate-address (format furl sid)))) 333 contents forum-contents furl-fetched a subject href 334 garticles topic tinfo old-max inc parse) 335 (mm-with-unibyte-buffer 336 (while furls 337 (erase-buffer) 338 (mm-url-insert (pop furls)) 339 (goto-char (point-min)) 340 (setq parse (w3-parse-buffer (current-buffer))) 341 (setq contents 342 (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table 343 parse)))))) 344 (setq forum-contents (nconc contents forum-contents)) 345 (unless furl-fetched 346 (setq furl-fetched t) 347 ;; On the first time through this loop, we find all the 348 ;; forum URLs. 349 (dolist (a (nnweb-parse-find-all 'a parse)) 350 (let ((href (cdr (assq 'href (nth 1 a))))) 351 (when (and href 352 (string-match "forumdisplay.*startpoint" href)) 353 (push href furls)))) 354 (setq furls (nreverse furls)))) 355 ;; The main idea here is to map Gnus article numbers to 356 ;; nnultimate article numbers. Say there are three topics in 357 ;; this forum, the first with 4 articles, the seconds with 2, 358 ;; and the third with 1. Then this will translate into 7 Gnus 359 ;; article numbers, where 1-4 comes from the first topic, 5-6 360 ;; from the second and 7 from the third. Now, then next time 361 ;; the group is entered, there's 2 new articles in topic one 362 ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 363 ;; in topic one and 10 will be the 2 in topic three. 364 (dolist (row (nreverse forum-contents)) 365 (setq row (nth 2 row)) 366 (when (setq a (nnweb-parse-find 'a row)) 367 (setq subject (car (last (nnweb-text a))) 368 href (cdr (assq 'href (nth 1 a)))) 369 (let ((artlist (nreverse (nnweb-text row))) 370 art) 371 (while (and (not art) 372 artlist) 373 (when (string-match "^[0-9]+$" (car artlist)) 374 (setq art (1+ (string-to-number (car artlist))))) 375 (pop artlist)) 376 (setq garticles art)) 377 (when garticles 378 (string-match "/\\([0-9]+\\).html" href) 379 (setq topic (string-to-number (match-string 1 href))) 380 (if (setq tinfo (assq topic topics)) 381 (progn 382 (setq old-max (cadr tinfo)) 383 (setcar (cdr tinfo) garticles)) 384 (setq old-max 0) 385 (push (list topic garticles subject href) topics) 386 (setcar (nthcdr 4 entry) topics)) 387 (when (not (= old-max garticles)) 388 (setq inc (- garticles old-max)) 389 (setq mapping (nconc mapping 390 (list 391 (list 392 old-total (1- (incf old-total inc)) 393 topic (1+ old-max))))) 394 (incf old-max inc) 395 (setcar (nthcdr 5 entry) mapping) 396 (setcar (nthcdr 6 entry) old-total)))))) 397 (setcar (nthcdr 7 entry) current-time) 398 (setcar (nthcdr 1 entry) (1- old-total)) 399 (nnultimate-write-groups) 400 mapping)) 401 402(defun nnultimate-possibly-change-server (&optional group server) 403 (nnultimate-init server) 404 (when (and server 405 (not (nnultimate-server-opened server))) 406 (nnultimate-open-server server)) 407 (unless nnultimate-groups-alist 408 (nnultimate-read-groups) 409 (setq nnultimate-groups (cdr (assoc nnultimate-address 410 nnultimate-groups-alist))))) 411 412(deffoo nnultimate-open-server (server &optional defs connectionless) 413 (nnheader-init-server-buffer) 414 (if (nnultimate-server-opened server) 415 t 416 (unless (assq 'nnultimate-address defs) 417 (setq defs (append defs (list (list 'nnultimate-address server))))) 418 (nnoo-change-server 'nnultimate server defs))) 419 420(defun nnultimate-read-groups () 421 (setq nnultimate-groups-alist nil) 422 (let ((file (expand-file-name "groups" nnultimate-directory))) 423 (when (file-exists-p file) 424 (mm-with-unibyte-buffer 425 (insert-file-contents file) 426 (goto-char (point-min)) 427 (setq nnultimate-groups-alist (read (current-buffer))))))) 428 429(defun nnultimate-write-groups () 430 (setq nnultimate-groups-alist 431 (delq (assoc nnultimate-address nnultimate-groups-alist) 432 nnultimate-groups-alist)) 433 (push (cons nnultimate-address nnultimate-groups) 434 nnultimate-groups-alist) 435 (with-temp-file (expand-file-name "groups" nnultimate-directory) 436 (prin1 nnultimate-groups-alist (current-buffer)))) 437 438(defun nnultimate-init (server) 439 "Initialize buffers and such." 440 (unless (file-exists-p nnultimate-directory) 441 (gnus-make-directory nnultimate-directory))) 442 443(defun nnultimate-generate-active () 444 (save-excursion 445 (set-buffer nntp-server-buffer) 446 (erase-buffer) 447 (dolist (elem nnultimate-groups) 448 (insert (prin1-to-string (car elem)) 449 " " (number-to-string (cadr elem)) " 1 y\n")))) 450 451(defun nnultimate-find-forum-table (contents) 452 (catch 'found 453 (nnultimate-find-forum-table-1 contents))) 454 455(defun nnultimate-find-forum-table-1 (contents) 456 (dolist (element contents) 457 (unless (stringp element) 458 (when (and (eq (car element) 'table) 459 (nnultimate-forum-table-p element)) 460 (throw 'found element)) 461 (when (nth 2 element) 462 (nnultimate-find-forum-table-1 (nth 2 element)))))) 463 464(defun nnultimate-forum-table-p (parse) 465 (when (not (apply 'gnus-or 466 (mapcar 467 (lambda (p) 468 (nnweb-parse-find 'table p)) 469 (nth 2 parse)))) 470 (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) 471 case-fold-search) 472 (when (and href (string-match nnultimate-table-regexp href)) 473 t)))) 474 475(provide 'nnultimate) 476 477;; Local Variables: 478;; coding: iso-8859-1 479;; End: 480 481;;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8 482;;; nnultimate.el ends here 483