X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnndb.el;h=032d7c0566423d93b49773c504bc973b3adfca69;hp=e7fbbcfa209b0274ad25ea0bdc29eaa2deba591c;hb=754a007c9c67f3506008dab6e7e8943eb51848f2;hpb=d0498ec691ac9cc3f6bdd9f4ba3ac26457cc3d8a diff --git a/lisp/nndb.el b/lisp/nndb.el index e7fbbcfa2..032d7c056 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -1,10 +1,13 @@ ;;; nndb.el --- nndb access for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1997,98 Free Software Foundation, Inc. -;; Author: Kai Grossjohann +;; Author: Masanobu UMEDA +;; Kai Grossjohann +;; Joe Hildebrand +;; David Blacka ;; Keywords: news -;; This file is part of GNU Emacs. +;; This file is NOT part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -23,24 +26,34 @@ ;;; Commentary: -;; I have shamelessly snarfed the code of nntp.el from sgnus. -;; Kai - +;;; This was based upon Kai Grossjohan's shamessly snarfed code and +;;; further modified by Joe Hildebrand. It has been updated for Red +;;; Gnus. + +;; TODO: +;; +;; * Fix bug where server connection can be lost and impossible to regain +;; This hasn't happened to me in a while; think it was fixed in Rgnus +;; +;; * make it handle different nndb servers seemlessly +;; +;; * Optimize expire if FORCE +;; +;; * Optimize move (only expire once) +;; +;; * Deal with add/deletion of groups +;; +;; * make the backend TOUCH an article when marked as expireable (will +;; make article expire 'expiry' days after that moment). ;;- ;; Register nndb with known select methods. -(require 'gnus) -(require 'gnus-load) -(require 'nnmail) - -(setq gnus-valid-select-methods - (cons '("nndb" mail address respool prompt-address) - gnus-valid-select-methods)) - +(gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address) ;;; Code: +(require 'nnmail) (require 'nnheader) (require 'nntp) (eval-when-compile (require 'cl)) @@ -57,7 +70,8 @@ (autoload 'cancel-timer "timer") (autoload 'telnet "telnet" nil t) (autoload 'telnet-send-input "telnet" nil t) - (autoload 'timezone-parse-date "timezone")) + (autoload 'timezone-parse-date "timezone") + (autoload 'gnus-declare-backend "gnus-start")) ;; Declare nndb as derived from nntp @@ -69,20 +83,20 @@ (defvoo nndb-deliver-program "nndel" "*The program used to put a message in an NNDB group.") +(defvoo nndb-server-side-expiry nil + "If t, expiry calculation will occur on the server side") + +(defvoo nndb-set-expire-date-on-mark nil + "If t, the expiry date for a given article will be set to the time +it was marked as expireable; otherwise the date will be the time the +article was posted to nndb") + ;; Variables copied from nntp (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) "Like nntp-server-opened-hook." nntp-server-opened-hook) -;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000") -; "*Parameters to nndb-open-login. Like nntp-rlogin-parameters." -; nntp-rlogin-parameters) - -;(defvoo nndb-rlogin-user-name nil -; "*User name for rlogin connect method." -; nntp-rlogin-user-name) - (defvoo nndb-address "localhost" "*The name of the NNDB server." nntp-address) @@ -91,15 +105,14 @@ "*Port number to connect to." nntp-port-number) -;(defvoo nndb-current-group "" -; "Like nntp-current-group." -; nntp-current-group) +;; change to 'news if you are actually using nndb for news +(defvoo nndb-article-type 'mail) (defvoo nndb-status-string nil "" nntp-status-string) -(defconst nndb-version "nndb 0.3" +(defconst nndb-version "nndb 0.7" "Version numbers of this version of NNDB.") @@ -107,114 +120,194 @@ (nnoo-define-basics nndb) -;; Import other stuff from nntp as is. - -(nnoo-import nndb - (nntp)) - -;;- maybe this should be mail?? -;;-(defun nndb-request-type (group &optional article) -;;- 'news) - ;;------------------------------------------------------------------ -;;- only new stuff below - -; nndb-request-update-info does not exist and is not needed - -; nndb-request-update-mark does not exist and is not needed - -; nndb-request-scan does not exist -; get new mail from somewhere -- maybe this is not needed? -; --> todo - -(deffoo nndb-request-create-group (group &optional server args) - "Creates a group if it doesn't exist yet." - (nntp-send-command "^[23].*\n" "MKGROUP" group)) -; todo -- use some other time than the creation time of the article -; best is time since article has been marked as expirable -(deffoo nndb-request-expire-articles +;; this function turns the lisp list into a string list. There is +;; probably a more efficient way to do this. +(defun nndb-build-article-string (articles) + (let (art-string art) + (while articles + (setq art (pop articles)) + (setq art-string (concat art-string art " "))) + art-string)) + +(defun nndb-build-expire-rest-list (total expire) + (let (art rest) + (while total + (setq art (pop total)) + (if (memq art expire) + () + (push art rest))) + rest)) + + +;; +(deffoo nndb-request-type (group &optional article) + nndb-article-type) + +;; nndb-request-update-info does not exist and is not needed + +;; nndb-request-update-mark does not exist; it should be used to TOUCH +;; articles as they are marked exipirable +(defun nndb-touch-article (group article) + (nntp-send-command nil "X-TOUCH" article)) + +(deffoo nndb-request-update-mark + (group article mark) + "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" + (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) + (nndb-touch-article group article)) + mark) + +;; nndb-request-create-group -- currently this isn't necessary; nndb +;; creates groups on demand. + +;; todo -- use some other time than the creation time of the article +;; best is time since article has been marked as expirable + +(defun nndb-request-expire-articles-local (articles &optional group server force) - "Expires ARTICLES from GROUP on SERVER. -If FORCE, delete regardless of expiration date, otherwise use normal -expiry mechanism." - (let (msg art) - (nntp-possibly-change-group group server) ;;- + "Let gnus do the date check and issue the delete commands." + (let (msg art delete-list (num-delete 0) rest) + (nntp-possibly-change-group group server) (while articles (setq art (pop articles)) - (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art) + (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) (setq msg (nndb-status-message)) - ;; CCC we shouldn't be using the variable nndb-status-string? - (if (string-match "^423" (nnheader-get-report 'nndb)) + (if (string-match "^423" msg) () - (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) - (error "Not a valid response for DATE command: %s" - msg)) - (if (nnmail-expired-article-p - group - (list (string-to-int - (substring msg (match-beginning 1) (match-end 1))) - (string-to-int - (substring msg (match-beginning 2) (match-end 2)))) - force) - (nnheader-message 5 "Deleting article %s in %s..." - art group) - (nntp-send-command "^[23].*\n" "DELETE" art)))))) + (or (string-match "'\\(.+\\)'" msg) + (error "Not a valid response for X-DATE command: %s" + msg)) + (if (nnmail-expired-article-p + group + (gnus-encode-date + (substring msg (match-beginning 1) (match-end 1))) + force) + (progn + (setq delete-list (concat delete-list " " (int-to-string art))) + (setq num-delete (1+ num-delete))) + (push art rest)))) + (if (> (length delete-list) 0) + (progn + (nnheader-message 5 "Deleting %s article(s) from %s" + (int-to-string num-delete) group) + (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) + ) + + (message "") + (nconc rest articles))) + +(defun nndb-get-remote-expire-response () + (let (list) + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (if (looking-at "^[34]") + ;; x-expire returned error--presume no articles were expirable) + (setq list nil) + ;; otherwise, pull all of the following numbers into the list + (re-search-forward "follows\r?\n?" nil t) + (while (re-search-forward "^[0-9]+$" nil t) + (push (string-to-int (match-string 0)) list))) + list)) + +(defun nndb-request-expire-articles-remote + (articles &optional group server force) + "Let the nndb backend expire articles" + (let (days art-string delete-list (num-delete 0)) + (nntp-possibly-change-group group server) + + ;; first calculate the wait period in days + (setq days (or (and nnmail-expiry-wait-function + (funcall nnmail-expiry-wait-function group)) + nnmail-expiry-wait)) + ;; now handle the special cases + (cond (force + (setq days 0)) + ((eq days 'never) + ;; This isn't an expirable group. + (setq days -1)) + ((eq days 'immediate) + (setq days 0))) + + + ;; build article string + (setq art-string (concat days " " (nndb-build-article-string articles))) + (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) + + (setq delete-list (nndb-get-remote-expire-response)) + (setq num-delete (length delete-list)) + (if (> num-delete 0) + (nnheader-message 5 "Deleting %s article(s) from %s" + (int-to-string num-delete) group)) + + (nndb-build-expire-rest-list articles delete-list))) + +(deffoo nndb-request-expire-articles + (articles &optional group server force) + "Expires ARTICLES from GROUP on SERVER. +If FORCE, delete regardless of exiration date, otherwise use normal +expiry mechanism." + (if nndb-server-side-expiry + (nndb-request-expire-articles-remote articles group server force) + (nndb-request-expire-articles-local articles group server force))) (deffoo nndb-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last) "Move ARTICLE (a number) from GROUP on SERVER. Evals ACCEPT-FORM in current buffer, where the article is. Optional LAST is ignored." - (let ((artbuf (get-buffer-create " *nndb move*")) + ;; we guess that the second arg in accept-form is the new group, + ;; which it will be for nndb, which is all that matters anyway + (let ((new-group (nth 1 accept-form)) result) + (nntp-possibly-change-group group server) + + ;; use the move command for nndb-to-nndb moves + (if (string-match "^nndb" new-group) + (let ((new-group-name (gnus-group-real-name new-group))) + (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) + (cons new-group article)) + ;; else move normally + (let ((artbuf (get-buffer-create " *nndb move*"))) + (and + (nndb-request-article article group server artbuf) + (save-excursion + (set-buffer artbuf) + (insert-buffer-substring nntp-server-buffer) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result) + (nndb-request-expire-articles (list article) + group + server + t)) result) - (and - (nndb-request-article article group server artbuf) - (save-excursion - (set-buffer artbuf) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (nndb-request-expire-articles (list article) - group - server - t)) - result)) + ))) (deffoo nndb-request-accept-article (group server &optional last) "The article in the current buffer is put into GROUP." - (nntp-possibly-change-group group server) ;;- - (let (art statmsg) + (nntp-possibly-change-group group server) + (let (art msg) (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) (nnheader-insert "") - (nntp-encode-text) - (nntp-send-buffer "^[23].*\n") - (setq statmsg (nntp-status-message)) - (or (string-match "^\\([0-9]+\\)" statmsg) - (error "nndb: %s" statmsg)) - (setq art (substring statmsg - (match-beginning 1) - (match-end 1))) - (message "nndb: accepted %s" art) - (list art)))) + (nntp-send-buffer "^[23].*\n")) + + (set-buffer nntp-server-buffer) + (setq msg (buffer-string (point-min) (point-max))) + (or (string-match "^\\([0-9]+\\)" msg) + (error "nndb: %s" msg)) + (setq art (substring msg (match-beginning 1) (match-end 1))) + (message "nndb: accepted %s" art) + (list art))) (deffoo nndb-request-replace-article (article group buffer) "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." (set-buffer buffer) - (let (art statmsg) - (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article)) - (nnheader-insert "") - (nntp-encode-text) - (nntp-send-buffer "^[23].*\n") -; (setq statmsg (nntp-status-message)) -; (or (string-match "^\\([0-9]+\\)" statmsg) -; (error "nndb: %s" statmsg)) -; (setq art (substring statmsg -; (match-beginning 1) -; (match-end 1))) -; (message "nndb: replaced %s" art) - (list (int-to-string article))))) + (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) + (nnheader-insert "") + (nntp-send-buffer "^[23.*\n") + (list (int-to-string article)))) ; nndb-request-delete-group does not exist ; todo -- maybe later @@ -222,6 +315,19 @@ with the contents of the BUFFER." ; nndb-request-rename-group does not exist ; todo -- maybe later +;; -- standard compatability functions + +(deffoo nndb-status-message (&optional server) + "Return server status as a string." + (set-buffer nntp-server-buffer) + (buffer-string (point-min) (point-max))) + +;; Import stuff from nntp + +(nnoo-import nndb + (nntp)) + (provide 'nndb) +