;;; cull-same-dates.el

;; Copyright (C) 2006-2015 Davin Pearson

;; Author/Maintainer: m4_davin_pearson
;; Keywords: Cull Same Dates
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This file deletes all but one file that was modified at every date,
;; so that you have a maximum of one archive file per day.

;;; m4_limitation_of_warranty

;;; m4_install_instructions(cull-same-dates)

;;; Known Bugs:

;; None!

;;; Code:

;;
;; NOTE: small bug in cull-same-dates-inner keeps YYMMDD files
;;
;; (cull-same-dates-inner (setq dirname "d:/home/bak/") (setq extension "\\.tar\\.gz$"))
;; (cull-same-dates-inner (setq dirname "d:/home/not-exist/")   (setq extension "\\.tar\\.gz$"))
;;
;; (cull-same-dates-inner "~/bak/baz" "\\.tar$")
;;
;; (setq dirname "~/bak/smeg/")
;; (setq dirname "~/bak/baz/")
;; (setq extension "\\.tar$")
;; (cull-same-dates-inner dirname extension)
;;
;; (bak--copy-to-other-drive--internal "~/bak" "d:/bak")
;; (cull-same-dates-inner (setq dirname "d:/bak") (setq extension "\\.tar\\.gz$"))
;;
;;
(defun cull-same-dates-dir-plus-extension (dirname extension)
  (message "cull-same-dates-inner dirname=%s extension=%s" (prin1-to-string dirname) (prin1-to-string extension))
  (assert (string-match "\\.\\(tar\\|tar.gz\\|zip\\)$" extension))
  (when (and (file-exists-p dirname) (file-directory-p dirname))
    (let* ((list   (directory-files dirname nil (concat (regexp-quote extension) "$")))
           (ptr    list))
      ;;(count  0)
      ;;(len    (length list)))
      (while ptr
        ;;(message "cull-same-dates-inner progress=%s%%" (/ (* count 100) len))
        (if (string-match (concat "\\(.*" bak--yyyymmdd "\\)" bak--hhmmss (regexp-quote extension) "$") (car ptr))
            (setcar ptr (substring (car ptr) (match-beginning 1) (match-end 1)))
          (setcar ptr nil))
        ;;(incf count)
        (setq ptr (cdr ptr)))

      (setq list (delete-duplicates list :test 'string=))
      (setq list (delete nil list))
      (setq ptr list)

      ;; (setq list '("bakw-h-dlisp"))
      ;; (setq ptr  list)
      ;; (debug)

      (let* ((count 0)
             (len   (length list))
             (pr1-dirname (prin1-to-string dirname))
             (pr1-extension (prin1-to-string extension)))
        (while ptr
          (incf count)
          (message "cull-same-dates-dirname-plus-extension dirname=%s extension=%s progress=%s%%"
                   pr1-dirname
                   pr1-extension
                   (/ (* count 100) len))
          (let* ((list2 (nreverse (directory-files dirname nil (concat "^"
                                                                       (car ptr)
                                                                       bak--hhmmss
                                                                       (regexp-quote extension)
                                                                       "$"))))
                 (ptr2  list2))
            ;;(count 0)
            ;;(len   (length list2)))
            (setq ptr2 (cdr ptr2))
            (while ptr2
              (delete-file (concat dirname "/" (car ptr2)))
              (setq ptr2 (cdr ptr2))))
          (setq ptr (cdr ptr)))))))

(defun cull-same-dates (dirname)
  (interactive "DEnter dir: ")
  (let ((d-message-on t))
    (message "cull-same-dates %s" (prin1-to-string dirname))
    (cull-same-dates-dir-plus-extension dirname ".tar")
    (cull-same-dates-dir-plus-extension dirname ".tar.gz")
    (cull-same-dates-dir-plus-extension dirname ".zip")
    )
  )

(provide 'cull-same-dates)
;;; cull-same-dates.el ends here
