From: tomo Date: Sun, 21 Nov 2010 11:38:45 +0000 (+0000) Subject: (exif-find-image-directories-by-original-date): Fixed. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=0b618137ef2c81c09a0b1802eb092b52b0b6810c;p=elisp%2Falbum.git (exif-find-image-directories-by-original-date): Fixed. (iphoto-make-image-file-name): New function. (iphoto-dir-to-album-dir): Use `iphoto-make-image-file-name'. --- diff --git a/iphoto-util.el b/iphoto-util.el index 5b01200..06c2477 100644 --- a/iphoto-util.el +++ b/iphoto-util.el @@ -42,9 +42,10 @@ ;; "~/Pictures/iPhoto Library/Originals/2006/") (defun exif-find-image-directories-by-original-date (year month day) - (let (base-dir date-time date-pat dest ret) + (let (base-dir ; date-time + date-pat dest ret) (setq base-dir (format "~/Pictures/iPhoto Library/Modified/%d/" year)) - (setq date-time (encode-time 0 0 0 day month year)) + ;; (setq date-time (encode-time 0 0 0 day month year)) (setq date-pat (format "^%d:%02d:%02d" year month day)) (dolist (dir (directory-files base-dir)) (when (and (not (string-match "^\\.+$" dir)) @@ -89,9 +90,9 @@ (< (nth 1 ret)(nth 1 time-min)))) (setq time-min ret)) (if (or (null time-max) - (< (car time-min)(car ret)) - (and (= (car time-min)(car ret)) - (< (nth 1 time-min)(nth 1 ret)))) + (< (car time-max)(car ret)) + (and (= (car time-max)(car ret)) + (< (nth 1 time-max)(nth 1 ret)))) (setq time-max ret)) )) (cons time-min time-max))) @@ -129,12 +130,46 @@ (nth 1 time-max) (nth 0 time-max)))))) +(defun iphoto-make-image-file-name (file &optional base-time) + (let (ret + file-time file-year file-month file-day file-hour file-min file-sec) + (setq file-time + (split-string + (exif-image-file-date-time-original file) + " ")) + (setq ret (split-string (car file-time) ":")) + (setq file-year (string-to-int (car ret)) + file-month (string-to-int (nth 1 ret)) + file-day (string-to-int (nth 2 ret))) + (setq ret (split-string (nth 1 file-time) ":")) + (setq file-hour (string-to-int (car ret)) + file-min (string-to-int (nth 1 ret)) + file-sec (string-to-int (nth 2 ret))) + (when base-time + (setq file-time + (encode-time file-sec file-min file-hour + file-day file-month file-year)) + (setq file-hour + (/ (- (+ (lsh (- (car file-time) (car base-time)) 16) + (nth 1 file-time)) + (nth 1 base-time)) + 3600))) + ;; (format "%02d%02d%s" + ;; file-hour file-min + ;; (file-name-nondirectory file)) + (format "%02d%02d%02d%s" + file-hour file-min file-sec + (file-name-nondirectory file)) + )) + (defun iphoto-dir-to-album-dir (year month day album-name album-dir-root url-root image-url-root album-url-prefix) (let ((coding-system-for-write 'utf-8-jp-er) (album-dir-base (expand-file-name album-name album-dir-root)) - album-dir album-dir-original ret a-dir-n a-dirs) + (base-time (encode-time 0 0 0 day month year)) + album-dir album-dir-original ret a-dir-n a-dirs + new-file) (dolist (dir (exif-find-image-directories-by-original-date year month day)) @@ -151,14 +186,18 @@ (unless (file-exists-p album-dir) (make-directory album-dir 'parents)) (dolist (file (directory-files dir 'full nil 'no-sort t)) - (call-process "ln" nil nil nil + (call-process "ln" nil nil nil file - album-dir) - ;; (call-process "gcp" nil nil nil - ;; "-al" + (expand-file-name + (iphoto-make-image-file-name file base-time) + ;; (format "%02dh%02dm%02ds_%s" + ;; file-hour file-min file-sec + ;; (file-name-nondirectory file)) + album-dir)) + ;; (call-process "ln" nil nil nil ;; file ;; album-dir) - ) + ) (with-temp-buffer (insert ";; -*- mode: emacs-lisp; coding: utf-8-jp-er; -*-\n") (insert (pp (list @@ -183,27 +222,34 @@ (format "~/Pictures/iPhoto Library/Originals/%d/" year)) 'full nil 'no-sort t)) + (setq new-file + (concat + (file-name-sans-extension + (iphoto-make-image-file-name + (expand-file-name + (concat (file-name-sans-extension + (file-name-nondirectory file)) ".jpg") + dir))) + "." (file-name-extension file))) (cond ((string= (downcase (file-name-extension file)) "jpg") (unless (file-exists-p album-dir-original) (make-directory album-dir-original 'parents)) (call-process "ln" nil nil nil file - album-dir-original) - ;; (call-process "gcp" nil nil nil - ;; "-al" + (expand-file-name new-file album-dir-original)) + ;; (call-process "ln" nil nil nil ;; file ;; album-dir-original) - ) + ) (t (call-process "ln" nil nil nil file - album-dir) - ;; (call-process "gcp" nil nil nil - ;; "-al" + (expand-file-name new-file album-dir)) + ;; (call-process "ln" nil nil nil ;; file ;; album-dir) - )) + )) ) (call-process "chgrp" nil nil nil "-R" "www-data"