(exif-find-image-directories-by-original-date): Fixed.

[elisp/album.git] / iphoto-util.el

diff --git a/iphoto-util.el b/iphoto-util.el
index 5b01200..06c2477 100644 (file)
--- 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"