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)))))
10 ;; (defun exif-image-file-date-time-original (image-file)
12 ;; (call-process "exif" nil t nil
13 ;; "-t" "DateTimeOriginal"
14 ;; (expand-file-name image-file))
15 ;; (goto-char (point-min))
16 ;; (if (re-search-forward "^[ \t]*Value: " nil t)
17 ;; (buffer-substring (match-end 0)(point-at-eol)))))
20 ;; (defun exif-image-file-date-time-original (image-file)
22 ;; (call-process "exif" nil t nil
23 ;; "-x" (expand-file-name image-file))
24 ;; (goto-char (point-min))
25 ;; (if (re-search-forward
26 ;; "<Date_and_Time__original_>\\([^<>]+\\)</Date_and_Time__original_>"
28 ;; (match-string 1))))
30 ;;; for exiftime Version 1.01
31 (defun exif-image-file-date-time-original (image-file)
33 (call-process "exiftime" nil t nil
34 (expand-file-name image-file))
35 (goto-char (point-min))
36 (if (re-search-forward
39 (buffer-substring (match-end 0)(point-at-eol)))))
42 ;; "~/Pictures/iPhoto Library/Originals/2006/")
44 (defun exif-find-image-directories-by-original-date (year month day)
45 (let (base-dir ; date-time
47 (setq base-dir (format "~/Pictures/iPhoto Library/Modified/%d/" year))
48 ;; (setq date-time (encode-time 0 0 0 day month year))
49 (setq date-pat (format "^%d:%02d:%02d" year month day))
50 (dolist (dir (directory-files base-dir))
51 (when (and (not (string-match "^\\.+$" dir))
52 (setq dir (expand-file-name dir base-dir))
53 (file-directory-p dir)
54 ;; (setq ret (nth 5 (file-attributes dir)))
55 ;; (or (> (car ret)(car date-time))
56 ;; (and (= (car ret)(car date-time))
57 ;; (>= (nth 1 ret)(nth 1 date-time))))
59 (exif-image-file-date-time-original
61 (directory-files dir 'full "\\.[A-Za-z0-9]+$"))))
62 (string-match date-pat ret))
67 (defun exif-image-directory-original-time-range (image-dir)
68 (let (ret time-min time-max
70 year month day hour min sec)
71 (dolist (file (directory-files
73 'full "\\.\\(JPG\\|jpg\\)$" 'no-sort))
74 (when (and (setq ret (exif-image-file-date-time-original file))
75 (setq ret (split-string ret " "))
78 (setq ret (split-string date ":"))
79 (setq year (string-to-int (car ret))
80 month (string-to-int (nth 1 ret))
81 day (string-to-int (nth 2 ret)))
82 (setq ret (split-string time ":"))
83 (setq hour (string-to-int (car ret))
84 min (string-to-int (nth 1 ret))
85 sec (string-to-int (nth 2 ret)))
86 (setq ret (encode-time sec min hour day month year)))
87 (if (or (null time-min)
88 (< (car ret)(car time-min))
89 (and (= (car ret)(car time-min))
90 (< (nth 1 ret)(nth 1 time-min))))
92 (if (or (null time-max)
93 (< (car time-max)(car ret))
94 (and (= (car time-max)(car ret))
95 (< (nth 1 time-max)(nth 1 ret))))
98 (cons time-min time-max)))
100 (defun iphoto-dir-format-time-range-as-album-dir (range year month day)
101 (let ((time-min (decode-time (car range)))
102 (time-max (decode-time (cdr range))))
104 (if (and (= (nth 3 time-min) day)
105 (= (nth 4 time-min) month)
106 (= (nth 5 time-min) year))
107 (format "%02dh%02dm%02ds"
111 (format "%d-%02d-%02d-%02dh%02dm%02ds"
118 (if (and (= (nth 3 time-max) day)
119 (= (nth 4 time-max) month)
120 (= (nth 5 time-max) year))
121 (format "%02dh%02dm%02ds"
125 (format "%d-%02d-%02d-%02dh%02dm%02ds"
131 (nth 0 time-max))))))
133 (defun iphoto-make-image-file-name (file &optional base-time)
135 file-time file-year file-month file-day file-hour file-min file-sec)
138 (exif-image-file-date-time-original file)
140 (setq ret (split-string (car file-time) ":"))
141 (setq file-year (string-to-int (car ret))
142 file-month (string-to-int (nth 1 ret))
143 file-day (string-to-int (nth 2 ret)))
144 (setq ret (split-string (nth 1 file-time) ":"))
145 (setq file-hour (string-to-int (car ret))
146 file-min (string-to-int (nth 1 ret))
147 file-sec (string-to-int (nth 2 ret)))
150 (encode-time file-sec file-min file-hour
151 file-day file-month file-year))
153 (/ (- (+ (lsh (- (car file-time) (car base-time)) 16)
157 ;; (format "%02d%02d%s"
158 ;; file-hour file-min
159 ;; (file-name-nondirectory file))
160 (format "%02d%02d%02d%s"
161 file-hour file-min file-sec
162 (file-name-nondirectory file))
165 (defun iphoto-dir-to-album-dir (year month day album-name
166 album-dir-root url-root image-url-root
168 (let ((coding-system-for-write 'utf-8-jp-er)
169 (album-dir-base (expand-file-name album-name album-dir-root))
170 (base-time (encode-time 0 0 0 day month year))
171 album-dir album-dir-original ret a-dir-n a-dirs
174 (exif-find-image-directories-by-original-date
179 (iphoto-dir-format-time-range-as-album-dir
180 (exif-image-directory-original-time-range dir)
183 (setq a-dirs (cons a-dir-n a-dirs))
184 (setq album-dir-original
185 (expand-file-name "Originals" album-dir))
186 (unless (file-exists-p album-dir)
187 (make-directory album-dir 'parents))
188 (dolist (file (directory-files dir 'full nil 'no-sort t))
189 (call-process "ln" nil nil nil
192 (iphoto-make-image-file-name file base-time)
193 ;; (format "%02dh%02dm%02ds_%s"
194 ;; file-hour file-min file-sec
195 ;; (file-name-nondirectory file))
197 ;; (call-process "ln" nil nil nil
202 (insert ";; -*- mode: emacs-lisp; coding: utf-8-jp-er; -*-\n")
208 (mapconcat #'identity
210 (split-string time "[hms]"))
212 (split-string a-dir-n "-")
215 ;; (directory-files dir nil nil nil t))
216 (cons 'exit (concat album-url-prefix album-name)))))
217 (write-region (point-min)(point-max)
218 (expand-file-name "dir.desc" album-dir)))
219 (dolist (file (directory-files
221 (file-name-nondirectory dir)
222 (format "~/Pictures/iPhoto Library/Originals/%d/"
224 'full nil 'no-sort t))
227 (file-name-sans-extension
228 (iphoto-make-image-file-name
230 (concat (file-name-sans-extension
231 (file-name-nondirectory file)) ".jpg")
233 "." (file-name-extension file)))
235 ((string= (downcase (file-name-extension file)) "jpg")
236 (unless (file-exists-p album-dir-original)
237 (make-directory album-dir-original 'parents))
238 (call-process "ln" nil nil nil
240 (expand-file-name new-file album-dir-original))
241 ;; (call-process "ln" nil nil nil
243 ;; album-dir-original)
246 (call-process "ln" nil nil nil
248 (expand-file-name new-file album-dir))
249 ;; (call-process "ln" nil nil nil
254 (call-process "chgrp" nil nil nil
257 (call-process "chmod" nil nil nil
260 (call-process "chmod" nil nil nil
265 (insert "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
266 \"http://www.w3.org/TR/html4/loose.dtd\">
270 (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"
272 (insert "</head>\n<body>\n")
273 (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"
277 (dolist (sub-url (sort a-dirs #'string<))
278 (insert (format " <li><a
279 href=\"%s/%s/%s/&lang=ja\"
281 src=\"%s/%s/%s/%s&size=thumbnail\"
284 url-root album-name sub-url
285 image-url-root album-name sub-url
289 (expand-file-name sub-url album-dir-base)
290 nil "\\.\\(JPG\\|jpg\\)$" 'no-sort))
291 (nth (random (length ret))
296 (insert-file-contents
299 (expand-file-name sub-url album-dir-base)))
300 (read (current-buffer))))))))
308 (write-region (point-min)(point-max)
310 "index.html.ja.utf-8" album-dir-base))