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