Java, Scala, .NET, Lisp, Python, IDE's, Hibernate, MATLAB, Mathematica, Physics & Other

суббота, 24 октября 2009 г.

Программа для резервного копирования / синхронизации данных.

Написал на Steel Bank Common Lisp.

Алгоритм простой:
  • Если файл/директория есть в src но нет в dest - то он/она копируется в dest.
  • Если файл/директория есть в dest но нет в src - то он/она удаляется из dest.
  • Если файл есть в src и в dest, но размеры их не совпадают - то файл из src переписывает файл из dest.
  • Алгоритм вызывается рекурсивно для всех поддиректорий.
Если не удалось скопировать файл/создать директорию - то выводится сообщение об ошибке и алгоритм продолжает работать дальше.

Работает, я считаю, довольно шустро - у меня синхронизация папки 1.4 гб с 53 тыс файлов занимает примерно 10 минут.


;;;; Created on 2009-10-18 13:12:10

(load "F:/Lisp/cl-fad-0.6.3/load.lisp")

(defmacro my-with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (gensym)))
     ,@body))

(defmacro exec-time (executions (&body body))
  (my-with-gensyms (start end time)
    `(progn
       (setf ,start (get-internal-real-time))
       (loop for i from 1 to ,executions do ,body)
       (setf ,end (get-internal-real-time))
       (setf ,time (float (/ (- ,end ,start) internal-time-units-per-second)))
       ,time)
    )
  )

(defun path-to-str (path)
  (format nil "~a" path))

(defun file-len (filepath)
  (with-open-file (in filepath) (file-length in)))

(defun dirs-and-files (path)
  (let* ((files-dirs (cl-fad:list-directory path))
         (dirs (remove-if-not #'cl-fad:directory-pathname-p files-dirs))
         (files (remove-if #'cl-fad:directory-pathname-p files-dirs)))    
    (values dirs files)))

(defun file-name (path)
  (let ((ext (pathname-type path)))
    (concatenate 'string (pathname-name path)
                 (if ext (concatenate 'string "." ext)))
    ))

(defun dir-name (path)
  (car (last (pathname-directory path))))

(defun new-deleted-existed (dest-paths src-paths is-files)
  (let* ((key-func (if is-files #'file-name #'dir-name))
         (new (set-difference src-paths dest-paths
                              :key key-func :test #'string-equal))
         (deleted (set-difference dest-paths src-paths
                              :key key-func :test #'string-equal))
         (existed (intersection src-paths dest-paths
                              :key key-func :test #'string-equal)))
    (values new deleted existed)))

(defun get-relative (base-path full-path)
  (let ((base-path-str (path-to-str base-path))
        (full-path-str (path-to-str full-path)))
    (pathname (subseq full-path-str (length base-path-str)))
    ))

(defun full-dest-path (base-dest-path base-src-path full-src-path)
  (let ((relative (get-relative base-src-path full-src-path)))
    (merge-pathnames relative base-dest-path)
    ))

(defmacro sefe-progn (&body body)
  `(handler-case (progn ,@body) (error (r) (format t "~a~%" r))))

(defun synchronize (dest src)  
  (let ((dest (pathname dest)) (src (pathname src))
        (dirs-src nil) (files-src nil) (dirs-dest nil) (files-dest nil)
        (new-files nil) (deleted-files nil) (existed-files nil)
        (new-dirs nil) (deleted-dirs nil) (existed-dirs nil))
    (setf (values dirs-src files-src) (dirs-and-files src))
    (setf (values dirs-dest files-dest) (dirs-and-files dest))
    (setf (values new-files deleted-files existed-files)
          (new-deleted-existed files-dest files-src T))
    (setf (values new-dirs deleted-dirs existed-dirs)
          (new-deleted-existed dirs-dest dirs-src nil))    
    (loop for new in new-files
          for new-dest = (full-dest-path dest src new)
          do (sefe-progn
               (format t "Copy FROM ~a TO ~a~%" new new-dest)
               (cl-fad:copy-file new new-dest)))  
    (loop for deleted in deleted-files
          do (sefe-progn
               (format t "Delete file ~a~%" deleted)
               (delete-file deleted)))
    (loop for existed in existed-files
          for existed-dest = (full-dest-path dest src existed)
          do (sefe-progn
              (if (/= (file-len existed) (file-len existed-dest))
                 (progn
                   (format t "Overwrite FROM ~a TO ~a~%" existed existed-dest)
                   (cl-fad:copy-file existed existed-dest :overwrite t)))))
    (loop for new in new-dirs
          for new-dest = (full-dest-path dest src new)  
          do (sefe-progn
               (format t "Create directory ~a~%" new-dest)
               (ensure-directories-exist new-dest)
               (synchronize new-dest new)))
    (loop for deleted in deleted-dirs
          do (sefe-progn
               (format t "Delete directory ~a~%" deleted)
               (cl-fad:delete-directory-and-files deleted)))
    (loop for existed in existed-dirs
          for existed-dest = (full-dest-path dest src existed)
          do (synchronize existed-dest existed))
    ))

(defun main (args)
  (let ((src (if (= 3 (length args))
              (nth 1 args) "F:/jFiles/workspaces/tests/file-sync/2"))
        (dest (if (= 3 (length args))
              (nth 2 args) "F:/jFiles/workspaces/tests/file-sync/1")))
    (cl-fad:pathname-as-directory "F:/jFiles/workspaces/tests/file-sync/2")
    (format t "Synchronize ~a ==> ~a~%" src dest)
    (let ((time
          (exec-time 1 (synchronize (cl-fad:pathname-as-directory dest)
                                    (cl-fad:pathname-as-directory src)))))
      (format t "Finished [execution time: ~as]" time))
    ))
     
(main *posix-argv*)
 


Теперь небольшая инструкция, как сделать так, чтобы программа заработала.

Для запуска вам понадобиться SBCL и библиотечка cl-fad которую я использовал для упрощения работы с файлами. В программе указан абсолютный путь к библиотеке "F:/Lisp/cl-fad-0.6.3/load.lisp" - необходимо будет заменить его на путь куда вы установите библиотеку. Сохранив код в файл, например sync.lisp, его можно запускать батником, например таким образом: call sbcl --script sync.lisp "F:/jFiles/" "O:/jFiles/". Возможна одна проблема - при запуске программа будет ругаться что библиотека cl-fad якобы откомпилирована более старой версией SBCL. Не пугайтесь - решается просто, надо пойти в директорию установки cl-fad и удалить файл packages.fasl. Тогда при повторном запуске cl-fad будет перекомпилирована.


Осталось добавить батник в планировщик заданий и радоваться жизни)

4 комментария:

  1. Вопрос: почему ты выбрал Lisp?

    Подобную задачу можно реализовать на любом другом скриптовом языке (batch, shell...), которые не требуют никаких дополнительных "библиотечек". Ну, на худой конец, если уж понадобилось кроссплатформенное решение, то можно обойтись perl, python/jython.

    Просто автор наверное демонстрирует мощь экспериментального компилятора под Windows. Если учесть, что большинство линуксовых файловых систем работает намного шустрее, чем NTFS, то данную задачу еще есть куда оптимизировать :)

    ОтветитьУдалить
  2. На Lisp-е потому что изучаю его в данный момент вот и все)

    ОтветитьУдалить
  3. Гуд, если только в учебных целях) Если нет, то мой поврос: а что мешало приспособить какой-нить git под эту задачу? И как по мне, вместо размеров файлов лучше бы считать их хэш.

    ОтветитьУдалить
    Ответы
    1. Мешало то что в то время о git не слышал , и недостаток фантазии :) Сейчас бы git так использовать не догадался бы)
      А хеш слишком долго мне кажется считать, если файлов много и/или они большие. Проще размер проверить.

      Удалить

Постоянные читатели