photo-store/exif.lisp

(in-package #:photo-store)

(defun degrees-to-rational (deg ref)
  (when deg
    (let ((rational
           (+ (elt deg 0)
              (/ (elt deg 1) 60)
              (/ (elt deg 2) 3600))))
      (if (member ref '("N" "E") :test #'equal)
          rational
          (- rational)))))

(defun exif-to-point (exif)
  (when exif
    (let ((lat (degrees-to-rational (zpb-exif:exif-value :GPSLatitude exif)
                                    (zpb-exif:exif-value :GPSLatitudeRef exif)))
          (lon (degrees-to-rational (zpb-exif:exif-value :GPSLongitude exif)
                                    (zpb-exif:exif-value :GPSLongitudeRef exif))))
      (and lat lon (geo:point-deg lat lon)))))

(defun exif-to-taken (exif)
  (when exif
    (or (zpb-exif:parsed-exif-value :DateTimeOriginal exif)
        (zpb-exif:parsed-exif-value :DateTime exif))))

(defun exif-to-dim (exif)
  (when exif
    (let ((width (or (zpb-exif:exif-value :PixelXDimension exif)
                     (zpb-exif:exif-value :ImageWidth exif)))
          (height (or (zpb-exif:exif-value :PixelYDimension exif)
                      (zpb-exif:exif-value :ImageHeight exif))))
      (and width height (list width height)))))

(defun get-dims (path)
  (ignore-errors
    (read-from-string
     (uiop:run-program
      (list "identify" "-format" "(%w %h)" (namestring path))
      :output :string))))

(defun load-photo-info (path)
  (with-open-file (in path :element-type '(unsigned-byte 8))
    (let ((length (file-length in))
          (modified (file-write-date path))
          (exif (ignore-errors (zpb-exif:make-exif in))))
      (list
       (cons :path path)
       (cons :name (pathname-name path))
       (cons :modified modified)
       (cons :length length)
       (cons :created-at (local-time:universal-to-timestamp
                          (or (exif-to-taken exif) modified)))
       (cons :dim (or (exif-to-dim exif)
                      (get-dims path)))
       (cons :location (exif-to-point exif))))))