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