|
|
@@ -1,4 +1,5 @@
|
|
|
(in-package #:photo-store)
|
|
|
+(use-package :iter)
|
|
|
|
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
|
(restas::register-pkgmodule-traits 'photo-store)
|
|
|
@@ -8,6 +9,72 @@
|
|
|
;; photos: id | album_id | filename | size | taken | width | height | lat | lon
|
|
|
;; albums: id | parent_id | path | date | name | description | cover_id | accessibility
|
|
|
|
|
|
+(defvar *db-path* "db.sqlite" "SQLite database path")
|
|
|
+
|
|
|
+(defmacro with-db ((db) &body body)
|
|
|
+ `(sqlite:with-open-database (,db *db-path* :busy-timeout 10)
|
|
|
+ (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON")
|
|
|
+ ,@body))
|
|
|
+
|
|
|
+(defun db-init ()
|
|
|
+ (with-db (db)
|
|
|
+ (sqlite:execute-non-query db "create table if not exists photos (id INTEGER PRIMARY KEY, path, size, taken, width, height, lat, lon)")
|
|
|
+ (sqlite:execute-non-query db "create table if not exists albums (id INTEGER PRIMARY KEY, name, description, cover_id REFERENCES photos)")
|
|
|
+ (sqlite:execute-non-query db "create table if not exists album_photos (album_id REFERENCES albums NOT NULL, photo_id REFERENCES photos NOT NULL, description, idx, hidden)")))
|
|
|
+
|
|
|
+(defun db/add-photo (db info)
|
|
|
+ (let* ((path (namestring (uiop:subpathp (aget :path info) *photo-storage-path*)))
|
|
|
+ (size (aget :length info))
|
|
|
+ (taken (local-time:timestamp-to-unix (aget :created-at info)))
|
|
|
+ (dim (aget :dim info))
|
|
|
+ (w (first dim)) (h (second dim))
|
|
|
+ (loc (aget :location info))
|
|
|
+ (lat (and loc (geo:latitude-deg loc)))
|
|
|
+ (lon (and loc (geo:longitude-deg loc))))
|
|
|
+ (sqlite:execute-non-query
|
|
|
+ db "insert into photos (path, size, taken, width, height, lat, lon) values (?, ?, ?, ?, ?, ?, ?)"
|
|
|
+ path size taken w h lat lon)
|
|
|
+ (sqlite:last-insert-rowid db)))
|
|
|
+
|
|
|
+(defun db/add-album (db name &optional description cover-id)
|
|
|
+ (sqlite:execute-non-query
|
|
|
+ db "insert into albums (name, description, cover_id) values (?, ?, ?)"
|
|
|
+ name description cover-id)
|
|
|
+ (sqlite:last-insert-rowid db))
|
|
|
+
|
|
|
+(defun db/add-album-photo (db album-id photo-id &optional description idx hidden)
|
|
|
+ (sqlite:execute-non-query
|
|
|
+ db "insert into album_photos (album_id, photo_id, description, idx, hidden) values (?, ?, ?, ?, ?)"
|
|
|
+ album-id photo-id description idx hidden))
|
|
|
+
|
|
|
+(defvar *photo-storage-url* nil "base url for photo storage")
|
|
|
+(defun db-load-album (album-id)
|
|
|
+ (with-db (db)
|
|
|
+ (multiple-value-bind (name cover-id)
|
|
|
+ (sqlite:execute-one-row-m-v db "select name, cover_id from albums where id = ?" album-id)
|
|
|
+ (let ((photos (iter (for (id path title w h)
|
|
|
+ in-sqlite-query "select p.id, p.path, ap.description, p.width, p.height from photos p inner join album_photos ap on ap.photo_id = p.id where ap.album_id = ? order by ap.idx"
|
|
|
+ on-database db
|
|
|
+ with-parameters (album-id))
|
|
|
+ (collect (list (cons :id id)
|
|
|
+ (cons :src (concatenate 'string *photo-storage-url* path))
|
|
|
+ (cons :title title)
|
|
|
+ (cons :w w) (cons :h h))))))
|
|
|
+ (list (cons :title name)
|
|
|
+ (cons :cover (find cover-id photos :key (agetter :id)))
|
|
|
+ (cons :photos photos))))))
|
|
|
+
|
|
|
+(defun db-load-albums ()
|
|
|
+ (with-db (db)
|
|
|
+ (iter (for (id title cover-path cover-w cover-h)
|
|
|
+ in-sqlite-query "select a.id, a.name, c.path, c.width, c.height from albums a inner join photos c on a.cover_id=c.id order by c.taken" on-database db)
|
|
|
+ (collect (list (cons :id id)
|
|
|
+ (cons :title title)
|
|
|
+ (cons :cover (list (cons :src (concatenate 'string
|
|
|
+ *photo-storage-url* cover-path))
|
|
|
+ (cons :w cover-w)
|
|
|
+ (cons :h cover-h))))))))
|
|
|
+
|
|
|
(defun dirname (directory)
|
|
|
(car (last (pathname-directory directory))))
|
|
|
|
|
|
@@ -75,25 +142,52 @@
|
|
|
(delete-duplicates (mapcar #'uiop:pathname-directory-pathname files) :test #'equal))
|
|
|
|
|
|
(defun move-file-to (file dest)
|
|
|
- (uiop:rename-file-overwriting-target
|
|
|
- file (uiop:make-pathname* :defaults file :directory (pathname-directory dest))))
|
|
|
+ (let ((destpath (uiop:make-pathname* :defaults file :directory (pathname-directory dest))))
|
|
|
+ (when (probe-file destpath)
|
|
|
+ (error "File ~S exists" destpath))
|
|
|
+ (uiop:rename-file-overwriting-target file destpath)
|
|
|
+ destpath))
|
|
|
|
|
|
-(defun move-images-with-folders (files dest)
|
|
|
+(defun move-images-with-folders (files dest &optional after-move-func)
|
|
|
(labels ((move (files dest)
|
|
|
(dolist (f files)
|
|
|
- (move-file-to f dest))))
|
|
|
+ (funcall after-move-func (move-file-to f dest)))))
|
|
|
(let ((dirs (directories files)))
|
|
|
+ (unless after-move-func (setf after-move-func #'identity))
|
|
|
(ensure-directories-exist dest)
|
|
|
(move files dest)
|
|
|
- ;; Move all non-image files from original folders if no images left there
|
|
|
+ ;; Move all non-image files from original folders if no images left there.
|
|
|
+ ;; Do not call after-move-func on them
|
|
|
+ (setf after-move-func #'identity)
|
|
|
(dolist (dir dirs)
|
|
|
(unless (other-images dir files)
|
|
|
(move (uiop:directory-files dir) dest)
|
|
|
- (uiop:delete-empty-directory dir))))))
|
|
|
+ (ignore-errors (uiop:delete-empty-directory dir)))))))
|
|
|
+
|
|
|
+(defun import-album (name dest paths)
|
|
|
+ (let (added-photos
|
|
|
+ (files (remove-if-not #'(lambda (p) (uiop:subpathp p *incoming-path*))
|
|
|
+ (mapcar #'probe-file paths))))
|
|
|
+ (when files
|
|
|
+ (with-db (db)
|
|
|
+ (sqlite:with-transaction db
|
|
|
+ (labels ((handle-moved (path)
|
|
|
+ (let ((info (load-photo-info path)))
|
|
|
+ (push (cons (db/add-photo db info) (aget :name info)) added-photos)
|
|
|
+ (log:info "Moved" (aget :path info)))))
|
|
|
+ (move-images-with-folders files dest #'handle-moved)
|
|
|
+ (let ((album-id (db/add-album db name nil (car (middle added-photos)))))
|
|
|
+ (loop for (photo-id . name) in (reverse added-photos)
|
|
|
+ for idx from 1
|
|
|
+ do (db/add-album-photo db album-id photo-id name idx))
|
|
|
+ album-id)))))))
|
|
|
|
|
|
(restas:define-route main ("")
|
|
|
(asdf:system-relative-pathname :photo-store "index.html"))
|
|
|
|
|
|
+(restas:define-route incoming ("incoming/")
|
|
|
+ (asdf:system-relative-pathname :photo-store "incoming.html"))
|
|
|
+
|
|
|
;; Assets file path
|
|
|
(defparameter *assets-path*
|
|
|
(asdf:system-relative-pathname :photo-store "assets/"))
|
|
|
@@ -108,9 +202,18 @@
|
|
|
(json:encode-json-to-string object))
|
|
|
|
|
|
(defvar *incoming-path* nil "Path for incoming photos")
|
|
|
-(restas:define-route incoming ("incoming/"
|
|
|
- :content-type "application/json")
|
|
|
- (json (mapcar 'album-item (load-albums-from-dir *incoming-path*))))
|
|
|
+(restas:define-route api/incoming ("api/incoming/"
|
|
|
+ :content-type "application/json")
|
|
|
+ (json (mapcar #'(lambda (a) (album-item a t)) (load-albums-from-dir *incoming-path*))))
|
|
|
+
|
|
|
+(restas:define-route api/albums ("api/albums/"
|
|
|
+ :content-type "application/json")
|
|
|
+ (json (db-load-albums)))
|
|
|
+
|
|
|
+(restas:define-route api/album ("api/albums/:album-id/"
|
|
|
+ :content-type "application/json")
|
|
|
+ (:sift-variables (album-id 'integer))
|
|
|
+ (json (db-load-album album-id)))
|
|
|
|
|
|
(defvar *photo-storage-path* nil "Destination storage path")
|
|
|
|
