checksum.el

    

;;; checksum.el

;; Copyright (C) 2014-2015 Davin Pearson

;; Emacs Lisp Archive Entry
;; Filename: checksum.el
;; Author/Maintainer: Davin Max Pearson <http://davin.50webs.com>
;; Keywords: Checksum code
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;;; Limitation of Warranty

;; 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 3 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 GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Known Bugs:

;; None so far!

;;; Code:

;;;
;;; NOTES TO SELF:
;;;
;;;  (1) checksum.el comes after manifest.el
;;;  (2) renaming files with dired "R" should affect the checksums database

;;;
;;; (setq file (expand-file-name "~/dlisp/checksum.el"))
;;; (setq file (expand-file-name "~/dlisp/i-dont-exist.el"))
;;; (setq file (expand-file-name "d:/home/text/file with spaces.txt"))
;;; (checksum--get-checksum file)
(defun checksum--get-checksum (file)
  (save-window-excursion
    (assert (stringp file))
    (if (not (file-exists-p file))
        0
      (shell-command (concat "cksum \"" file "\""))
      (set-buffer "*Shell Command Output*")
      (goto-char (point-min))
      (read (buffer-substring-no-properties (point) (progn (forward-sexp) (point))))))
    )

;;(defun checksum--get-file-list ()
;;  '("d:/home/text/file with spaces.txt"))

(defun checksum--get-file-list ()
  (let* (
         (list-bak (directory-files-deep "~/bak/"                t "\\.\\(tar\\|tar\\.gz\\|zip\\)$"))
         (list-hairy-lemon (directory-files-deep "~/hairy-lemon/web/"            t))
         (list-home        (directory-files-no-subdirs "~/"                      t))
         (list-dlisp       (directory-files-deep "~/dlisp/"                      t))
         (list-text        (directory-files-deep "~/text/"                       t))
         (list-1-allegro   nil);;(directory-files-deep "~/1-yallegro-connect-four/"    t))
         (list-2-allegro   nil);;(directory-files-deep "~/2-tallegro-old-system/"      t))
         (list-3-allegro   (directory-files-deep "~/3-zallegro-autogc-nosplit/"  t))
         )
    (let ((ptr    (append list-hairy-lemon
                          list-home
                          list-dlisp
                          list-text
                          list-1-allegro
                          list-2-allegro
                          list-3-allegro))
          (answer nil))
      (while ptr
        (assert (file-exists-p (car ptr))) ;;; assumes you have included full path information
        (if (and (not (string-equal                    (car ptr) checksum--log-file))
                 (not (file-directory-p                (car ptr)))
                 (not (string-match "\\.exe$"          (car ptr)))
                 (not (string-match "\\.o$"            (car ptr)))
                 (not (string-match "\\.tmp$"          (car ptr)))
                 (not (string-match "\\.tm4$"          (car ptr)))
                 (not (string-match "\\.aux$"          (car ptr)))
                 (not (string-match "\\.log$"          (car ptr)))
                 (not (string-match "\\.bak$"          (car ptr)))
                 (not (string-match "#$"               (car ptr)))
                 (not (string-match "~$"               (car ptr)))
                 (not (string-match "\\.bash_history$" (car ptr)))
                 (not (string-match "\\.places\\.sav$" (car ptr)))
                 )

(setq answer (cons (car ptr) answer)))
        (setq ptr (cdr ptr)))
      (reverse answer)))
  )

(defun checksum--save-log-file ()
  (save-excursion
    ;; NOTE: sort before save
    (setq checksum--alist (sort checksum--alist (function (lambda (x y) (string< (car x) (car y))))))
    ;; NOTE: do the save
    (find-file checksum--log-file)
    (erase-buffer)
    (insert (prin1-to-string checksum--alist))
    (save-buffer checksum--log-file)
    (kill-buffer nil)
    ;;(d-foo)
    )
  )

(setq checksum--log-file (safe-expand-file-name "~/dlisp/checksum-log.el"))
(defadvice save-some-buffers (around checksum--stub activate)
  ;;(d-foo)
  ad-do-it
  (let ((ptr       checksum--alist)
        (found-nil nil))
    (while ptr
      (when (eq (cdar ptr) nil)
        (setcdr (car ptr) (checksum--get-checksum (caar ptr)))
        (setq found-nil t))
      (setq ptr (cdr ptr)))
    (if found-nil
        (checksum--save-log-file))
    )
  )

