
;;; cull-duplicate-files --- Culls all but one timestamped file

;; Copyright (C) 2015 Davin Pearson

;; Author/Maintainer: m4_davin_pearson
;; Keywords: Culls duplicates files
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; The function cull-duplicate-files--inner deletes all but the
;; latest timestamped copies of each file.

;;; m4_limitation_of_warranty

;;; m4_install_instructions(cull-duplicate-files)

;;; Known Bugs:

;; none!

;;; Code:

;; m4_changequote(,)

;; (setq dir "~/hairy-lemon/output/davinpearson-com/binaries/")
;; (setq extension ".tar.gz")
;; (setq str "allegro-c++-projects-20150728-193920.tar.gz")
(defun cull-duplicate-files--inner (dir extension)
  (progn
    (if (not (string-match "/$" dir))
        (setq dir (concat dir "/")))
;;;                                                              Y    Y    Y    Y    M    M    D    D     H    H    M    M    S    S
    (setq list (directory-files dir nil (concat "^[-a-zA-Z0-9_ ]*[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9][0-9][0-9]" (regexp-quote extension) "$")))
    (setq ptr list)
    (while ptr
      (setq str (car ptr))
;;;                                    Y    Y    Y    Y    M    M    D    D     H    H    M    M    S    S
      (assert (string-match "\\(^.*\\)-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9][0-9][0-9]" str))
      (setq str (substring str (match-beginning 1) (match-end 1)))
      (setcar ptr str)
      (setq ptr (cdr ptr))
      )
    (setq list (remove-duplicates list :test 'string=))
    (setq ptr list)
    ;;(message "list=%s" list)
    (while ptr
;;;                                                                Y    Y    Y    Y    M    M    D    D    -H    H    M    M    S    S
      (setq list2 (directory-files dir nil (concat "^" (car ptr) "-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9][0-9][0-9]" (regexp-quote extension) "$")))
      (setq list2 (nreverse list2))
      ;;(message "list2=%s" list2)
      (setq ptr2 list2)
      ;;(message "Not deleting file %s" (car ptr2))
      (setq ptr2 (cdr ptr2))
      (while ptr2
        ;;(message "Deleting file %s" (car ptr2))
        (delete-file (concat dir (car ptr2)))
        (setq ptr2 (cdr ptr2)))
      (setq ptr (cdr ptr)))
    )
  )

(defun cull-duplicate-files ()
  (interactive)
  (cull-duplicate-files--inner "~/hairy-lemon/output/davinpearson-com/binaries/" ".tar.gz"))

(provide 'cull-duplicate-files)
;;; cull-duplicate-files.el ends here
