🚀 go-pugleaf

In message <FELIX.91Mar8143131@cayucos.ai.sri.com> Francois Felix INGRAND wrote:
>
> OK, I know this is something which has been discussed in the past, but I am
> getting mail message from "brain damaged" mailers which generate dates
> unparsable by VM.

Well I hope Kyle decides that Worse is Better on this one, but in any event,
here's a version of vm-su-do-date that can handle all of the bogus brain-
damaged date formats I've come across.  I posted an older version of this
a long time ago.
			-- Jamie

;;; put this in a file and load it from .vm:
(require 'vm)
(if (not (fboundp 'vm-su-do-date)) (load-library "vm-summary"))

(defun vm-su-do-date (m)
  (let (date)
    (setq date (or (vm-get-header-contents m "Date") (vm-grok-From_-date m)))
    (cond
     ((null date)
      (vm-set-weekday-of m "")
      (vm-set-monthday-of m "")
      (vm-set-month-of m "")
      (vm-set-month-number-of m "")
      (vm-set-year-of m "")
      (vm-set-hour-of m "")
      (vm-set-zone-of m ""))
     ((string-match
;; The date format recognized here is the one specified in RFC 822.
;; Some slop is allowed e.g. dashes between the monthday, month and year
;; because such malformed headers have been observed.
;; jwz: added some more slop - dashes between time and zone.
;; Also allow DOTW to be at end, optionally in parens.
;;
;; Handles:
;;     Mon, 3 dec 90 15:25:36 PST
;;     Mon 3 dec 90 15:25:36 PST
;;     03-dec-90 15:25:36 PST
;;     Mon, 3 dec 90 15:25:36-PST
;;     3 Dec 90 15:25 PST (Mon)
"\\(\\([a-z][a-z][a-z]\\),?\\)?[ \t\n]*0?\\([0-9][0-9]?\\)[ \t\n---]*\\([a-z][a-z][a-z]\\)[ \t\n---]*\\([0-9]*[0-9][0-9]\\)[ \t\n]*\\([0-9:]+\\)[- \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+][0-9][0-9][0-9][0-9]\\)[ \t\n]*(?\\([a-z][a-z][a-z]\\)?)?"
       date)
      (if (match-beginning 2)
	  (vm-set-weekday-of m (substring date (match-beginning 2)
					  (match-end 2)))
	  (if (match-beginning 8)
	      (vm-set-weekday-of m (substring date (match-beginning 8)
					      (match-end 8)))
	      (vm-set-weekday-of m "")))
      (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-su-do-month m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
      (vm-set-hour-of m (substring date (match-beginning 6) (match-end 6)))
      (vm-set-zone-of m (substring date (match-beginning 7) (match-end 7))))
     ((string-match
;; UNIX ctime(3) format, with slop allowed in the whitespace, and we allow for
;; the possibility of a timezone at the end.
;; jwz: more slop - allow a comma after the weekday.
;; Handles:
;;     Tue Dec 11 00:13:13 1990
;;     Tue, Dec 11 00:13:13 90 PST
"\\([a-z][a-z][a-z]\\)[ \t\n,]*\\([a-z][a-z][a-z]\\)[ \t\n]*\\([0-9][0-9]?\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*[0-9][0-9]\\([0-9][0-9]\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+][0-9][0-9][0-9][0-9]\\)?"
       date)
      (vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
      (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
      (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
      ;; jwz: don't allow nil in the zone slot.
      (vm-set-zone-of m (if (match-beginning 6)
			    (substring date (match-beginning 6)
				       (match-end 6))
			    "")))
     ((string-match
;; YASTF: Yet Another Sucky Time Format.  Dan Jacobson found this one.
;; Handles:
;;    Tue, Dec 11 12:11:45 CST 1990
;;    Tue Dec 11 12:11 CST 1990
"\\([a-z][a-z][a-z]\\)[ \t\n,]*\\([a-z][a-z][a-z]\\)[ \t\n]*\\([0-9][0-9]?\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*\\([a-z][a-z][a-z]\\|[-+]?[0-9][0-9][0-9][0-9]\\)[ \t\n]*\\([0-9]?[0-9]?[0-9][0-9]\\)?"
       date)
      (vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
      (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
      (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-zone-of m (if (match-beginning 5)
			    (substring date (match-beginning 5)
				       (match-end 5))
			    ""))
      (vm-set-year-of m (if (match-beginning 6)
			    (substring date (match-beginning 6) (match-end 6))
			    "")))
     ((string-match
;; jwz: I've seen dates of the form "13-AUG-1990 16:11:21.26" from VMS.
	"\\([0-9]+\\)[- \t]*\\([A-Z][A-Z][A-Z]+\\)[- \t]*\\([0-9][0-9][0-9]?[0-9]?\\)[ \t]+\\([0-9:]+\\)\\(\\.[0-9]+\\)?"
	date)
      (vm-set-weekday-of m "")
      (vm-set-monthday-of m (substring date (match-beginning 1) (match-end 1)))
      (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
      (vm-set-year-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-zone-of m ""))
     (t
      ;; otherwise, punt.
      (vm-set-weekday-of m "")
      (vm-set-monthday-of m "")
      (vm-set-month-of m "")
      (vm-set-month-number-of m "")
      (vm-set-year-of m "")
      (vm-set-hour-of m "")
      (vm-set-zone-of m "")))))