;;; cull-size-quota.el

;; Copyright (C) 2006-2015 Davin Pearson

;; Author/Maintainer: m4_davin_pearson
;; Keywords: Cull Size Quota
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This file deletes archive files that exceed a certain size.

;;; m4_limitation_of_warranty

;;; m4_install_instructions(cull-size-quota)

;;; Known Bugs:

;; None!

;;; Code:

(defun d-file-size (file)
  (if (file-exists-p file)
      (nth 7 (file-attributes file))
    0))

;;;
;;; (shell-command "cp -r d:/home/bak/baz d:/")
;;;
;;; (setq count 0)
(defun cull-size-quota-inner-inner (dirname regexp total-size)

  ;;(debug)
  ;;(d-beeps "called cull-size-quota-inner-inner dirname=%s regexp=%s total-size=%s count=%s" dirname regexp total-size count)
  (incf count)

  ;;
  ;; NOTE: deletes files that exceed quota `total-size'
  ;;
  (let* ((list (nreverse (directory-files dirname t regexp)))
         (ptr  list)
         (size 0))
    (while (and ptr (<= size total-size))
      ;;(message "skipping file %s" (car ptr))
      (setq size (+ size (/ (d-file-size (car ptr)) 1024.0 1024.0)))
      (setq ptr (cdr ptr)))
    (while ptr
      (message "deleting file %s as total file size exceeds quota %s MB" (car ptr) total-size)
      (delete-file (car ptr))
      (setq ptr (cdr ptr))))

  ;;
  ;; NOTE: sets an upper bound on the number of files
  ;;
  (let* ((number-to-keep 200)
         (list (nreverse (directory-files dirname t regexp)))
         (ptr  list)
         (i    0))
    (while (and ptr (< i number-to-keep))
      (incf i)
      (setq ptr (cdr ptr)))
    (while ptr
      (message "deleting file %s as number of files exceeds 200" (car ptr))
      (delete-file (car ptr))
      (setq ptr (cdr ptr))))
  )

;;(cull-size-quota-inner "~/" (setq extension ".zip") 0)
(defun cull-size-quota-inner (dirname extension total-size)
  ;;(message "cull-size-quota-inner dirname=%s extension=%s total-size=%s" (prin1-to-string dirname) (prin1-to-string extension) (prin1-to-string total-size))
  (when (file-exists-p dirname)
    (assert (or (string-match "\\.tar\\.gz$" extension)
                (string-match "\\.tar$"      extension)
                (string-match "\\.zip$"      extension)
                (string-match "\\.pdf$"      extension)))
    (let* ((list          (bak--get-bases dirname extension))
           (ptr           list)
           (count         0)
           (len           (length list))
           (pr1-dirname   (prin1-to-string dirname))
           (pr1-extension (prin1-to-string extension)))
      (while ptr
        (incf count)
        (message "cull-size-quota-inner dirname=%s extension=%s total-size=%sMB progress=%s%%"
                 pr1-dirname
                 pr1-extension
                 total-size
                 (/ (* 100 count) len))
        (cull-size-quota-inner-inner dirname (concat "^"
                                                     (car ptr)
                                                     bak--yyyymmdd
                                                     bak--hhmmss
                                                     (regexp-quote extension)
                                                     "$")
                                     total-size)
        (setq ptr (cdr ptr)))
      )))

;; (cull-size-quota "d:/home/bak/")
;; (cull-size-quota "g:/home/bak")
(defun cull-size-quota-dir-plus-extension (dirname extension)
  (assert (or (string-match "\\.tar\\.gz$" extension)
              (string-match "\\.tar$"      extension)
              (string-match "\\.zip$"      extension)
              (string-match "\\.pdf$"      extension)
              ))
  (message "cull-size-quota %s" (prin1-to-string dirname))
  (progn
    ;;
    ;; NOTE: canonicalise dirname
    ;;
    (setq dirname (expand-file-name dirname))
    (if (not (string-match "/$" dirname))
        (setq dirname (concat dirname "/"))))

  (if (file-exists-p "f:/")
      (assert (or (file-exists-p "f:/big") (file-exists-p "f:/small"))))

  (if (file-exists-p "/media/www/F2TB/")
      (assert (or (file-exists-p "/media/www/F2TB/big") (file-exists-p "/media/www/F2TB/small"))))

  (if (file-exists-p "g:/")
      (assert (or (file-exists-p "g:/big") (file-exists-p "g:/small"))))

  (if (file-exists-p "/media/www/G16GB/")
      (assert (or (file-exists-p "/media/www/G16GB/big") (file-exists-p "/media/www/G16GB/small"))))

  (if (file-exists-p "h:/")
      (assert (or (file-exists-p "h:/big") (file-exists-p "h:/small"))))

  (if (file-exists-p "j:/")
      (assert (or (file-exists-p "j:/big") (file-exists-p "j:/small"))))

  (if (file-exists-p "/media/www/H16GB/")
      (assert (or (file-exists-p "/media/www/H16GB/big") (file-exists-p "/media/www/H16GB/small"))))

  ;; NOTE: these sizes are in megabytes
  (let (alist total-size)
    (progn
      (setq alist '(
                    ("c:/home/bak/"                     . 10)
                    ("c:/home/bak/baz/"                 . 10)
                    ("f:/home/bak/"                     . (if (file-exists-p "f:/big") 800  10))
                    ("f:/home/bak/baz/"                 . (if (file-exists-p "f:/big") 800 100))
                    ("f:/davinpearson-com/binaries/"    . (if (file-exists-p "f:/big") 800 100))
                    ("g:/home/bak/"                     . (if (file-exists-p "g:/big") 800  10))
                    ("g:/home/bak/baz/"                 . (if (file-exists-p "g:/big") 800 100))
                    ("h:/home/bak/"                     . (if (file-exists-p "h:/big") 800  10))
                    ("h:/home/bak/baz/"                 . (if (file-exists-p "h:/big") 800 100))
                    ("j:/home/bak/"                     . (if (file-exists-p "j:/big") 800  10))
                    ("j:/home/bak/baz/"                 . (if (file-exists-p "j:/big") 800 100))
                    ("/home/www/bak/"                   . 200)
                    ("/home/www/bak/baz/"               . 400)
                    ("/home/www/C/home/bak/"            . 10)
                    ("/home/www/C/home/bak/baz/"        . 10)
                    ("/home/www/F/home/bak/"            . (if (file-exists-p "/home/www/F/big") 800  10))
                    ("/home/www/F/home/bak/baz/"        . (if (file-exists-p "/home/www/F/big") 800 100))
                    ("/home/www/G/home/bak/"            . (if (file-exists-p "/home/www/G/big") 800  10))
                    ("/home/www/G/home/bak/baz/"        . (if (file-exists-p "/home/www/G/big") 800 100))
                    ("/home/www/H/home/bak/"            . (if (file-exists-p "/home/www/H/big") 800  10))
                    ("/home/www/H/home/bak/baz/"        . (if (file-exists-p "/home/www/H/big") 800 100))
                    ("/media/www/C1TB/home/bak/"       . 100)
                    ("/media/www/C1TB/home/bak/baz/"   . 100)
                    ("/media/www/F2TB/home/bak/"        . (if (file-exists-p "/media/www/F2TB/big")  800  10))
                    ("/media/www/F2TB/home/bak/baz/"    . (if (file-exists-p "/media/www/F2TB/big")  800 100))
                    ("/media/www/G16GB/home/bak/"       . (if (file-exists-p "/media/www/G16GB/big") 800  10))
                    ("/media/www/G16GB/home/bak/baz/"   . (if (file-exists-p "/media/www/G16GB/big") 800 100))
                    ("/media/www/H16GB/home/bak/"       . (if (file-exists-p "/media/www/H16GB/big") 800  10))
                    ("/media/www/H16GB/home/bak/baz/"   . (if (file-exists-p "/media/www/H16GB/big") 800 100))
                    ("/media/www/I16GB/home/bak/"       . (if (file-exists-p "/media/www/I16GB/big") 800  10))
                    ("/media/www/I16GB/home/bak/baz/"   . (if (file-exists-p "/media/www/I16GB/big") 800 100))
                    ("/media/www/J600GB/home/bak/"      . (if (file-exists-p "/media/www/J600GB/big") 800  10))
                    ("/media/www/J600GB/home/bak/baz/"  . (if (file-exists-p "/media/www/J600GB/big") 800 100))
                    ("/media/www/K2TB/home/bak/"        . (if (file-exists-p "/media/www/K2TB/big") 800  10))
                    ("/media/www/K2TB/home/bak/baz/"    . (if (file-exists-p "/media/www/K2TB/big") 800 100))
                    ("/media/www/BLU16GB/home/bak/"     . (if (file-exists-p "/media/www/BLU16GB/big") 800  10))
                    ("/media/www/BLU16GB/home/bak/baz/" . (if (file-exists-p "/media/www/BLU16GB/big") 800 100))
                    ("/media/www/BLU16GB/davinpearson-com/binaries/" . (if (file-exists-p "/media/www/BLU16GB/big") 800  10))
                    ("/media/www/GRN16GB/home/bak/"                  . (if (file-exists-p "/media/www/GRN16GB/big") 800 100))
                    ("/media/www/GRN16GB/home/bak/baz/"              . (if (file-exists-p "/media/www/GRN16GB/big") 800 100))
                    ("/media/www/GRN16GB/davinpearson-com/binaries/" . (if (file-exists-p "/media/www/GRN16GB/big") 800  10))
                    ("/media/www/WD2TB/home/bak/"                  . (if (file-exists-p "/media/www/WD2TB/big") 800 100))
                    ("/media/www/WD2TB/home/bak/baz/"              . (if (file-exists-p "/media/www/WD2TB/big") 800 100))
                    ("/media/www/WD2TB/davinpearson-com/binaries/" . (if (file-exists-p "/media/www/WD2TB/big") 800  10))
                    ("/media/www/WD2TB2/home/bak/"                  . (if (file-exists-p "/media/www/WD2TB2/big") 800 100))
                    ("/media/www/WD2TB2/home/bak/baz/"              . (if (file-exists-p "/media/www/WD2TB2/big") 800 100))
                    ("/media/www/WD2TB2/davinpearson-com/binaries/" . (if (file-exists-p "/media/www/WD2TB2/big") 800  10))
                    ("c:/home/hairy-lemon/output/davinpearson-com/binaries/" . 200)))
      (setq total-size (eval (cdr (assoc dirname alist))))
      (assert (boundp 'total-size))
      (assert total-size)
      (cull-size-quota-inner dirname extension total-size)
      )
    )
  )

;;; (setq dirname (expand-file-name "~/bak/"))
;;; (setq dirname "/media/www/G16GB/home/bak/")
(defun cull-size-quota (dirname)
  (interactive "DEnter dir: ")
  (let ((d-message-on t))
    (cull-size-quota-dir-plus-extension dirname ".tar.gz")
    (cull-size-quota-dir-plus-extension dirname ".tar")
    (cull-size-quota-dir-plus-extension dirname ".zip")
    (cull-size-quota-dir-plus-extension dirname ".pdf")
    )
  )

(provide 'cull-size-quota)
;;; cull-size-quota.el ends here
