cgit.sxemacs.org Git - gnus/blob - lisp/nnultimate.el

   1 ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board
   2 ;; Copyright (C) 1999 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 'nnweb)
  40 (eval-when-compile
  41   (ignore-errors
  42     (require 'w3)
  43     (require 'url)
  44     (require 'w3-forms)))
  45 ;; Report failure to find w3 at load time if appropriate.
  46 (eval '(progn
  47          (require 'w3)
  48          (require 'url)
  49          (require 'w3-forms)))
  50
  51 (nnoo-declare nnultimate)
  52
  53 (defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
  54   "Where nnultimate will save its files.")
  55
  56 (defvoo nnultimate-address-1 "http://debet.solbors.no/cgi-bin/billboard/"
  57   "The address of the Ultimate bulletin board.")
  58
  59 ;;; Internal variables
  60
  61 (defvar nnultimate-groups nil)
  62 (defvar nnultimate-buffer nil)
  63 (defvar nnultimate-headers nil)
  64 (defvar nnultimate-articles nil)
  65
  66 ;;; Interface functions
  67
  68 (nnoo-define-basics nnultimate)
  69
  70 (deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old)
  71   (nnultimate-possibly-change-server group server)
  72   (let* ((last (car (last articles)))
  73          (did nil)
  74          (start 1)
  75          (entry (gnus-copy-sequence (assoc group nnultimate-groups)))
  76          (sid (nth 2 entry))
  77          (topics (nth 4 entry))
  78          (mapping (nth 5 entry))
  79          (old-total (or (nth 6 entry) 0))
  80          (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000")
  81          (turl "http://debet.solbors.no/billboard/Forum%d/HTML/%06d.html")
  82          headers article subject score from date lines parent point
  83          contents tinfo fetchers map elem)
  84     (save-excursion
  85       (set-buffer nnultimate-buffer)
  86       (erase-buffer)
  87       (url-insert-file-contents
  88        (concat nnultimate-address-1 (format furl sid)))
  89       (setq buffer-file-name nil)
  90       (goto-char (point-min))
  91       (setq contents (nth 2 (car (nth 2
  92                                       (nnultimate-find-forum-table
  93                                        (w3-parse-buffer (current-buffer)))))))
  94       ;; The main idea here is to map Gnus article numbers to
  95       ;; nnultimate article numbers.  Say there are three topics in
  96       ;; this forum, the first with 4 articles, the seconds with 2,
  97       ;; and the third with 1.  Then this will translate into 7 Gnus
  98       ;; article numbers, where 1-4 comes from the first topic, 5-6
  99       ;; from the second and 7 from the third.  Now, then next time
 100       ;; the group is entered, there's 2 new articles in topic one and
 101       ;; 1 in topic three.  Then Gnus article number 8-9 be 5-6 in
 102       ;; topic one and 10 will be the 2 in topic three.
 103       (dolist (row (cdr contents))
 104         (setq row (nth 2 row))
 105         (when (setq a (nnultimate-descend 'a (nth 2 row)))
 106           (setq subject (car (last (nnultimate-text a)))
 107                 href (cdr (assq 'href (nth 1 a))))
 108           (setq garticles (1+ (string-to-number (car (last (nnultimate-text
 109                                                             (nth 4 row)))))))
 110           (string-match "/\\([0-9]+\\).html" href)
 111           (setq topic (string-to-number (match-string 1 href)))
 112           (if (setq tinfo (assq topic topics))
 113               (progn
 114                 (setq old-max (cadr tinfo))
 115                 (setcar (cdr tinfo) garticles))
 116             (setq old-max 0)
 117             (push (list topic garticles subject) topics)
 118             (setcar (nthcdr 4 entry) topics))
 119           (when (not (= old-max garticles))
 120             (setq inc (- garticles old-max))
 121             (setq mapping (nconc mapping
 122                                  (list
 123                                   (list
 124                                    (setq old-total (+ old-total inc))
 125                                    topic (1+ old-max)))))
 126             (incf old-max inc)
 127             (setcar (nthcdr 5 entry) mapping))))
 128       (setq map mapping)
 129       (while (and (setq article (car articles))
 130                   map)
 131         (while (and map
 132                     (> article (caar map)))
 133           (pop map))
 134         (while (and article
 135                     map
 136                     (<= article (caar map)))
 137           (if (setq elem (assq (cadar map) fetchers))
 138               (nconc elem (list (cons article
 139                                       (+ (caddar map)
 140                                          (- (caar map) article)))))
 141             (push (list (cadar map) (cons article
 142                                           (+ (caddar map)
 143                                              (- (caar map) article))))
 144                   fetchers))
 145           (setq article (car (setq articles (cdr articles))))))
 146       ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
 147       ;; so we start fetching the topics that we need to satisfy the
 148       ;; request.
 149       (if (not fetchers)
 150           (save-excursion
 151             (set-buffer nntp-server-buffer)
 152             (erase-buffer))
 153         (setq nnultimate-articles nil)
 154         (with-temp-buffer
 155           (dolist (elem fetchers)
 156             (erase-buffer)
 157             (setq subject (nth 2 (assq (car elem) topics)))
 158             (url-insert-file-contents (format turl sid (car elem)))
 159             (setq buffer-file-name nil)
 160             (goto-char (point-min))
 161             (setq contents
 162                   (cdr
 163                    (nth 2 (car (nth 2
 164                                     (nnultimate-find-forum-table
 165                                      (w3-parse-buffer (current-buffer))))))))
 166             (dolist (art (cdr elem))
 167               (push (list (car art)
 168                           (nth (1- (cdr art)) contents)
 169                           subject)
 170                     nnultimate-articles))))
 171         (setq nnultimate-articles
 172               (sort nnultimate-articles 'car-less-than-car))
 173         ;; Now we have all the articles, conveniently in an alist
 174         ;; where the key is the Gnus article number.
 175         (dolist (articlef nnultimate-articles)
 176           (setq article (nth 0 articlef)
 177                 contents (nth 1 articlef)
 178                 subject (nth 2 articlef))
 179           (setq from (mapconcat 'identity
 180                                 (nnultimate-text (car (nth 2 contents)))
 181                                 " ")
 182                 datel (nnultimate-text (nth 2 (car (cdr (nth 2 contents))))))
 183           (while datel
 184             (when (string-match "Posted" (car datel))
 185               (setq date (substring (car datel) (match-end 0))
 186                     datel nil))
 187             (pop datel))
 188           (when (string-match " *\\([-0-9]+ [0-9:]+\\)[\n ]+" date)
 189             (setq date (match-string 1 date)))
 190           (push
 191            (cons
 192             article
 193             (make-full-mail-header
 194              article subject
 195              from (or date "")
 196              (concat "<" (number-to-string sid) "%"
 197                      (number-to-string article)
 198                      "@ultimate>")
 199              "" 0 0 nil nil))
 200            headers))
 201         (setq nnultimate-headers (sort headers 'car-less-than-car))
 202         (save-excursion
 203           (set-buffer nntp-server-buffer)
 204           (erase-buffer)
 205           (dolist (header nnultimate-headers)
 206             (nnheader-insert-nov (cdr header))))))
 207     'nov))
 208
 209 (deffoo nnultimate-request-group (group &optional server dont-check)
 210   (nnultimate-possibly-change-server nil server)
 211   (let ((elem (assoc group nnultimate-groups)))
 212     (cond
 213      ((not elem)
 214       (nnheader-report 'nnultimate "Group does not exist"))
 215      (t
 216       (nnheader-report 'nnultimate "Opened group %s" group)
 217       (nnheader-insert
 218        "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
 219        (prin1-to-string group))))))
 220
 221 (deffoo nnultimate-close-group (group &optional server)
 222   (nnultimate-possibly-change-server group server)
 223   (when (gnus-buffer-live-p nnultimate-buffer)
 224     (save-excursion
 225       (set-buffer nnultimate-buffer)
 226       (kill-buffer nnultimate-buffer)))
 227   t)
 228
 229 (deffoo nnultimate-request-article (article &optional group server buffer)
 230   (nnultimate-possibly-change-server group server)
 231   (let ((contents (cdr (assq article nnultimate-articles))))
 232     (when contents
 233       (save-excursion
 234         (set-buffer (or buffer nntp-server-buffer))
 235         (erase-buffer)
 236         (apply 'insert (nnultimate-text contents))
 237         (goto-char (point-min))
 238         (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
 239         (let ((header (cdr (assq article nnultimate-headers))))
 240           (nnheader-insert-header header))
 241         (nnheader-report 'nnultimate "Fetched article %s" article)
 242         (cons group article)))))
 243
 244 (deffoo nnultimate-close-server (&optional server)
 245   (when (and (nnultimate-server-opened server)
 246              (gnus-buffer-live-p nnultimate-buffer))
 247     (save-excursion
 248       (set-buffer nnultimate-buffer)
 249       (kill-buffer nnultimate-buffer)))
 250   (nnoo-close-server 'nnultimate server))
 251
 252 (deffoo nnultimate-request-list (&optional server)
 253   (nnultimate-possibly-change-server nil server)
 254   (with-temp-buffer
 255     (url-insert-file-contents (concat nnultimate-address-1 "Ultimate.cgi"))
 256     (setq buffer-file-name nil)
 257     (let ((contents (nth 2 (car (nth 2
 258                                      (nnultimate-find-forum-table
 259                                       (w3-parse-buffer (current-buffer)))))))
 260           sid elem description articles a href group)
 261       (dolist (row contents)
 262         (setq row (nth 2 row))
 263         (when (setq a (nnultimate-descend 'a row))
 264           (setq group (car (last (nnultimate-text a)))
 265                 href (cdr (assq 'href (nth 1 a))))
 266           (setq description (car (last (nnultimate-text (nth 1 row)))))
 267           (setq articles (string-to-number (car (last (nnultimate-text
 268                                                        (nth 2 row))))))
 269           (when href
 270             (string-match "number=\\([0-9]+\\)" href)
 271             (setq forum (string-to-number (match-string 1 href)))
 272             (if (setq elem (assoc group nnultimate-groups))
 273                 (setcar (cdr elem) articles)
 274               (push (list group articles forum description nil nil nil)
 275                     nnultimate-groups))))))
 276     (nnultimate-write-groups)
 277     (nnultimate-generate-active)
 278     t))
 279
 280 (deffoo nnultimate-request-newgroups (date &optional server)
 281   (nnultimate-possibly-change-server nil server)
 282   (nnultimate-generate-active)
 283   t)
 284
 285 (deffoo nnultimate-asynchronous-p ()
 286   nil)
 287
 288 (nnoo-define-skeleton nnultimate)
 289
 290 ;;; Internal functions
 291
 292 (defun nnultimate-possibly-change-server (&optional group server)
 293   (nnultimate-init server)
 294   (when (and server
 295              (not (nnultimate-server-opened server)))
 296     (nnultimate-open-server server))
 297   (unless nnultimate-groups
 298     (nnultimate-read-groups)))
 299
 300 (defun nnultimate-read-groups ()
 301   (let ((file (expand-file-name "groups" nnultimate-directory)))
 302     (when (file-exists-p file)
 303       (with-temp-buffer
 304         (insert-file-contents file)
 305         (goto-char (point-min))
 306         (setq nnultimate-groups (read (current-buffer)))))))
 307
 308 (defun nnultimate-write-groups ()
 309   (with-temp-file (expand-file-name "groups" nnultimate-directory)
 310     (prin1 nnultimate-groups (current-buffer))))
 311
 312 (defun nnultimate-init (server)
 313   "Initialize buffers and such."
 314   (unless (file-exists-p nnultimate-directory)
 315     (gnus-make-directory nnultimate-directory))
 316   (unless (gnus-buffer-live-p nnultimate-buffer)
 317     (setq nnultimate-buffer
 318           (save-excursion
 319             (nnheader-set-temp-buffer
 320              (format " *nnultimate %s*" server))))))
 321
 322 (defun nnultimate-encode-www-form-urlencoded (pairs)
 323   "Return PAIRS encoded for forms."
 324   (mapconcat
 325    (function
 326     (lambda (data)
 327       (concat (w3-form-encode-xwfu (car data)) "="
 328               (w3-form-encode-xwfu (cdr data)))))
 329    pairs "&"))
 330
 331 (defun nnultimate-fetch-form (url pairs)
 332   (let ((url-request-data (nnultimate-encode-www-form-urlencoded pairs))
 333         (url-request-method "POST")
 334         (url-request-extra-headers
 335          '(("Content-type" . "application/x-www-form-urlencoded"))))
 336     (url-insert-file-contents url)
 337     (setq buffer-file-name nil))
 338   t)
 339
 340 (defun nnultimate-decode-entities ()
 341   (goto-char (point-min))
 342   (while (re-search-forward "&\\([a-z]+\\);" nil t)
 343     (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
 344                                                   w3-html-entities))
 345                                        ?#))
 346                    t t)))
 347
 348 (defun nnultimate-remove-markup ()
 349   (goto-char (point-min))
 350   (while (search-forward "<!--" nil t)
 351     (delete-region (match-beginning 0)
 352                    (or (search-forward "-->" nil t)
 353                        (point-max))))
 354   (goto-char (point-min))
 355   (while (re-search-forward "<[^>]+>" nil t)
 356     (replace-match "" t t)))
 357
 358 (defun nnultimate-date-to-date (sdate)
 359   (let ((elem (split-string sdate)))
 360     (concat (substring (nth 0 elem) 0 3) " "
 361             (substring (nth 1 elem) 0 3) " "
 362             (substring (nth 2 elem) 0 2) " "
 363             (substring (nth 3 elem) 1 6) " "
 364             (format-time-string "%Y") " "
 365             (nth 4 elem))))
 366
 367 (defun nnultimate-generate-active ()
 368   (save-excursion
 369     (set-buffer nntp-server-buffer)
 370     (erase-buffer)
 371     (dolist (elem nnultimate-groups)
 372       (insert (prin1-to-string (car elem))
 373               " " (number-to-string (cadr elem)) " 1 y\n"))))
 374
 375 (defun nnultimate-find-forum-table (contents)
 376   (catch 'found
 377     (nnultimate-find-forum-table-1 contents)))
 378
 379 (defun nnultimate-find-forum-table-1 (contents)
 380   (dolist (element contents)
 381     (unless (stringp element)
 382       (when (and (eq (car element) 'table)
 383                  (equalp (cdr (assq 'width (cadr element))) "100%"))
 384         (throw 'found element))
 385       (when (nth 2 element)
 386         (nnultimate-find-forum-table-1 (nth 2 element))))))
 387
 388 (defun nnultimate-descend (type contents)
 389   (catch 'found
 390     (nnultimate-descend-1 type contents)))
 391
 392 (defun nnultimate-descend-1 (type contents)
 393   (when (consp contents)
 394     (when (eq (car contents) type)
 395       (throw 'found contents))
 396     (when (listp (cdr contents))
 397       (dolist (element contents)
 398         (when (consp element)
 399           (nnultimate-descend-1 type element))))))
 400
 401 (defvar nnultimate-text)
 402 (defun nnultimate-text (contents)
 403   (let ((nnultimate-text nil))
 404     (nnultimate-text-1 contents)
 405     (nreverse nnultimate-text)))
 406
 407 (defun nnultimate-text-1 (contents)
 408   (when (consp (car contents))
 409     (dolist (element contents)
 410       (if (stringp element)
 411           (push element nnultimate-text)
 412         (when (consp element)
 413           (nnultimate-text-1 (nth 2 element)))))))
 414
 415
 416 (defun nnultimate-text-1 (contents)
 417   (dolist (element contents)
 418     (if (stringp element)
 419         (push element nnultimate-text)
 420       (when (and (consp element)
 421                  (listp (cdr element)))
 422         (nnultimate-text-1 element)))))
 423
 424 (provide 'nnultimate)
 425
 426 ;;; nnultimate.el ends here