;; (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 "%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 "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
						 (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 "cp" nil nil nil
			"-al" 
			file
			album-dir-original)
	  )
	 (t
	  (call-process "cp" 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 "<!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>（%d年%d月%d日）</title>\n"
		      year month day))
      (insert "</head>\n<body>\n")
      (insert (format "<h1>（%d年%d月%d日）</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
			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 "</ul>

<hr>

</body>
</html>
")
      (write-region (point-min)(point-max)
		    (expand-file-name
		     "index.html.ja.utf-8" album-dir-base))
      )))