#!/bin/sh
: ; exec klone $0 "$@"
; The above line allows not to embed the exact path of the klone executable

;;Skeleton of a typical klone script
;;(kdb t)
;; TODO: verifier thread title ok
;; TODO: simpler display of --verbose, via numids
;; TODO: pouvoir matcher dates day, Month

;; Message separators are recognized by having:
;; Message-Id: <xmh-thread@separator>

(setq args (getopts "USAGE: %0 [options]
Removes the duplicate mails in current dir (mails which have the same body)
The mails with the shortest header is removed"
    ("-v" () verbose "verbose operation")
))

(setq re-num (regcomp "^[0-9]+$"))
(setq re-dir (regcomp "^(.*)[/]([^/]*)$"))
(setq mails (Hashtable ()))
(setq duplicates (Hashtable ()))

(defstruct Mail
  num					;number of the mail (filename in MH)
  header
  body
)

(defun main (&aux 
    (n 0) 
    (start-time (get-internal-run-time))
  )
  (dolist (file (directory)) 
    (when (regexec re-num file)
      (Parse-mail file)
  ))
  (dohash (body ml mails)
    (sort ml compare-mails)
    (dolist (mail (subseq ml 1))
      (verbose? "Removing %0, duplicate of %1" 
	(Mail-num mail) (Mail-num (0 ml)))
      (wait (system (list "rm" "-f" (String (Mail-num mail)))))
    )
  )
)))

(defun compare-mails (m1 m2)
  (compare (length (Mail-header m2)) (length (Mail-header m1)))
)

(defun Parse-mail (filename &aux
    (mail (make-Mail :num (Int filename)))
    (fd (open filename 
	:error '(fatal-error 1 "Cannot Open file %0\n" filename)))
    curline
    (header (copy ""))
    (body (copy ""))
    m
  )
  (catch 'EOF
    (catch 'HeaderEnd
      (doline (line fd)
	(if (= "" line) (throw 'HeaderEnd)
	  (nconc header line "\n")
    )))
    (with (line 
      (catch 'SpaceEnd
	(doline (line fd)
	  (if (/= "" line) (throw 'SpaceEnd line))
      )))
      (nconc body line "\n" (String fd))
    )
  )
  (Mail-body mail body)
  (Mail-header mail header)
  (if (setq m (getn mails body)) (progn
      (lappend m mail)
    )
    (put mails body (list mail))
  )
)
    
      
(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***