Sonntag, 26. Oktober 2014

Removing duplicate images with Chicken-Scheme

Because of an mouse accident I have several duplicate images. Windows adds " (2)" in front of the extension when two files have the same name. It looks like this:

The following script removes the useless duplicates.

(use posix)

(define (sysname)
  (let ((si (system-information)))
    (if (pair? si)
        (car si)

(define file-separator 
  (let ((sysname (sysname)))
     ((equal? sysname "windows") "\\")
     (else "/"))))

(define (append-file-name a b)
  (string-append a file-separator b))

(define-syntax append-file-name*
  (syntax-rules ()
    ((_ a) a)
    ((_ a b) (append-file-name a b))
    ((_ a b ...) (_ a (_ b ...)))))

(define (prepend-directory-name directory-name file-names)
  (map (lambda (name)
         (append-file-name directory-name name))

(define (windows-duplicate name)
  (let ((index (string-index-right name #\.)))
    (if index
        (let ((basename (string-take name index))
              (extension (string-drop name index)))
          (string-append basename " (2)" extension))

(define (duplicate? a b)
  (if (and (regular-file? a)
           (regular-file? b))
      (= (file-size a)
         (file-size b))

(define (directory* name)
  (prepend-directory-name name (directory name)))

(define (find-duplicates dirname kind)
  (let loop ((files (directory* dirname))
             (duplicates (list)))
    (if (pair? files)
        (let ((name (car files))
              (rest (cdr files)))
          (if (directory? name)
              (loop rest (loop (directory* name)
              (let ((duplicate (kind name)))
                (if (duplicate? name duplicate)
                    (loop rest (cons duplicate duplicates))
                    (loop rest duplicates)))))

(for-each delete-file*
          (find-duplicates "C:\\Users\\Me\\Pictures\\Original\\2009"

Keine Kommentare: