;; (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)))))
;;; for exif 0.6.9
;; (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)))))
;;; for exif 0.6.15
;; (defun exif-image-file-date-time-original (image-file)
;; (with-temp-buffer
;; (call-process "exif" nil t nil
;; "-x" (expand-file-name image-file))
;; (goto-char (point-min))
;; (if (re-search-forward
;; "\\([^<>]+\\)"
;; nil t)
;; (match-string 1))))
;;; for exiftime Version 1.01
(defun exif-image-file-date-time-original (image-file)
(with-temp-buffer
(call-process "exiftime" nil t nil
(expand-file-name image-file))
(goto-char (point-min))
(if (re-search-forward
"^Image Generated: "
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 "%02dh%02dm%02ds"
(nth 2 time-min)
(nth 1 time-min)
(nth 0 time-min))
(format "%d-%02d-%02d-%02dh%02dm%02ds"
(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 "%02dh%02dm%02ds"
(nth 2 time-max)
(nth 1 time-max)
(nth 0 time-max))
(format "%d-%02d-%02d-%02dh%02dm%02ds"
(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
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)
(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 "ln" nil nil nil
file
album-dir)
;; (call-process "gcp" 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
(nbutlast
(split-string time "[hms]"))
":"))
(split-string a-dir-n "-")
"〜")))
;; (cons 'files
;; (directory-files dir nil nil nil t))
(cons 'exit (concat album-url-prefix album-name)))))
(write-region (point-min)(point-max)
(expand-file-name "dir.desc" album-dir)))
(dolist (file (directory-files
(expand-file-name
(file-name-nondirectory dir)
(format "~/Pictures/iPhoto Library/Originals/%d/"
year))
'full nil 'no-sort t))
(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"
;; file
;; album-dir-original)
)
(t
(call-process "ln" nil nil nil
file
album-dir)
;; (call-process "gcp" nil nil nil
;; "-al"
;; file
;; album-dir)
))
)
(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 "
")
(insert (format "(%d年%d月%d日)\n"
year month day))
(insert "\n\n")
(insert (format "(%d年%d月%d日)
\n"
year month day))
(insert "\n
\n")
(insert "\n\n")
(dolist (sub-url (sort a-dirs #'string<))
(insert (format " - %s
"
url-root album-name sub-url
image-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 "
")
(write-region (point-min)(point-max)
(expand-file-name
"index.html.ja.utf-8" album-dir-base))
)))