From: tomo <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/cgi-bin/gitweb.cgi?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"