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                                      album-url-prefix)
 112   (let ((coding-system-for-write 'utf-8-jp-er)
 113         (album-dir-base (expand-file-name album-name album-dir-root))
 114         album-dir album-dir-original ret a-dir-n a-dirs)
 115     (dolist (dir
 116              (exif-find-image-directories-by-original-date
 117               year month day))
 118       (setq album-dir
 119             (expand-file-name
 120              (setq a-dir-n
 121                    (iphoto-dir-format-time-range-as-album-dir
 122                     (exif-image-directory-original-time-range dir)
 123                     year month day))
 124              album-dir-base))
 125       (setq a-dirs (cons a-dir-n a-dirs))
 126       (setq album-dir-original
 127             (expand-file-name "Originals" album-dir))
 128       (unless (file-exists-p album-dir)
 129         (make-directory album-dir 'parents))
 130       (dolist (file (directory-files dir 'full nil 'no-sort t))
 131         (call-process "cp" nil nil nil
 132                       "-al"
 133                       file
 134                       album-dir))
 135       (with-temp-buffer
 136         (insert ";; -*- mode: emacs-lisp; coding: utf-8-jp-er; -*-\n")
 137         (insert (pp (list
 138                      (cons 'title
 139                            (format "(%s)"
 140                                    (mapconcat
 141                                     (lambda (time)
 142                                       (mapconcat #'identity
 143                                                  (split-string time "-")
 144                                                  ":"))
 145                                     (split-string a-dir-n "_")
 146                                     "\e$B!A\e(B")))
 147                      ;; (cons 'files
 148                      ;;       (directory-files dir nil nil nil t))
 149                      (cons 'exit (concat album-url-prefix album-name)))))
 150         (write-region (point-min)(point-max)
 151                       (expand-file-name "dir.desc" album-dir)))
 152       (dolist (file (directory-files
 153                      (expand-file-name
 154                       (file-name-nondirectory dir)
 155                       (format "~/Pictures/iPhoto Library/Originals/%d/"
 156                               year))
 157                      'full nil 'no-sort t))
 158         (cond
 159          ((string= (downcase (file-name-extension file)) "jpg")
 160           (unless (file-exists-p album-dir-original)
 161             (make-directory album-dir-original 'parents))
 162           (call-process "cp" nil nil nil
 163                         "-al"
 164                         file
 165                         album-dir-original)
 166           )
 167          (t
 168           (call-process "cp" nil nil nil
 169                         "-al"
 170                         file
 171                         album-dir)
 172           ))
 173         )
 174       (call-process "chgrp" nil nil nil
 175                     "-R" "www-data"
 176                     album-dir)
 177       (call-process "chmod" nil nil nil
 178                     "-R" "g+r"
 179                     album-dir)
 180       (call-process "chmod" nil nil nil
 181                     "g+w"
 182                     album-dir)
 183       )
 184     (with-temp-buffer
 185       (insert "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 186 \"http://www.w3.org/TR/html4/loose.dtd\">
 187 <html lang=\"ja\">
 188 <head>
 189 ")
 190       (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"
 191                       year month day))
 192       (insert "</head>\n<body>\n")
 193       (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"
 194                       year month day))
 195       (insert "\n<hr>\n")
 196       (insert "\n<ul>\n")
 197       (dolist (sub-url (sort a-dirs #'string<))
 198         (insert (format "  <li><a
 199       href=\"%s/%s/%s/&lang=ja\"
 200       ><img
 201       src=\"%s/%s/%s/%s&size=thumbnail\"
 202       >%s</a>
 203 "
 204                         url-root album-name sub-url
 205                         image-url-root album-name sub-url
 206                         (progn
 207                           (setq ret
 208                                 (directory-files
 209                                  (expand-file-name sub-url album-dir-base)
 210                                  nil "\\.\\(JPG\\|jpg\\)$" 'no-sort))
 211                           (nth (random (length ret))
 212                                ret))
 213                         (cdr
 214                          (assq 'title
 215                                (with-temp-buffer
 216                                  (insert-file-contents
 217                                   (expand-file-name
 218                                    "dir.desc"
 219                                    (expand-file-name sub-url album-dir-base)))
 220                                  (read (current-buffer))))))))
 221       (insert "</ul>
 222
 223 <hr>
 224
 225 </body>
 226 </html>
 227 ")
 228       (write-region (point-min)(point-max)
 229                     (expand-file-name
 230                      "index.html.ja.utf-8" album-dir-base))
 231       )))