1 ;; (defun image-file-timestamp (image-file)
3 ;; (call-process "identify" nil t nil
4 ;; "-verbose" (expand-file-name image-file))
5 ;; (goto-char (point-min))
6 ;; (if (re-search-forward "^[ \t]*Timestamp: " nil t)
7 ;; (buffer-substring (match-end 0)(point-at-eol)))))
9 (defun exif-image-file-date-time-original (image-file)
11 (call-process "exif" nil t nil
12 "-t" "DateTimeOriginal"
13 (expand-file-name image-file))
14 (goto-char (point-min))
15 (if (re-search-forward "^[ \t]*Value: " nil t)
16 (buffer-substring (match-end 0)(point-at-eol)))))
19 ;; "~/Pictures/iPhoto Library/Originals/2006/")
21 (defun exif-find-image-directories-by-original-date (year month day)
22 (let (base-dir date-time date-pat dest ret)
23 (setq base-dir (format "~/Pictures/iPhoto Library/Modified/%d/" year))
24 (setq date-time (encode-time 0 0 0 day month year))
25 (setq date-pat (format "^%d:%02d:%02d" year month day))
26 (dolist (dir (directory-files base-dir))
27 (when (and (not (string-match "^\\.+$" dir))
28 (setq dir (expand-file-name dir base-dir))
29 (file-directory-p dir)
30 (setq ret (nth 5 (file-attributes dir)))
31 (or (> (car ret)(car date-time))
32 (and (= (car ret)(car date-time))
33 (>= (nth 1 ret)(nth 1 date-time))))
35 (exif-image-file-date-time-original
37 (directory-files dir 'full "\\.[A-Za-z0-9]+$"))))
38 (string-match date-pat ret))
43 (defun exif-image-directory-original-time-range (image-dir)
44 (let (ret time-min time-max
46 year month day hour min sec)
47 (dolist (file (directory-files
49 'full "\\.\\(JPG\\|jpg\\)$" 'no-sort))
50 (when (and (setq ret (exif-image-file-date-time-original file))
51 (setq ret (split-string ret " "))
54 (setq ret (split-string date ":"))
55 (setq year (string-to-int (car ret))
56 month (string-to-int (nth 1 ret))
57 day (string-to-int (nth 2 ret)))
58 (setq ret (split-string time ":"))
59 (setq hour (string-to-int (car ret))
60 min (string-to-int (nth 1 ret))
61 sec (string-to-int (nth 2 ret)))
62 (setq ret (encode-time sec min hour day month year)))
63 (if (or (null time-min)
64 (< (car ret)(car time-min))
65 (and (= (car ret)(car time-min))
66 (< (nth 1 ret)(nth 1 time-min))))
68 (if (or (null time-max)
69 (< (car time-min)(car ret))
70 (and (= (car time-min)(car ret))
71 (< (nth 1 time-min)(nth 1 ret))))
74 (cons time-min time-max)))
76 (defun iphoto-dir-format-time-range-as-album-dir (range year month day)
77 (let ((time-min (decode-time (car range)))
78 (time-max (decode-time (cdr range))))
80 (if (and (= (nth 3 time-min) day)
81 (= (nth 4 time-min) month)
82 (= (nth 5 time-min) year))
83 (format "%02d-%02d-%02d"
87 (format "%d-%02d-%02d-%02d-%02d-%02d"
94 (if (and (= (nth 3 time-max) day)
95 (= (nth 4 time-max) month)
96 (= (nth 5 time-max) year))
97 (format "%02d-%02d-%02d"
101 (format "%d-%02d-%02d-%02d-%02d-%02d"
107 (nth 0 time-max))))))
109 (defun iphoto-dir-to-album-dir (year month day album-name
110 album-dir-root url-root image-url-root
112 (let ((coding-system-for-write 'utf-8-jp-er)
113 (album-dir-base (expand-file-name album-name album-dir-root))
114 album-dir album-dir-original ret a-dir-n a-dirs)
116 (exif-find-image-directories-by-original-date
121 (iphoto-dir-format-time-range-as-album-dir
122 (exif-image-directory-original-time-range dir)
125 (setq a-dirs (cons a-dir-n a-dirs))
126 (setq album-dir-original
127 (expand-file-name "Originals" album-dir))
128 (unless (file-exists-p album-dir)
129 (make-directory album-dir 'parents))
130 (dolist (file (directory-files dir 'full nil 'no-sort t))
131 (call-process "cp" nil nil nil
136 (insert ";; -*- mode: emacs-lisp; coding: utf-8-jp-er; -*-\n")
142 (mapconcat #'identity
143 (split-string time "-")
145 (split-string a-dir-n "_")
148 (directory-files dir nil nil nil t))
149 (cons 'exit (concat album-url-prefix album-name)))))
150 (write-region (point-min)(point-max)
151 (expand-file-name "dir.desc" album-dir)))
152 (unless (file-exists-p album-dir-original)
153 (make-directory album-dir-original 'parents))
154 (dolist (file (directory-files
156 (file-name-nondirectory dir)
157 (format "~/Pictures/iPhoto Library/Originals/%d/"
159 'full nil 'no-sort t))
160 (call-process "cp" nil nil nil
164 (call-process "chgrp" nil nil nil
167 (call-process "chmod" nil nil nil
170 (call-process "chmod" nil nil nil
175 (insert "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
176 \"http://www.w3.org/TR/html4/loose.dtd\">
180 (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"
182 (insert "</head>\n<body>\n")
183 (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"
187 (dolist (sub-url (sort a-dirs #'string<))
188 (insert (format " <li><a
189 href=\"%s/%s/%s/&lang=ja\"
191 src=\"%s/%s/%s/%s&size=thumbnail\"
194 url-root album-name sub-url
195 image-url-root album-name sub-url
199 (expand-file-name sub-url album-dir-base)
200 nil "\\.\\(JPG\\|jpg\\)$" 'no-sort))
201 (nth (random (length ret))
206 (insert-file-contents
209 (expand-file-name sub-url album-dir-base)))
210 (read (current-buffer))))))))
218 (write-region (point-min)(point-max)
220 "index.html.ja.utf-8" album-dir-base))