From: tomo <tomo>
Date: Fri, 22 Sep 2006 04:25:58 +0000 (+0000)
Subject: New file.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=03f6a756ab652d208bb071bb20bf42790019ab15;p=elisp%2Falbum.git

New file.
---

diff --git a/iphoto-util.el b/iphoto-util.el
new file mode 100644
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 "_")
+				    "〜")))
+		     (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>（%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
+			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