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 "%02dh%02dm%02ds"
  84                         (nth 2 time-min)
  85                         (nth 1 time-min)
  86                         (nth 0 time-min))
  87               (format "%d-%02d-%02d-%02dh%02dm%02ds"
  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 "%02dh%02dm%02ds"
  98                         (nth 2 time-max)
  99                         (nth 1 time-max)
 100                         (nth 0 time-max))
 101               (format "%d-%02d-%02d-%02dh%02dm%02ds"
 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                                                  (nbutlast
 144                                                   (split-string time "[hms]"))
 145                                                  ":"))
 146                                     (split-string a-dir-n "-")
 147                                     "\e$B!A\e(B")))
 148                      ;; (cons 'files
 149                      ;;       (directory-files dir nil nil nil t))
 150                      (cons 'exit (concat album-url-prefix album-name)))))
 151         (write-region (point-min)(point-max)
 152                       (expand-file-name "dir.desc" album-dir)))
 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         (cond
 160          ((string= (downcase (file-name-extension file)) "jpg")
 161           (unless (file-exists-p album-dir-original)
 162             (make-directory album-dir-original 'parents))
 163           (call-process "cp" nil nil nil
 164                         "-al"
 165                         file
 166                         album-dir-original)
 167           )
 168          (t
 169           (call-process "cp" nil nil nil
 170                         "-al"
 171                         file
 172                         album-dir)
 173           ))
 174         )
 175       (call-process "chgrp" nil nil nil
 176                     "-R" "www-data"
 177                     album-dir)
 178       (call-process "chmod" nil nil nil
 179                     "-R" "g+r"
 180                     album-dir)
 181       (call-process "chmod" nil nil nil
 182                     "g+w"
 183                     album-dir)
 184       )
 185     (with-temp-buffer
 186       (insert "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 187 \"http://www.w3.org/TR/html4/loose.dtd\">
 188 <html lang=\"ja\">
 189 <head>
 190 ")
 191       (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"
 192                       year month day))
 193       (insert "</head>\n<body>\n")
 194       (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"
 195                       year month day))
 196       (insert "\n<hr>\n")
 197       (insert "\n<ul>\n")
 198       (dolist (sub-url (sort a-dirs #'string<))
 199         (insert (format "  <li><a
 200       href=\"%s/%s/%s/&lang=ja\"
 201       ><img
 202       src=\"%s/%s/%s/%s&size=thumbnail\"
 203       >%s</a>
 204 "
 205                         url-root album-name sub-url
 206                         image-url-root album-name sub-url
 207                         (progn
 208                           (setq ret
 209                                 (directory-files
 210                                  (expand-file-name sub-url album-dir-base)
 211                                  nil "\\.\\(JPG\\|jpg\\)$" 'no-sort))
 212                           (nth (random (length ret))
 213                                ret))
 214                         (cdr
 215                          (assq 'title
 216                                (with-temp-buffer
 217                                  (insert-file-contents
 218                                   (expand-file-name
 219                                    "dir.desc"
 220                                    (expand-file-name sub-url album-dir-base)))
 221                                  (read (current-buffer))))))))
 222       (insert "</ul>
 223
 224 <hr>
 225
 226 </body>
 227 </html>
 228 ")
 229       (write-region (point-min)(point-max)
 230                     (expand-file-name
 231                      "index.html.ja.utf-8" album-dir-base))
 232       )))