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