[code] Re: Expiration not expiring

[Nicolas Kowalski <Nicolas.Kowalski@imag.fr>]

Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann) writes:

> Nicolas Kowalski <Nicolas.Kowalski@imag.fr> writes:
>
>>     ((string-match "^list." group) 7)	          ;; mailing-lists
>
> Could you verify that the group name is really list.foo and not
> nnml:list.foo? 

Yes it is. nnml is my primary select method.

As i wrote in the message (Message-ID:
<vqovgaxth38.fsf@astazou.imag.fr>), the fact is nnml use the
modification time of the file containing an article to decide if it
must run the expiration process on it. As my nmml groups are fairly
recent, modification times of articles do not match the "real" date of
article.

To handle this, I wrote some simple functions (which look and behave
like nnml-generate-nov-database), to make Gnus modify the date
attributes of the files using the message dates, and the `touch' (FSF
version) utility. See below. It worked for me.

Any comment about these ?


;;
;; file: niko-nnml.el
;;
;; Simple functions for modifying time-related file attributes of nnml group
;; articles, based on the contents of these articles.  
;;
;; When a message date field is valid, change the modification time
;; (using touch command) of the file to this date.
;;
;; To use it M-x niko-nnml-generate-mod-time
;;
;; The commands to execute will be written in *niko-output* buffer, or
;; executed immediatly (not recommended) if niko-nnml-mod-time-exec is
;; set to t
;;


(defun niko-date-to-time (date)
  "Parse a string that represents a date-time and return a time value.
If DATE is malformed, returns nil."
  (condition-case ()
      (date-to-time date)
    (error nil)))

(defvar niko-nnml-mod-time-string-format "%Y%m%d%H%M"
  "Format of the string to be given as date argument to touch")

(defvar niko-nnml-mod-time-touch-cmd "touch -c -t"
  "touch program")

(defvar niko-nnml-mod-time-exec nil
  "Set to `t' if you really want to execute touch commands.
If nil, shells commands are stored in the *niko-output* buffer.")



(defun niko-nnml-regenerate-mod-time-for-files (dir files)
  (let* ((niko-buffer (get-buffer-create "*niko-tmp*"))
	 (niko-output-buffer (get-buffer-create "*niko-output*"))
	 (dir (file-name-as-directory dir)))
    (save-excursion
      (set-buffer niko-output-buffer)
      (while files
	(unless (file-directory-p (setq file (concat dir (cdar files))))
	  (set-buffer niko-buffer)
	  (erase-buffer)
	  (nnheader-insert-file-contents file)
	  (let* ((article-tmp-time (niko-date-to-time (message-fetch-field "Date")))
		 (article-time (if (eq nil article-tmp-time)
				   (nth 5 (file-attributes file))
				 article-tmp-time))
		 (cmd (concat niko-nnml-mod-time-touch-cmd " "
			      (format-time-string 
			       niko-nnml-mod-time-string-format
			       article-time)
			      " "
			      file
			      "\n")))
	    (set-buffer niko-output-buffer)
	    (point-max)
	    (if niko-nnml-mod-time-exec
		(shell-command cmd niko-output-buffer)
	      (insert cmd)
	      )
	    )
	  )
	(setq files (cdr files))
	)
      )
    )
  )


;;;###autoload
(defun niko-nnml-generate-mod-time (&optional server)
  "Generate articles modification times in all nnml directories."
  (interactive (list (or (nnoo-current-server 'nnml) "")))
  ;; Read the active file to make sure we don't re-use articles
  ;; numbers in empty groups.
  (nnmail-activate 'nnml)
  (unless (nnml-server-opened server)
    (nnml-open-server server))
  (setq nnml-directory (expand-file-name nnml-directory))
  ;; Recurse down the directories.
  (niko-nnml-generate-mod-time-1 nnml-directory nil t)
  )

(defun niko-nnml-generate-mod-time-1 (dir &optional seen no-active)
  "Regenerate the articles modification times in DIR."
  (interactive "DRegenerate mod-time in: ")
  (setq dir (file-name-as-directory dir))
  ;; Only scan this sub-tree if we haven't been here yet.
  (unless (member (file-truename dir) seen)
    (push (file-truename dir) seen)
    ;; We descend recursively
    (let ((dirs (directory-files dir t nil t))
	  dir)
      (while (setq dir (pop dirs))
	(when (and (not (string-match "^\\." (file-name-nondirectory dir)))
		   (file-directory-p dir))
	  (niko-nnml-generate-mod-time-1 dir seen))))
    ;; Do this directory.
    (let ((files (sort (nnheader-article-to-file-alist dir)
		       'car-less-than-car)))
      (if (not files)
	  (let* ((group (nnheader-file-to-group
			 (directory-file-name dir) nnml-directory))
		 (info (cadr (assoc group nnml-group-alist))))
	    (when info
	      (setcar info (1+ (cdr info)))))
	;; Generate the mod-time
	(niko-nnml-regenerate-mod-time-for-files dir files)
	))))



(provide 'niko-nnml)