archive-compare.el

    

;;; archive-compare.el --- A recoverable file deletion system

;; Copyright (C) 2006-2015 Davin Pearson

;; Emacs Lisp Archive Entry
;; Filename: archive-compare.el
;; Author/Maintainer: Davin Max Pearson <http://davin.50webs.com>
;; Version: 1.0
;; Keywords: Archive Compare

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This code makes the use of the five minute principle that governs
;; how builders assess the quality of their workmanship.  If the
;; building remains erect after five minutes, then it will remain
;; erect forever!  Translated into the language of the archive compare
;; function: If the data remains intact after five minutes after the
;; disc has been burned, it will remain intact forever!

;;; 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>.


;;; Install Instructions:
;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2006/mopa2e.html#archive-compare>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require 'archive-compare)

;;; Known Bugs:

;; None!

;;; Code:

(defalias 'acz 'archive-compare--zips)

;; (archive-compare--zips)
(defun archive-compare--zips ()
  (interactive)

(progn
    ;; BEGIN LOG BUFFER!

    (if (get-buffer archive-compare--buffer-name)
        (kill-buffer archive-compare--buffer-name))

(setq archive-compare--buffer (or (get-buffer archive-compare--buffer-name)
                                      (generate-new-buffer archive-compare--buffer-name)))
    (set-buffer archive-compare--buffer)
    (erase-buffer)
    (insert "**** Begin: archive-compare--compare-zips\n")
    (when (not (eq major-mode 'compilation-mode))
      (compilation-mode)
      (read-only-mode -1))

(if (fboundp 'd-groups-modeline-hook)
        (d-groups-modeline-hook))

(switch-to-buffer archive-compare--buffer)
    (sit-for 1)

    ;; END PROGN:
    )

  ;; BEGIN TIMER!
  (setq archive-compare--time-start (current-time))

(when (file-exists-p "~/hairy-lemon/output/davinpearson-com/binaries/")
    (setq acz--dir-cd   "~/hairy-lemon/output/davinpearson-com/binaries/")
    (setq acz--dir-hd-c "~/")
    (setq acz--dir-hd-h nil)
    (archive-compare--zips-inner))

(if (file-exists-p "e:/Install Files/")
      (progn
        (setq acz--dir-cd   "e:/Install Files/")
        (setq acz--dir-hd-c "c:/Install Files/")
        (setq acz--dir-hd-h nil) ;; NOTE: set a dir to nil to not search that drive
        (archive-compare--zips-inner)))
  (if (file-exists-p "e:/")
      (progn
        (setq acz--dir-cd   "e:/")
        (setq acz--dir-hd-c "c:/bak/")
        (setq acz--dir-hd-h "~/bak/")
        (archive-compare--zips-inner)))
  (if (file-exists-p "f:/bak/")
      (progn
        (setq acz--dir-cd   "f:/bak/")
        (setq acz--dir-hd-c "c:/bak/")
        (setq acz--dir-hd-h "~/bak/")
        (archive-compare--zips-inner)))
  (if (file-exists-p "g:/bak/")
      (progn
        (setq acz--dir-cd   "g:/bak/")
        (setq acz--dir-hd-c "c:/bak/")
        (setq acz--dir-hd-h "~/bak/")
        (archive-compare--zips-inner)))
  ;; END TIMER!

  (let (dif)
    (setq archive-compare--time-stop (current-time))
    (setq dif (seconds-of-time-difference archive-compare--time-start archive-compare--time-stop))
    (insert "**** Time took=" (seconds-to-readable-string dif) "\n"))

(insert "**** Finished Time=" (d-time--get-stamp) "\n")

  ;; END LOG BUFFER!
  (insert "**** End: archive-compare--compare-zips\n")
  (d-random-play-emacs-midi "c:/sound-samples/emacs/completed-archive-compare.wav")

(let ((count 0))
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "FAILED!" nil t)
        (incf count))
      (goto-char (point-max))
      (insert (format "**** Errors: %d\n" count))
      ;;(d-say-number 9998)
      ;;(d-say-number-improved 0)
      ;;(d-say-number-improved -1)
      (d-say-number-improved count)
      (d-random-play-emacs-midi "c:/sound-samples/emacs/numbers/errors-found.wav")))

)

(defvar archive-compare--buffer-name "*archive-compare*")
(defvar d-compare-files--reason nil)