(defadvice save-buffer (around checksum--stub activate)
  ;;(d-foo)
  ad-do-it
  (let ((ptr       checksum--alist)
        (found-nil nil))
    (while ptr
      (when (eq (cdar ptr) nil)
        (setcdr (car ptr) (checksum--get-checksum (caar ptr)))
        (setq found-nil t))
      (setq ptr (cdr ptr)))
    (if found-nil
        (checksum--save-log-file))
    )
  )

;;(defadvice save-some-buffers (around checksum-stub activate)
;;  ad-do-it)

(add-hook 'after-save-hook 'checksum--after-save-hook)
(defun checksum--after-save-hook ()
  ;;(d-foo)
  (when (not (string-equal (buffer-file-name) checksum--log-file))
    (let ((a  (assoc (buffer-file-name) checksum--alist)))
      (if a
          (setcdr a nil)
        ;;(ch (checksum--get-checksum (buffer-file-name))))
        ;;(if a
        ;;  (setcdr a ch)
        (setq checksum--alist (cons (cons (buffer-file-name) nil) checksum--alist)))
      )
    )
  )

;;(add-hook 'after-init-hook 'checksum--after-init-hook)
(defun checksum--init ()
  (save-window-excursion
    (find-file checksum--log-file)
    (goto-char (point-min))
    (setq checksum--alist (read (current-buffer)))
    (kill-buffer nil)))

(checksum--init)

;;; life with out you s'been to lonely too long

;;; (setq list (directory-files-deep "~/zallegro/" t "\\.cc$"))
;;; (setq list (directory-files-deep "~/dlisp/" t "\\.el$"))
;;; (setq ptr '("d:/home/dlisp/checksum.el"))
;;; (setq ptr '("d:/home/dlisp/checksum-log.el"))
;;; (setq ptr '("d:/home/"))
;;; (setq ptr '("d:/home/bin/playwav.exe"))
;;; (setq list (directory-files-deep "~/hairy-lemon/web/" t))
(defun checksum--create ()
  "Use this function when you need to rebuild the checksum database because an error occurred"
  (let* ((ptr   (checksum--get-file-list))
         (alist nil))
    (while ptr
      (setq alist (cons (cons (car ptr) (checksum--get-checksum (car ptr))) alist))
      (setq ptr (cdr ptr)))
    (setq checksum--alist (reverse alist))
    (checksum--save-log-file))
  )

;;(defun checksum--add-newly-created-files ()
;;  (let* ((list (checksum--get-file-list))
;;         (ptr  list))
;;    (while ptr
;;      (if (not (assoc (car ptr) checksum--alist))
;;          (setq checksum--alist (cons (cons (car ptr) (checksum--get-checksum (car ptr))) checksum--alist)))
;;      (setq ptr (cdr ptr)))
;;    (checksum--save-log-file))
;;    )
;;
(setq checksum--log-buffer "*Checksum*")
(defun checksum ()
  (interactive)
  (let ((ptr          checksum--alist)
        (a            nil)
        (time-started (current-time))
        (time-stopped nil)
        (dif          nil))
    (if (get-buffer checksum--log-buffer)
        (kill-buffer checksum--log-buffer))
    (switch-to-buffer (generate-new-buffer checksum--log-buffer))
    (compilation-mode)
    (read-only-mode -1)
    (insert "**** BEGIN the output of the command checksum--test-integrity\n")
    (while ptr

(setq a (car ptr))

(cond
       ((not (file-exists-p (car a)))
        (insert "*** File not found error in file: " (car a) "\n"))

((not (eq (cdr a) (checksum--get-checksum (car a))))
        (insert "*** Checksum error in file: " (car a) "\n"))

(t
        ;; OK
        ))

(setq ptr (cdr ptr)))

(setq time-stopped (current-time))
    (setq dif (seconds-of-time-difference time-started time-stopped))
    (insert "**** TIME TOOK: = " (seconds-to-readable-string dif) "\n")

(let ((count (let ((count 0))
                   (save-excursion
                     (goto-char (point-min))
                     (while (re-search-forward "error in file:" nil t)
                       (incf count))
                     count))))
      (goto-char (point-max))
      (insert (format "**** ERRORS: %d\n" count)))

(insert "**** END   the output of the command checksum--test-integrity\n")
    )
  )

(provide 'checksum)