New file.

diff --git a/iphoto-util.el b/iphoto-util.el
new file mode 100644 (file)
index 0000000..1321b7d
--- /dev/null
+++ b/iphoto-util.el
@@ -0,0 +1,221 @@
+;; (defun image-file-timestamp (image-file)
+;;   (with-temp-buffer
+;;     (call-process "identify" nil t nil
+;;                   "-verbose" (expand-file-name image-file))
+;;     (goto-char (point-min))
+;;     (if (re-search-forward "^[ \t]*Timestamp: " nil t)
+;;         (buffer-substring (match-end 0)(point-at-eol)))))
+
+(defun exif-image-file-date-time-original (image-file)
+  (with-temp-buffer
+    (call-process "exif" nil t nil
+                 "-t" "DateTimeOriginal"
+                 (expand-file-name image-file))
+    (goto-char (point-min))
+    (if (re-search-forward "^[ \t]*Value: " nil t)
+       (buffer-substring (match-end 0)(point-at-eol)))))
+
+;; (directory-files
+;;  "~/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)
+    (setq base-dir (format "~/Pictures/iPhoto Library/Modified/%d/" 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))
+                (setq dir (expand-file-name dir base-dir))
+                (file-directory-p dir)
+                (setq ret (nth 5 (file-attributes dir)))
+                (or (> (car ret)(car date-time))
+                    (and (= (car ret)(car date-time))
+                         (>= (nth 1 ret)(nth 1 date-time))))
+                (setq ret
+                      (exif-image-file-date-time-original
+                       (car
+                        (directory-files dir 'full "\\.[A-Za-z0-9]+$"))))
+                (string-match date-pat ret))
+       (setq dest
+             (cons dir dest))))
+    dest))
+
+(defun exif-image-directory-original-time-range (image-dir)
+  (let (ret time-min time-max
+           date time
+           year month day hour min sec)
+    (dolist (file (directory-files 
+                  image-dir
+                  'full "\\.\\(JPG\\|jpg\\)$" 'no-sort))
+      (when (and (setq ret (exif-image-file-date-time-original file))
+                (setq ret (split-string ret " "))
+                (setq date (car ret)
+                      time (nth 1 ret))
+                (setq ret (split-string date ":"))
+                (setq year (string-to-int (car ret))
+                      month (string-to-int (nth 1 ret))
+                      day (string-to-int (nth 2 ret)))
+                (setq ret (split-string time ":"))
+                (setq hour (string-to-int (car ret))
+                      min (string-to-int (nth 1 ret))
+                      sec (string-to-int (nth 2 ret)))
+                (setq ret (encode-time sec min hour day month year)))
+       (if (or (null time-min)
+               (< (car ret)(car time-min))
+               (and (= (car ret)(car time-min))
+                    (< (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))))
+           (setq time-max ret))
+       ))
+    (cons time-min time-max)))
+
+(defun iphoto-dir-format-time-range-as-album-dir (range year month day)
+  (let ((time-min (decode-time (car range)))
+       (time-max (decode-time (cdr range))))
+    (format "%s_%s"
+           (if (and (= (nth 3 time-min) day)
+                    (= (nth 4 time-min) month)
+                    (= (nth 5 time-min) year))
+               (format "%02d-%02d-%02d"
+                       (nth 2 time-min)
+                       (nth 1 time-min)
+                       (nth 0 time-min))
+             (format "%d-%02d-%02d-%02d-%02d-%02d"
+                     (nth 5 time-min)
+                     (nth 4 time-min)
+                     (nth 3 time-min)
+                     (nth 2 time-min)
+                     (nth 1 time-min)
+                     (nth 0 time-min)))
+           (if (and (= (nth 3 time-max) day)
+                    (= (nth 4 time-max) month)
+                    (= (nth 5 time-max) year))
+               (format "%02d-%02d-%02d"
+                       (nth 2 time-max)
+                       (nth 1 time-max)
+                       (nth 0 time-max))
+             (format "%d-%02d-%02d-%02d-%02d-%02d"
+                     (nth 5 time-max)
+                     (nth 4 time-max)
+                     (nth 3 time-max)
+                     (nth 2 time-max)
+                     (nth 1 time-max)
+                     (nth 0 time-max))))))
+
+(defun iphoto-dir-to-album-dir (year month day album-name
+                                    url-root album-dir-root)
+  (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)
+    (dolist (dir
+            (exif-find-image-directories-by-original-date
+             year month day))
+      (setq album-dir
+           (expand-file-name
+            (setq a-dir-n
+                  (iphoto-dir-format-time-range-as-album-dir
+                   (exif-image-directory-original-time-range dir)
+                   year month day))
+            album-dir-base))
+      (setq a-dirs (cons a-dir-n a-dirs))
+      (setq album-dir-original
+           (expand-file-name "Originals" album-dir))
+      (unless (file-exists-p album-dir)
+       (make-directory album-dir 'parents))
+      (dolist (file (directory-files dir 'full nil 'no-sort t))
+       (call-process "cp" nil nil nil
+                     "-al" 
+                     file
+                     album-dir))
+      (with-temp-buffer
+       (insert ";; -*- mode: emacs-lisp; coding: utf-8-jp-er; -*-\n")
+       (insert (pp (list
+                    (cons 'title
+                          (format "(%s)"
+                                  (mapconcat
+                                   (lambda (time)
+                                     (mapconcat #'identity
+                                                (split-string time "-")
+                                                ":"))
+                                   (split-string a-dir-n "_")
+                                   "\e$B!A\e(B")))
+                    (cons 'files
+                          (directory-files dir nil nil nil t))
+                    (cons 'exit album-name))))
+       (write-region (point-min)(point-max)
+                     (expand-file-name "dir.desc" album-dir)))
+      (unless (file-exists-p album-dir-original)
+       (make-directory album-dir-original 'parents))
+      (dolist (file (directory-files
+                    (expand-file-name
+                     (file-name-nondirectory dir)
+                     (format "~/Pictures/iPhoto Library/Originals/%d/"
+                             year))
+                    'full nil 'no-sort t))
+       (call-process "cp" nil nil nil
+                     "-al" 
+                     file
+                     album-dir-original))
+      (call-process "chgrp" nil nil nil
+                   "-R" "www-data"
+                   album-dir)
+      (call-process "chmod" nil nil nil
+                   "-R" "g+r"
+                   album-dir)
+      (call-process "chmod" nil nil nil
+                   "g+w"
+                   album-dir)
+      )
+    (with-temp-buffer
+      (insert "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+\"http://www.w3.org/TR/html4/loose.dtd\">
+<html lang=\"ja\">
+<head>
+")
+      (insert (format "<title>\e$B!J\e(B%d\e$BG/\e(B%d\e$B7n\e(B%d\e$BF|!K\e(B</title>\n"
+                     year month day))
+      (insert "</head>\n<body>\n")
+      (insert (format "<h1>\e$B!J\e(B%d\e$BG/\e(B%d\e$B7n\e(B%d\e$BF|!K\e(B</h1>\n"
+                     year month day))
+      (insert "\n<hr>\n")
+      (insert "\n<ul>\n")
+      (dolist (sub-url (sort a-dirs #'string<))
+       (insert (format "  <li><a
+      href=\"%s/%s/%s/&lang=ja\"
+      ><img
+      src=\"%s/%s/%s/%s&size=thumbnail\"
+      >%s</a>
+"
+                       url-root album-name sub-url
+                       url-root album-name sub-url
+                       (progn
+                         (setq ret
+                               (directory-files
+                                (expand-file-name sub-url album-dir-base)
+                                nil "\\.\\(JPG\\|jpg\\)$" 'no-sort))
+                         (nth (random (length ret))
+                              ret))
+                       (cdr
+                        (assq 'title
+                              (with-temp-buffer
+                                (insert-file-contents
+                                 (expand-file-name
+                                  "dir.desc"
+                                  (expand-file-name sub-url album-dir-base)))
+                                (read (current-buffer))))))))
+      (insert "</ul>
+
+<hr>
+
+</body>
+</html>
+")
+      (write-region (point-min)(point-max)
+                   (expand-file-name
+                    "index.html.ja.utf-8" album-dir-base))
+      )))
+                 
\ No newline at end of file