(defun archive-compare--zips-inner ()

(progn
    ;;; Init log buffer if not already init'ed
    (setq archive-compare--buffer (or (get-buffer archive-compare--buffer-name)
                                      (generate-new-buffer archive-compare--buffer-name)))
    (set-buffer archive-compare--buffer)
    (when (not (eq major-mode 'compilation-mode))
      (compilation-mode)
      (read-only-mode -1))
    (switch-to-buffer archive-compare--buffer)
    (flm 1)
    (goto-char (point-max))
    (sit-for 1)
    ;; END PROGN:
    )

(assert (boundp 'acz--dir-cd))
  (assert (boundp 'acz--dir-hd-h))
  (assert (boundp 'acz--dir-hd-c))

  ;;; Expand file name...
  (if acz--dir-cd   (setq acz--dir-cd   (expand-file-name acz--dir-cd)))
  (if acz--dir-hd-h (setq acz--dir-hd-h (expand-file-name acz--dir-hd-h)))
  (if acz--dir-hd-c (setq acz--dir-hd-c (expand-file-name acz--dir-hd-c)))

  ;;; Add trailing slash if not already present...
  (if (and acz--dir-cd (not (string-match "/$" acz--dir-cd)))
      (setq acz--dir-cd (concat acz--dir-cd "/")))
  (if (and acz--dir-hd-h (not (string-match "/$" acz--dir-hd-h)))
      (setq acz--dir-hd-h (concat acz--dir-hd-h "/")))
  (if (and acz--dir-hd-c (not (string-match "/$" acz--dir-hd-c)))
      (setq acz--dir-hd-c (concat acz--dir-hd-c "/")))

  ;;; Init file lists...
  (let* ((list-cd   (if acz--dir-cd                 (directory-files-deep acz--dir-cd)))
         (list-hd-h (if (and list-cd acz--dir-hd-h) (directory-files-deep acz--dir-hd-h)))
         (list-hd-c (if (and list-cd acz--dir-hd-c) (directory-files-deep acz--dir-hd-c)))
         (ptr nil)
         (found nil)
         (file-cd nil)
         (file-hd nil)
         (cmd     nil))

(setq ptr list-cd)
    (while ptr
      (setq file-cd (concat acz--dir-cd (car ptr)))
      (when (and (not (string-match "/output/" file-cd)) (not (file-directory-p file-cd)))
        ;;(setq found nil)
        ;; Compare with file on HOME drive
        (when (find (car ptr) list-hd-h :test 'string=)
          ;;(setq found t)
          (setq file-hd (concat acz--dir-hd-h (car ptr)))
          (if (d-compare-files file-cd file-hd)
              (insert "* compare \"" file-cd "\" with \"" file-hd "\" OK\n")
            (insert "*** compare \"" file-cd "\" with \"" file-hd "\" FAILED!\n"
                    "*** Reason: " d-compare-files--reason "\n")
            (when (file-exists-p file-hd)
              (setq cmd (concat "cp -p \"" file-hd "\" \"" file-cd "\""))
              (shell-command cmd)
              (insert (format "shell command: %s\n" cmd)))
            ;;(condition-case err
            ;;   (copy-file file-hd file-cd 'OK-if-ALREADY-EXISTS)
            ;;  (error (insert "Copying error: " (prin1-to-string err) "\n")))
            ))

(sit-for 1)
        ;;)

        ;; Compare with file on c drive
        (when (find (car ptr) list-hd-c :test 'string=)
          ;;(setq found t)
          (setq file-hd (concat acz--dir-hd-c (car ptr)))
          (if (d-compare-files file-cd file-hd)
              (insert "* compare \"" file-cd "\" with \"" file-hd "\" OK\n")

(insert "*** compare \"" file-cd "\" with \"" file-hd "\" FAILED!\n"
                    "*** Reason: " d-compare-files--reason "\n")
            (when (file-exists-p file-hd)
              (setq cmd (concat "cp -p \"" file-hd "\" \"" file-cd "\""))
              (shell-command cmd)
              (insert (format "shell command: %s\n" cmd)))
            ;;(condition-case err
            ;;    (copy-file file-hd file-cd 'OK-if-ALREADY-EXISTS)
            ;;  (error (insert "Copying error: " (prin1-to-string err) "\n")))
            ))

(sit-for 1)
          ;;)

        ;;(if (not found) (insert "*** file-cd \""  file-cd "\" not found on hard drive FAILED!\n"))

        ;; END WHEN:
        )
      (setq ptr (cdr ptr))
      (recenter)
      ;;(redraw-frame (car (frame-list)))
      ;; END while:
      )))

                                      ;; COMPARE-FILES:

;; (setq file-1 "d:/zallegro/a")
;; (setq file-2 "d:/zallegro/b")
;; (setq file-1 "/media/www/C80GB/log.txt")
;; (setq file-2 "/media/www/J600GB/log.txt")
;; (d-compare-files "d:/home/zallegro/a" "d:/zallegro/b")
;; (d-compare-files "d:/zallegro/a" "d:/zallegro/b")
;; (d-compare-files "e:/MinGW.zip" "c:/MinGW.zip")
;; (d-compare-files "e:/msys.zip"  "c:/msys.zip")
;; (d-compare-files "e:/allegro-403.zip"  "c:/allegro-403.zip")
;; (d-compare-files "e:/download-files.zip"  "c:/download-files.zip")
;; (d-compare-files "d:/text.zip" "d:/text2.zip")
;; (d-compare-files "d:/home/.emacs"
(defun d-compare-files (file-1 file-2)
  ;;(error "STOP")
  (setq d-compare-files--reason nil)
  (cond

((and (file-directory-p file-1) (file-directory-p file-2))
    t)

((or (file-directory-p file-1) (file-directory-p file-2))
    (setq d-compare-files--reason
          (format "One of the files (%s or %s) is a directory and the other isn't" file-1 file-2))
    nil)

((or (not (file-exists-p file-1)) (not (file-exists-p file-2)))
    (cond
     ((and (not (file-exists-p file-1)) (not (file-exists-p file-2)))
      (setq d-compare-files--reason (format "Files not found: %s, %s" file-1 file-2))
      nil)
     ((not (file-exists-p file-1))
      (setq d-compare-files--reason (format "File not found: %s" file-1))
      nil)
     ((not (file-exists-p file-2))
      (setq d-compare-files--reason (format "File not found: %s" file-2))
      nil)
     (t
      (error "should never happen"))))

(t
    (save-excursion
      (if (get-buffer "*Shell Command Output*")
          (kill-buffer "*Shell Command Output*"))
      (setq cmd (concat "nice --adjustment=10 "
                        (if (file-exists-p "/cygdrive/c/home/bin/compare-files.exe")
                            "/cygdrive/c/home/bin/compare-files.exe"
                          (if (file-exists-p "~/bin/compare-files.exe")
                              "~/bin/compare-files.exe"))
                        " " (prin1-to-string file-1) " " (prin1-to-string file-2)))
      (if (and (boundp 'len) (boundp 'count) (boundp 'stage) (boundp 'time-elapsed))
          (if (fboundp 'buf-message)
              (buf-message "*** Executing shell command: %s Stage: %d Progress (%d/%d) (%d%% completed) Elapsed time=%s" cmd stage count len (/ (* 100 count) len) time-elapsed)
            (message "*** Executing shell command: %s Stage: %d Progress (%d/%d) (%d%% completed) Elapsed time=%s" cmd stage count len (/ (* 100 count) len) time-elapsed))
        (if (fboundp 'buf-message)
            (buf-message "*** Executing shell command: %s" cmd)
          (message "*** Executing shell command: %s" cmd))
        )
      (shell-command cmd)
      (if (not (get-buffer "*Shell Command Output*"))
          (error "Cannot find *Shell Command Output*"))
      (set-buffer "*Shell Command Output*")
      (goto-char (point-min))
      (if (re-search-forward "RESULT=YES" nil t)
          t
        (goto-char (point-min))
        (if (re-search-forward "RESULT=NO" nil t)
            (let (p-low p-high)
              (forward-char 1)
              ;;(assert (looking-at "[0-9]+"))
              (setq p-low (point))
              (setq p-high (point-at-eol))
              (setq d-compare-files--reason (buffer-substring-no-properties p-low p-high))
              (if (fboundp 'buf-message)
                  (buf-message "%s\n" d-compare-files--reason))
              nil)
          (switch-to-buffer "*Shell Command Output*")
          (if (save-excursion
                (goto-char (point-min))
                (re-search-forward "Usage:" nil t))
              (error "*** Usage spec given")
            (if (save-excursion
                  (goto-char (point-min))
                  (re-search-forward "File too large" nil t))
                (error "*** File too large")
              (error (if (file-exists-p "c:/home/bin/compare-files.exe")
                         "c:/home/bin/compare-files.exe not working properly!"
                       (if (file-exists-p "~/bin/compare-files.exe")
                           "~/bin/compare-files.exe not working properly!"
                         "Error not found compare-files")
                       )
                     )
              )))))
    )
   )
  )

(provide 'archive-compare)