[PATCH] Expiry based on headers

[PATCH] Expiry based on headers

[Nevin Kapur]

Recently, I've seen a few requests for a function that will expire
articles based on their headers.  I've been using such a function for
a while.  I am proposing it for inclusion into Gnus.

ChangeLog:

2001-12-08  Nevin Kapur  <nevin@jhu.edu>

	* nnmail.el (nnmail-fancy-expiry-targets): New variable.
	(nnmail-fancy-expiry-target): Use it.



Index: lisp/nnmail.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/nnmail.el,v
retrieving revision 6.27
diff -u -r6.27 nnmail.el
--- lisp/nnmail.el	2001/09/26 17:55:05	6.27
+++ lisp/nnmail.el	2001/12/08 16:33:42
@@ -190,6 +190,16 @@
 		 (function :format "%v" nnmail-)
 		 string))
 
+;; Need to make this a defcustom
+(defvar nnmail-fancy-expiry-targets nil 
+  "A list of (\"header\" \"regexp\" \"target\" \"date format\").  If
+`nnmail-expiry-target' is set to `nnmail-fancy-expiry-target' and the 
+header matches the regexp, the message will be expired to the target
+group with the date in the specified format, appended.  If no date
+format is specified the %Y is assumed.  In the special cases that
+header is from, the regexp will match the from or to header.  See
+the manual for examples.")
+
 (defcustom nnmail-cache-accepted-message-ids nil
   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
 If non-nil, also update the cache when copy or move articles."
@@ -1699,6 +1709,38 @@
       (setq target (funcall target group)))
     (unless (eq target 'delete)
       (gnus-request-accept-article target nil nil t))))
