iphoto-util.el

   1 ;; (defun image-file-timestamp (image-file)
   2 ;;   (with-temp-buffer
   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)))))
   8
   9 ;;; for exif 0.6.9
  10 ;; (defun exif-image-file-date-time-original (image-file)
  11 ;;   (with-temp-buffer
  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)))))
  18
  19 ;;; for exif 0.6.15
  20 (defun exif-image-file-date-time-original (image-file)
  21   (with-temp-buffer
  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_>"
  27          nil t)
  28         (match-string 1))))
  29
  30 ;; (directory-files
  31 ;;  "~/Pictures/iPhoto Library/Originals/2006/")
  32
  33 (defun exif-find-image-directories-by-original-date (year month day)
  34   (let (base-dir date-time date-pat dest ret)
  35     (setq base-dir (format "~/Pictures/iPhoto Library/Modified/%d/" year))
  36     (setq date-time (encode-time 0 0 0 day month year))
  37     (setq date-pat (format "^%d:%02d:%02d" year month day))
  38     (dolist (dir (directory-files base-dir))
  39       (when (and (not (string-match "^\\.+$" dir))
  40                  (setq dir (expand-file-name dir base-dir))
  41                  (file-directory-p dir)
  42                  ;; (setq ret (nth 5 (file-attributes dir)))
  43                  ;; (or (> (car ret)(car date-time))
  44                  ;;     (and (= (car ret)(car date-time))
  45                  ;;          (>= (nth 1 ret)(nth 1 date-time))))
  46                  (setq ret
  47                        (exif-image-file-date-time-original
  48                         (car
  49                          (directory-files dir 'full "\\.[A-Za-z0-9]+$"))))
  50                  (string-match date-pat ret))
  51         (setq dest
  52               (cons dir dest))))
  53     dest))
  54
  55 (defun exif-image-directory-original-time-range (image-dir)
  56   (let (ret time-min time-max
  57             date time
  58             year month day hour min sec)
  59     (dolist (file (directory-files
  60                    image-dir
  61                    'full "\\.\\(JPG\\|jpg\\)$" 'no-sort))
  62       (when (and (setq ret (exif-image-file-date-time-original file))
  63                  (setq ret (split-string ret " "))
  64                  (setq date (car ret)
  65                        time (nth 1 ret))
  66                  (setq ret (split-string date ":"))
  67                  (setq year (string-to-int (car ret))
  68                        month (string-to-int (nth 1 ret))
  69                        day (string-to-int (nth 2 ret)))
  70                  (setq ret (split-string time ":"))
  71                  (setq hour (string-to-int (car ret))
  72                        min (string-to-int (nth 1 ret))
  73                        sec (string-to-int (nth 2 ret)))
  74                  (setq ret (encode-time sec min hour day month year)))
  75         (if (or (null time-min)
  76                 (< (car ret)(car time-min))
  77                 (and (= (car ret)(car time-min))
  78                      (< (nth 1 ret)(nth 1 time-min))))
  79             (setq time-min ret))
  80         (if (or (null time-max)
  81                 (< (car time-min)(car ret))
  82                 (and (= (car time-min)(car ret))
  83                      (< (nth 1 time-min)(nth 1 ret))))
  84             (setq time-max ret))
  85         ))
  86     (cons time-min time-max)))
  87
  88 (defun iphoto-dir-format-time-range-as-album-dir (range year month day)
  89   (let ((time-min (decode-time (car range)))
  90         (time-max (decode-time (cdr range))))
  91     (format "%s-%s"
  92             (if (and (= (nth 3 time-min) day)
  93                      (= (nth 4 time-min) month)
  94                      (= (nth 5 time-min) year))
  95                 (format "%02dh%02dm%02ds"
  96                         (nth 2 time-min)
  97                         (nth 1 time-min)
  98                         (nth 0 time-min))
  99               (format "%d-%02d-%02d-%02dh%02dm%02ds"
 100                       (nth 5 time-min)
 101                       (nth 4 time-min)
 102                       (nth 3 time-min)
 103                       (nth 2 time-min)
 104                       (nth 1 time-min)
 105                       (nth 0 time-min)))
 106             (if (and (= (nth 3 time-max) day)
 107                      (= (nth 4 time-max) month)
 108                      (= (nth 5 time-max) year))
 109                 (format "%02dh%02dm%02ds"
 110                         (nth 2 time-max)
 111                         (nth 1 time-max)
 112                         (nth 0 time-max))
 113               (format "%d-%02d-%02d-%02dh%02dm%02ds"
 114                       (nth 5 time-max)
 115                       (nth 4 time-max)
 116                       (nth 3 time-max)
 117                       (nth 2 time-max)
 118                       (nth 1 time-max)
 119                       (nth 0 time-max))))))
 120
 121 (defun iphoto-dir-to-album-dir (year month day album-name
 122                                      album-dir-root url-root image-url-root
 123                                      album-url-prefix)
 124   (let ((coding-system-for-write 'utf-8-jp-er)
 125         (album-dir-base (expand-file-name album-name album-dir-root))
 126         album-dir album-dir-original ret a-dir-n a-dirs)
 127     (dolist (dir
 128              (exif-find-image-directories-by-original-date
 129               year month day))
 130       (setq album-dir
 131             (expand-file-name
 132              (setq a-dir-n
 133                    (iphoto-dir-format-time-range-as-album-dir
 134                     (exif-image-directory-original-time-range dir)
 135                     year month day))
 136              album-dir-base))
 137       (setq a-dirs (cons a-dir-n a-dirs))
 138       (setq album-dir-original
 139             (expand-file-name "Originals" album-dir))
 140       (unless (file-exists-p album-dir)
 141         (make-directory album-dir 'parents))
 142       (dolist (file (directory-files dir 'full nil 'no-sort t))
 143         (call-process "cp" nil nil nil
 144                       "-al"
 145                       file
 146                       album-dir))
 147       (with-temp-buffer
 148         (insert ";; -*- mode: emacs-lisp; coding: utf-8-jp-er; -*-\n")
 149         (insert (pp (list
 150                      (cons 'title
 151                            (format "(%s)"
 152                                    (mapconcat
 153                                     (lambda (time)
 154                                       (mapconcat #'identity
 155                                                  (nbutlast
 156                                                   (split-string time "[hms]"))
 157                                                  ":"))
 158                                     (split-string a-dir-n "-")
 159                                     "\e$B!A\e(B")))
 160                      ;; (cons 'files
 161                      ;;       (directory-files dir nil nil nil t))
 162                      (cons 'exit (concat album-url-prefix album-name)))))
 163         (write-region (point-min)(point-max)
 164                       (expand-file-name "dir.desc" album-dir)))
 165       (dolist (file (directory-files
 166                      (expand-file-name
 167                       (file-name-nondirectory dir)
 168                       (format "~/Pictures/iPhoto Library/Originals/%d/"
 169                               year))
 170                      'full nil 'no-sort t))
 171         (cond
 172          ((string= (downcase (file-name-extension file)) "jpg")
 173           (unless (file-exists-p album-dir-original)
 174             (make-directory album-dir-original 'parents))
 175           (call-process "cp" nil nil nil
 176                         "-al"
 177                         file
 178                         album-dir-original)
 179           )
 180          (t
 181           (call-process "cp" nil nil nil
 182                         "-al"
 183                         file
 184                         album-dir)
 185           ))
 186         )
 187       (call-process "chgrp" nil nil nil
 188                     "-R" "www-data"
 189                     album-dir)
 190       (call-process "chmod" nil nil nil
 191                     "-R" "g+r"
 192                     album-dir)
 193       (call-process "chmod" nil nil nil
 194                     "g+w"
 195                     album-dir)
 196       )
 197     (with-temp-buffer
 198       (insert "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 199 \"http://www.w3.org/TR/html4/loose.dtd\">
 200 <html lang=\"ja\">
 201 <head>
 202 ")
 203       (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"
 204                       year month day))
 205       (insert "</head>\n<body>\n")
 206       (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"
 207                       year month day))
 208       (insert "\n<hr>\n")
 209       (insert "\n<ul>\n")
 210       (dolist (sub-url (sort a-dirs #'string<))
 211         (insert (format "  <li><a
 212       href=\"%s/%s/%s/&lang=ja\"
 213       ><img
 214       src=\"%s/%s/%s/%s&size=thumbnail\"
 215       >%s</a>
 216 "
 217                         url-root album-name sub-url
 218                         image-url-root album-name sub-url
 219                         (progn
 220                           (setq ret
 221                                 (directory-files
 222                                  (expand-file-name sub-url album-dir-base)
 223                                  nil "\\.\\(JPG\\|jpg\\)$" 'no-sort))
 224                           (nth (random (length ret))
 225                                ret))
 226                         (cdr
 227                          (assq 'title
 228                                (with-temp-buffer
 229                                  (insert-file-contents
 230                                   (expand-file-name
 231                                    "dir.desc"
 232                                    (expand-file-name sub-url album-dir-base)))
 233                                  (read (current-buffer))))))))
 234       (insert "</ul>
 235
 236 <hr>
 237
 238 </body>
 239 </html>
 240 ")
 241       (write-region (point-min)(point-max)
 242                     (expand-file-name
 243                      "index.html.ja.utf-8" album-dir-base))
 244       )))