;;; Guile bindings for Mutt
;;; Copyright (C) 2003  Ludovic Courtès

;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */


(mutt-module (mutt mua-stats)
	     #:use-module (mutt helpers misc)
	     #:use-module (ice-9 format)
	     #:documentation
"Provides a command to get information about which mail-user-agent
is being user by the sender of the messages available in the
current mailbox.  :-)

@emph{Beware}:  This can be really slow since each email has to be
retrieved and copied to local storage!")


(define mua-regexp
  (make-regexp "^(User-Agent|X-Mailer):" regexp/extended
	       regexp/icase))

; Grand user-agent categories (version and arch-independent
; identification string superset)
(define-public mua-categories
  `(("Mutt"       . ,(make-regexp "Mutt"))
    ("Gnus"       . ,(make-regexp "Gnus"))
    ("VM"         . ,(make-regexp "VM"))
    ("Evolution"  . ,(make-regexp "Ximian Evolution"))
    ("Sylpheed"   . ,(make-regexp "Sylpheed"))
    ("Balsa"      . ,(make-regexp "Balsa"))
    ("Mozilla"    . ,(make-regexp "Mozilla"))
    ("KMail"      . ,(make-regexp "KMail"))
    ("IMP"        . ,(make-regexp "Internet Messaging Program"))

    ; Proprietary crap
    ("Apple Mail" . ,(make-regexp "Apple Mail"))
    ("Eudora"     . ,(make-regexp "Eudora"))
    ("Outlook"    . ,(make-regexp "Outlook"))
    ("dtmail"     . ,(make-regexp "dtmail"))))


(define (make-temp-file)
  "/tmp/.mutt-mua-stats.tmp")

; This function is necessary because user headers are not stored in
; the message objects, i.e. `envelope-user-headers' always returns
; '().
; FIXME: For "local" mailbox types (mbox, maildir), there is no need
; for copying the file like this, so this could be optimized.
(define-public (extract-user-agent-header message)
  "Return the value of one of the User-Agent of X-Mailer header or
false if not found."
  (let* ((filename (make-temp-file)))
    (false-if-exception (delete-file filename))
    (if (save-message message filename #f #f #f)
	(let ((file (open-input-file filename)))
	  (if file
	      (let ((line (read-line file))
		    (result #f))
		(while (not (or (eof-object? line) result))
		       (let ((match (regexp-exec mua-regexp line)))
			 (if match
			     (set! result
				   (substring line
					      (match:end match)))
			     (set! line (read-line file)))))
		(close-port file)
		result)))
	(ui-message (string-append "Could not save message to "
				   filename)))))

(define-public (output-raw-stats per-address-stats file)
  (format file "Raw MUA stats (~a people):\n ~a\n"
	  (length per-address-stats) per-address-stats))

(define-public (output-mua-stats per-category-stats per-mua-stats
				 sender-number file)
  "Write @var{stats} to port @var{file}.  @var{per-mua-stats} is an alist of
mua-number pairs, e.g. @code{(\"Mutt/1.2.3\" . 43)} and
@var{per-category-stats} is an alist of category-number pair, e.g.
@code{(\"Mutt\" . 78)}."
  (format file "~a\n" (strftime "%c" (localtime (current-time))))
  (format file "Stats collected from ~a users.\n\n" sender-number)
  (format file "--- Overall distribution ---\n\n")
  (let ((total-percent 0))
    (map
     (lambda (pair)
       (let ((percent (* 100 (/ (cdr pair) sender-number))))
	 (set! total-percent (+ total-percent percent))
	 (format file "~a: ~$% (~a users)\n"
		 (car pair) percent (cdr pair))))
     per-category-stats)
    
    (format file "\nCovers ~$% of the mail-user-agents.\n"
	    total-percent))
  
  (format file "\n\n--- Detailed distribution ---\n\n")
  (map
   (lambda (pair)
     (format file "~a: ~$% (~a users)\n"
	     (car pair)
	     (* 100 (/ (cdr pair) sender-number))
	     (cdr pair)))
   per-mua-stats))

(define-public (per-mua-stats per-address-stats)
  "Convert @var{per-address-stats} (an alist of address-mua pairs) into a
per-user-agent stat list (an alist of mua-number pair)."
  (let ((mua-stats '()))
    (map
     (lambda (pair)
       (let* ((mua-name (cdr pair))
	      (mua-number (let ((mua (assoc-ref mua-stats mua-name)))
			    (if mua mua 0))))
	 (set! mua-stats (assoc-set! mua-stats mua-name
				     (+ mua-number 1)))))
     per-address-stats)
    mua-stats))

(define-public (per-category-stats per-mua-stats)
  "Convert @var{per-mua-stats} into an alist for each user-agent
category defined in @var{mua-categories}."
  (let ((cat-stats '()))
    (map
     (lambda (pair)
       (let* ((mua-name (car pair))
	      (mua-number (cdr pair))
	      (cat (loop-until-true
		    (lambda (cat-pair)
		      (regexp-exec (cdr cat-pair) mua-name))
		    mua-categories))
	      (cat-name (if (null? cat) #f (caar cat)))
	      (cat-number (if cat-name
			      (let ((cat-num (assoc-ref cat-stats
							cat-name)))
				(if cat-num cat-num 0))
			      0)))
	 (if cat-name
	     (set! cat-stats (assoc-set! cat-stats cat-name
					 (+ cat-number mua-number))))))
     per-mua-stats)
    cat-stats))

(define (per-address-mua-stats)
  "Return per-email-address statistics, i.e. an alist of address-mua pairs."
  (let ((stats '())
	(number 0)
	(total (mailbox-messages)))
    (mailbox-select-messages
     (lambda (message)
       (let ((sender (address-mailbox
		      (envelope-from (message-envelope
				      message))))
	     (mua (extract-user-agent-header message)))
	 (set! number (+ 1 number))
	 (if (= 0 (modulo number 20))
	     (let ((percent (* 100 (/ number total))))
	       (ui-message (format #f "~$%%" percent))))
	 (if mua
	     (set! stats
		   (assoc-set! stats sender mua))))))
    (ui-message "100%% - done!")
    stats))

(define-command (raw-mua-stats stats-file)
  "Write raw mail-user-agent stats to the given file, i.e. per-user stats."
  (if (string-null? stats-file)
      (ui-message "Usage: raw-mua-stats <filename>")
      (let* ((file-path (expand-path stats-file))
	     (file (open-file file-path "w+")))
	(if (not file)
	    (ui-message "Could not open ~a for writing" file-path)
	    (begin
	      (output-raw-stats (per-address-mua-stats) file)
	      (close-port file))))))

(define-command (mua-stats stats-file)
  "Write mail-user-agent stats to the given file."
  (if (string-null? stats-file)
      (ui-message "Usage: mua-stats <filename>")
      (let* ((file-path (expand-path stats-file))
	     (file (open-file file-path "w+")))
	(if (not file)
	    (ui-message "Could not open ~a for writing" file-path)
	    (let* ((per-address  (per-address-mua-stats))
		   (per-mua      (per-mua-stats per-address))
		   (per-category (per-category-stats per-mua)))
	      (output-mua-stats per-category per-mua
				(length per-address) file)
	      (close-port file))))))