+
+(defun nnmail-fancy-expiry-target (group)
+  "Returns a target expiry group depending on the last match in nnmail-fancy-expiry-targets."
+  (if (or (string= group "drafts") (string= group "queue"))
+      'delete
+    (let* (header
+	   (case-fold-search nil)
+	   (from (or (message-fetch-field "from") ""))
+	   (to (or (message-fetch-field "to") ""))
+	   (date (date-to-time
+		  (or (message-fetch-field "date") (current-time-string))))
+	   (target 'delete))
+      ;; Note that last match will be returned.
+      (dolist (regexp-target-pair nnmail-fancy-expiry-targets target)
+	(setq header (car regexp-target-pair))
+	(cond
+	 ;; If the header is "from" or "to" match either field
+	 ((and (or (string-match header "from") (string-match header "to"))
+	       (or (string-match (cadr regexp-target-pair) from)
+		   (and (string-match message-dont-reply-to-names from)
+			(string-match (cadr regexp-target-pair) to))))
+	  (setq target (concat (caddr regexp-target-pair)
+			       "-"
+			       (format-time-string
+				(or (cadddr regexp-target-pair) "%Y") date))))
+	 ((string-match (cadr regexp-target-pair) (message-fetch-field header))
+	  (setq target (concat (caddr regexp-target-pair)
+			       "-"
+			       (format-time-string
+				(or (cadddr regexp-target-pair) "%Y")
+				date)))))))))
+  
 
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."


Here is the manual entry:

Index: texi/gnus.texi
===================================================================
RCS file: /usr/local/cvsroot/gnus/texi/gnus.texi,v
retrieving revision 6.189
diff -u -r6.189 gnus.texi
--- texi/gnus.texi	2001/12/05 10:15:25	6.189
+++ texi/gnus.texi	2001/12/08 16:37:14
@@ -13073,6 +13073,26 @@
 (setq nnmail-expiry-target "nnml:expired")
 @end lisp
 
+Gnus provides a function @code{nnmail-fancy-expiry-target} which will
+expire mail to groups according to the variable
+@code{nnmail-fancy-expiry-targets}.  Here's an example:
+
+@lisp
+ (setq nnmail-expiry-target 'nnmail-fancy-expiry-target
+       nnmail-fancy-expiry-targets
+       '(("from" ".*" "nnfolder:Archive" "%Y-%b")
+    	 ("subject" "IMPORTANT" "nnfolder:IMPORTANT")
+	 ("from" "boss" "nnfolder:Work")))
+@end lisp
+
+With this setup, any mail that has @code{IMPORTANT} in its Subject
+header and was sent in the year @code{YYYY}, will get expired to the
+group @code{nnfolder:IMPORTANT-YYYY}. If its From or To header contains
+the string @code{boss}, it will get expired to
+@code{nnfolder:Work-YYYY}. All other mail will get expired to
+@code{nnfolder:Archive-YYYY-MMM}.
+
+
 
 @vindex nnmail-keep-last-article
 If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never

-- 
Nevin

Re: [PATCH] Expiry based on headers

[Simon Josefsson]

Nevin Kapur <nevin@jhu.edu> writes:

> Recently, I've seen a few requests for a function that will expire
> articles based on their headers.  I've been using such a function for
> a while.  I am proposing it for inclusion into Gnus.

Looks useful.  Have you signed papers?

> +;; Need to make this a defcustom
> +(defvar nnmail-fancy-expiry-targets nil 
> +  "A list of (\"header\" \"regexp\" \"target\" \"date format\").  If
> +`nnmail-expiry-target' is set to `nnmail-fancy-expiry-target' and the 
> +header matches the regexp, the message will be expired to the target
> +group with the date in the specified format, appended.  If no date
> +format is specified the %Y is assumed.  In the special cases that
> +header is from, the regexp will match the from or to header.  See
> +the manual for examples.")
> +

Would you like to work on the custom :type?

> +(defun nnmail-fancy-expiry-target (group)
> +  "Returns a target expiry group depending on the last match in nnmail-fancy-expiry-targets."
> +  (if (or (string= group "drafts") (string= group "queue"))
> +      'delete

Is this necessary?  I happen to actually have a group named "queue"
that isn't the same as the nndraft:queue one (which I assume is
intended).  If the user doesn't want expiry-target for drafts/queue
groups, she should make sure the expiry-target is nil for those
groups.

> +      ;; Note that last match will be returned.
> +      (dolist (regexp-target-pair nnmail-fancy-expiry-targets target)

Maybe a (reverse ...) is good here?  Splitting code in Gnus usually
take the first match, I think.

> +	(setq header (car regexp-target-pair))
> +	(cond
> +	 ;; If the header is "from" or "to" match either field
> +	 ((and (or (string-match header "from") (string-match header "to"))
> +	       (or (string-match (cadr regexp-target-pair) from)
> +		   (and (string-match message-dont-reply-to-names from)
> +			(string-match (cadr regexp-target-pair) to))))

Perhaps this logic could be used only when the regexp-target-pair is
the symbol `to-from' instead of the strings "from" or "to"?

> +	  (setq target (concat (caddr regexp-target-pair)
> +			       "-"

If you remove the "-" you can use something like:

(setq nnmail-expiry-target 'nnmail-fancy-expiry-target
      nnmail-fancy-expiry-targets
      '(("subject" "IMPORTANT" "nnfolder:IMPORTANT" "")

and have the resulting folder look like "nnfolder:IMPORTANT".  Also,
some people (like me) would want to use "." as a separator instead of
"-" so making it part of the regexp-target-pair is probably easier.

Re: [PATCH] Expiry based on headers

[Nevin Kapur]

Simon Josefsson <jas@extundo.com> writes:

> Nevin Kapur <nevin@jhu.edu> writes:
>
>> Recently, I've seen a few requests for a function that will expire
>> articles based on their headers.  I've been using such a function for
>> a while.  I am proposing it for inclusion into Gnus.
>
> Looks useful.  Have you signed papers?

Yep.

>> +;; Need to make this a defcustom
>> +(defvar nnmail-fancy-expiry-targets nil 
>> +  "A list of (\"header\" \"regexp\" \"target\" \"date format\").  If
>> +`nnmail-expiry-target' is set to `nnmail-fancy-expiry-target' and the 
>> +header matches the regexp, the message will be expired to the target
>> +group with the date in the specified format, appended.  If no date
>> +format is specified the %Y is assumed.  In the special cases that
>> +header is from, the regexp will match the from or to header.  See
>> +the manual for examples.")
>> +
>
> Would you like to work on the custom :type?

I would.  This was a first pass.  I imagine there is a simple custom
:type that would suffice in this case.  I just don't know what it is.

>> +(defun nnmail-fancy-expiry-target (group)
>> +  "Returns a target expiry group depending on the last match in nnmail-fancy-expiry-targets."
>> +  (if (or (string= group "drafts") (string= group "queue"))
>> +      'delete
>
> Is this necessary?  I happen to actually have a group named "queue"
> that isn't the same as the nndraft:queue one (which I assume is
> intended).  If the user doesn't want expiry-target for drafts/queue
> groups, she should make sure the expiry-target is nil for those
> groups.

I agree that this is a kludge.  But I've noticed that nndrafts groups
behave strangely with expiry.  If I understand you correctly, would
setting expiry-target to nil for a group bypass expiry for that group?

>
>> +      ;; Note that last match will be returned.
>> +      (dolist (regexp-target-pair nnmail-fancy-expiry-targets target)
>
> Maybe a (reverse ...) is good here?  Splitting code in Gnus usually
> take the first match, I think.

Good idea.

>> +	(setq header (car regexp-target-pair))
>> +	(cond
>> +	 ;; If the header is "from" or "to" match either field
>> +	 ((and (or (string-match header "from") (string-match header "to"))
>> +	       (or (string-match (cadr regexp-target-pair) from)
>> +		   (and (string-match message-dont-reply-to-names from)
>> +			(string-match (cadr regexp-target-pair) to))))
>
> Perhaps this logic could be used only when the regexp-target-pair is
> the symbol `to-from' instead of the strings "from" or "to"?

Agreed.

>> +	  (setq target (concat (caddr regexp-target-pair)
>> +			       "-"
>
> If you remove the "-" you can use something like:
>
> (setq nnmail-expiry-target 'nnmail-fancy-expiry-target
>       nnmail-fancy-expiry-targets
>       '(("subject" "IMPORTANT" "nnfolder:IMPORTANT" "")
>
> and have the resulting folder look like "nnfolder:IMPORTANT".  Also,
> some people (like me) would want to use "." as a separator instead of
> "-" so making it part of the regexp-target-pair is probably easier.

All these suggestions enhance the functionality I propose.  I will
work on a revised patch and submit it.  Thanks for your review.

-- 
Nevin

Re: [PATCH] Expiry based on headers (Take 2)

[Nevin Kapur]

Here's a revised patch for a header-based expiry function that
incorporates all of Simon's suggestion.  This is my first attempt at
using custom non-trivially, so any correction would be welcome.

ChangeLog:

2001-12-08  Nevin Kapur  <nevin@jhu.edu> (Suggestions from Simon
            Josefsson <jas@extundo.com>)

	* nnmail.el (nnmail-fancy-expiry-targets): New variable.
	(nnmail-fancy-expiry-target): Use it.

Index: lisp/nnmail.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/nnmail.el,v
retrieving revision 6.27
diff -u -r6.27 nnmail.el
--- lisp/nnmail.el	2001/09/26 17:55:05	6.27
+++ lisp/nnmail.el	2001/12/08 21:04:15
@@ -190,6 +190,38 @@
 		 (function :format "%v" nnmail-)
 		 string))
 
+(defcustom nnmail-fancy-expiry-targets nil 
+  "A list of (\"header\" \"regexp\" \"target\" \"date format\").  If
+`nnmail-expiry-target' is set to `nnmail-fancy-expiry-target' and the 
+header matches the regexp, the message will be expired to the target
+group with the date in the specified format, appended.  If no date
+format is specified the %Y is assumed.
+
+In the special cases that header is the symbol `to-from', the regexp
+will try to match against From or the To header.
+
+Example:
+
+(setq nnmail-fancy-expiry-targets
+      '((to-from \"boss\" \"nnfolder:Work-\")
+	(\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.\" \"%Y.%b\")
+	(\"from\" \".*\" \"nnfolder:Archive-\")))
+
+In this case, mail that has the string \"boss\" in the To or the From
+header will be expired to the groun nnfolder:Work-YYYY; mail that
+has the sting \"IMPORTANT\" in the Subject header will be expired
+to the group nnfolder:IMPORTANT.YYYY.MMM; everything else will
+be expired to nnfolder:Archive-YYYY."
+
+  :group 'nnmail-expire
+  :type '(repeat (list (choice :tag "Match against"
+                        (string :tag "Header")
+                        (const to-from))
+                       regexp
+                       (string :tag "Target group")
+                       (string :tag "Date format"
+                               :value "%Y"))))
+
 (defcustom nnmail-cache-accepted-message-ids nil
   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
 If non-nil, also update the cache when copy or move articles."
@@ -1699,6 +1731,38 @@
       (setq target (funcall target group)))
     (unless (eq target 'delete)
       (gnus-request-accept-article target nil nil t))))
+
+(defun nnmail-fancy-expiry-target (group)
+  "Returns a target expiry group depending on the last match in `nnmail-fancy-expiry-targets'."
+  (let* (header
+	 (case-fold-search nil)
+	 (from (or (message-fetch-field "from") ""))
+	 (to (or (message-fetch-field "to") ""))
+	 (date (date-to-time
+		(or (message-fetch-field "date") (current-time-string))))
+	 (target 'delete))
+      (dolist (regexp-target-pair
+	       (reverse nnmail-fancy-expiry-targets) target)
+	(setq header (car regexp-target-pair))
+	(cond
+	 ;; If the header is to-from then match against the
+	 ;; To or From header
+	 ((and (equal header 'to-from)
+	       (or (string-match (cadr regexp-target-pair) from)
+		   (and (string-match message-dont-reply-to-names from)
+			(string-match (cadr regexp-target-pair) to))))
+	  (setq target (concat (caddr regexp-target-pair)
+			       (format-time-string
+				(or (cadddr regexp-target-pair) "%Y")
+				date))))
+	 ((and (not (equal header 'to-from))
+	       (string-match (cadr regexp-target-pair)
+			     (message-fetch-field header)))
+	  (setq target (concat (caddr regexp-target-pair)
+			       (format-time-string
+				(or (cadddr regexp-target-pair) "%Y")
+				date))))))))
+  
 
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."


The patch for the manual:

Index: texi/gnus.texi
===================================================================
RCS file: /usr/local/cvsroot/gnus/texi/gnus.texi,v
retrieving revision 6.189
diff -u -r6.189 gnus.texi
--- texi/gnus.texi	2001/12/05 10:15:25	6.189
+++ texi/gnus.texi	2001/12/08 21:05:53
@@ -13073,6 +13073,26 @@
 (setq nnmail-expiry-target "nnml:expired")
 @end lisp
 
+Gnus provides a function @code{nnmail-fancy-expiry-target} which will
+expire mail to groups according to the variable
+@code{nnmail-fancy-expiry-targets}.  Here's an example:
+
+@lisp
+ (setq nnmail-expiry-target 'nnmail-fancy-expiry-target
+       nnmail-fancy-expiry-targets
+       '((to-from "boss" "nnfolder:Work.")
+    	 ("subject" "IMPORTANT" "nnfolder:IMPORTANT" "")
+         ("from" ".*" "nnfolder:Archive-" "%Y-%b")))
+@end lisp
+
+With this setup, any mail that has @code{IMPORTANT} in its Subject
+header and was sent in the year @code{YYYY}, will get expired to the
+group @code{nnfolder:IMPORTANT}. If its From or To header contains
+the string @code{boss}, it will get expired to
+@code{nnfolder:Work.YYYY}. All other mail will get expired to
+@code{nnfolder:Archive-YYYY-MMM}.
+
+
 
 @vindex nnmail-keep-last-article
 If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never

-- 
Nevin Kapur
nevin@jhu.edu 

Re: [PATCH] Expiry based on headers (Take 2)

[Simon Josefsson]

Nevin Kapur <nevin@jhu.edu> writes:

> Here's a revised patch for a header-based expiry function that
> incorporates all of Simon's suggestion.  This is my first attempt at
> using custom non-trivially, so any correction would be welcome.

I modified it a little, what do you think of this approach?  If you
don't like we'll use yours.

Index: nnmail.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/nnmail.el,v
retrieving revision 6.27
diff -u -u -w -r6.27 nnmail.el
--- nnmail.el	2001/09/26 17:55:05	6.27
+++ nnmail.el	2001/12/08 22:24:51
@@ -190,6 +190,39 @@
 		 (function :format "%v" nnmail-)
 		 string))
 
+(defcustom nnmail-fancy-expiry-targets nil 
+  "Determine expiry target based on articles using fancy techniques.
+
+This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries.  If
+`nnmail-expiry-target' is set to the function
+`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
+the message will be expired to a group determined by invoking
+`format-time-string' with TARGET used as the format string and the
+time extracted from the articles' Date header (if missing the current
+time is used).
+
+In the special cases that HEADER is the symbol `to-from', the regexp
+will try to match against both the From and the To header.
+
+Example:
+
+\(setq nnmail-fancy-expiry-targets
+      '((to-from \"boss\" \"nnfolder:Work\")
+	(\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
+	(\"from\" \".*\" \"nnfolder:Archive-%Y\")))
+
+In this case, articles containing the string \"boss\" in the To or the
+From header will be expired to the group \"nnfolder:Work\";
+articles containing the sting \"IMPORTANT\" in the Subject header will
+be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
+everything else will be expired to \"nnfolder:Archive-YYYY\"."
+  :group 'nnmail-expire
+  :type '(repeat (list (choice :tag "Match against"
+			       (string :tag "Header")
+			       (const to-from))
+                       regexp
+                       (string :tag "Target group format string"))))
+
 (defcustom nnmail-cache-accepted-message-ids nil
   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
 If non-nil, also update the cache when copy or move articles."
@@ -1699,6 +1732,31 @@
       (setq target (funcall target group)))
     (unless (eq target 'delete)
       (gnus-request-accept-article target nil nil t))))
+
+(defun nnmail-fancy-expiry-target (group)
+  "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
+  (let* (header
+	 (case-fold-search nil)
+	 (from (or (message-fetch-field "from") ""))
+	 (to (or (message-fetch-field "to") ""))
+	 (date (date-to-time
+		(or (message-fetch-field "date") (current-time-string))))
+	 (target 'delete))
+    (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
+      (setq header (car regexp-target-pair))
+      (cond
+       ;; If the header is to-from then match against the
+       ;; To or From header
+       ((and (equal header 'to-from)
+	     (or (string-match (cadr regexp-target-pair) from)
+		 (and (string-match message-dont-reply-to-names from)
+		      (string-match (cadr regexp-target-pair) to))))
+	(setq target (format-time-string (caddr regexp-target-pair) date)))
+       ((and (not (equal header 'to-from))
+	     (string-match (cadr regexp-target-pair)
+			   (message-fetch-field header)))
+	(setq target (format-time-string (caddr regexp-target-pair)
+					 date))))))))
 
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."
Index: gnus.texi
===================================================================
RCS file: /usr/local/cvsroot/gnus/texi/gnus.texi,v
retrieving revision 6.189
diff -u -u -w -r6.189 gnus.texi
--- gnus.texi	2001/12/05 10:15:25	6.189
+++ gnus.texi	2001/12/08 22:25:09
@@ -13073,6 +13073,26 @@
 (setq nnmail-expiry-target "nnml:expired")
 @end lisp
 
+@findex nnmail-fancy-expiry-target
+@vindex nnmail-fancy-expiry-targets
+Gnus provides a function @code{nnmail-fancy-expiry-target} which will
+expire mail to groups according to the variable
+@code{nnmail-fancy-expiry-targets}.  Here's an example:
+
+@lisp
+ (setq nnmail-expiry-target 'nnmail-fancy-expiry-target
+       nnmail-fancy-expiry-targets
+       '((to-from "boss" "nnfolder:Work")
+    	 ("subject" "IMPORTANT" "nnfolder:IMPORTANT.%Y.%b")
+         ("from" ".*" "nnfolder:Archive-%Y")))
+@end lisp
+
+With this setup, any mail that has @code{IMPORTANT} in its Subject
+header and was sent in the year @code{YYYY} and month @code{MMM}, will
+get expired to the group @code{nnfolder:IMPORTANT.YYYY.MMM}. If its
+From or To header contains the string @code{boss}, it will get expired
+to @code{nnfolder:Work}. All other mail will get expired to
+@code{nnfolder:Archive-YYYY}.
 
 @vindex nnmail-keep-last-article
 If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never

Re: [PATCH] Expiry based on headers (Take 2)

[Nevin Kapur]

Simon Josefsson <jas@extundo.com> writes:

> Nevin Kapur <nevin@jhu.edu> writes:
>
>> Here's a revised patch for a header-based expiry function that
>> incorporates all of Simon's suggestion.  This is my first attempt at
>> using custom non-trivially, so any correction would be welcome.
>
> I modified it a little, what do you think of this approach?  If you
> don't like we'll use yours.

Looks good to me.  Thanks for cleaning up the code.

-- 
Nevin Kapur
nevin@jhu.edu 

Re: [PATCH] Expiry based on headers (Take 2)

[Nevin Kapur]

Simon Josefsson <jas@extundo.com> writes:

> +(defun nnmail-fancy-expiry-target (group)
> +  "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
> +  (let* (header
> +	 (case-fold-search nil)
> +	 (from (or (message-fetch-field "from") ""))
> +	 (to (or (message-fetch-field "to") ""))
> +	 (date (date-to-time
> +		(or (message-fetch-field "date") (current-time-string))))
> +	 (target 'delete))
> +    (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
> +      (setq header (car regexp-target-pair))
> +      (cond
> +       ;; If the header is to-from then match against the
> +       ;; To or From header
> +       ((and (equal header 'to-from)
> +	     (or (string-match (cadr regexp-target-pair) from)
> +		 (and (string-match message-dont-reply-to-names from)
> +		      (string-match (cadr regexp-target-pair) to))))
> +	(setq target (format-time-string (caddr regexp-target-pair) date)))
> +       ((and (not (equal header 'to-from))
> +	     (string-match (cadr regexp-target-pair)
> +			   (message-fetch-field header)))
> +	(setq target (format-time-string (caddr regexp-target-pair)
> +					 date))))))))
                                                    ^  
I forgot to mention that there is one too many parentheses on this line.

-- 
Nevin Kapur
nevin@jhu.edu 

Re: [PATCH] Expiry based on headers (Take 2)

[Simon Josefsson]

Nevin Kapur <nevin@jhu.edu> writes:

> Looks good to me.

Oki, I committed it.