|
@@ -51,18 +51,20 @@
|
|
|
(defun db-load-album (album-id)
|
|
(defun db-load-album (album-id)
|
|
|
(with-db (db)
|
|
(with-db (db)
|
|
|
(multiple-value-bind (name cover-id)
|
|
(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))))))
|
|
|
|
|
|
|
+ (sqlite:execute-one-row-m-v db "select id, name, cover_id from albums where id = ?" album-id)
|
|
|
|
|
+ (when name
|
|
|
|
|
+ (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 :id album-id)
|
|
|
|
|
+ (cons :title name)
|
|
|
|
|
+ (cons :cover (find cover-id photos :key (agetter :id)))
|
|
|
|
|
+ (cons :photos photos)))))))
|
|
|
|
|
|
|
|
(defun db-load-albums ()
|
|
(defun db-load-albums ()
|
|
|
(with-db (db)
|
|
(with-db (db)
|
|
@@ -92,7 +94,7 @@
|
|
|
(local-time:format-timestring nil from :format format)))
|
|
(local-time:format-timestring nil from :format format)))
|
|
|
|
|
|
|
|
(defun middle (seq)
|
|
(defun middle (seq)
|
|
|
- (elt seq (/ (length seq) 2)))
|
|
|
|
|
|
|
+ (elt seq (floor (length seq) 2)))
|
|
|
|
|
|
|
|
(defun imagep (path)
|
|
(defun imagep (path)
|
|
|
(equal (string-downcase (pathname-type path)) "jpg"))
|
|
(equal (string-downcase (pathname-type path)) "jpg"))
|
|
@@ -100,18 +102,25 @@
|
|
|
(defun directory-images (directory)
|
|
(defun directory-images (directory)
|
|
|
(remove-if-not 'imagep (uiop:directory-files directory)))
|
|
(remove-if-not 'imagep (uiop:directory-files directory)))
|
|
|
|
|
|
|
|
|
|
+(defun photo-item (info)
|
|
|
|
|
+ `((:src . ,(map-path (aget :path info)))
|
|
|
|
|
+ (:path . ,(namestring (aget :path info)))
|
|
|
|
|
+ (:title . ,(aget :name info))
|
|
|
|
|
+ (:w . ,(first (aget :dim info)))
|
|
|
|
|
+ (:h . ,(second (aget :dim info)))))
|
|
|
|
|
+
|
|
|
(defun load-album (directory)
|
|
(defun load-album (directory)
|
|
|
(let ((photos (mapcar 'load-photo-info (directory-images directory))))
|
|
(let ((photos (mapcar 'load-photo-info (directory-images directory))))
|
|
|
(when photos
|
|
(when photos
|
|
|
- (list (cons :title (guess-album-title directory photos))
|
|
|
|
|
- (cons :path directory)
|
|
|
|
|
- (cons :cover (middle photos))
|
|
|
|
|
- (cons :photos photos)))))
|
|
|
|
|
|
|
+ `((:title . ,(guess-album-title directory photos))
|
|
|
|
|
+ (:cover . ,(photo-item (middle photos)))
|
|
|
|
|
+ (:dest . ,(guess-album-path directory photos))
|
|
|
|
|
+ (:photos . ,(mapcar 'photo-item photos))))))
|
|
|
|
|
|
|
|
-(defun load-albums-from-dir (directory)
|
|
|
|
|
- (remove-if #'null (list* (load-album directory)
|
|
|
|
|
- (loop for subdir in (uiop:subdirectories directory)
|
|
|
|
|
- append (load-albums-from-dir subdir)))))
|
|
|
|
|
|
|
+(defun fs-load-albums (directory)
|
|
|
|
|
+ (delete nil (list* (load-album directory)
|
|
|
|
|
+ (loop for subdir in (uiop:subdirectories directory)
|
|
|
|
|
+ append (fs-load-albums subdir)))))
|
|
|
|
|
|
|
|
(defvar *path-url-mapping* nil "alist of path-2-url mapping")
|
|
(defvar *path-url-mapping* nil "alist of path-2-url mapping")
|
|
|
(defun map-path (path)
|
|
(defun map-path (path)
|
|
@@ -120,20 +129,6 @@
|
|
|
when rel-path do (return (concatenate 'string base-url (namestring rel-path)))
|
|
when rel-path do (return (concatenate 'string base-url (namestring rel-path)))
|
|
|
finally (error "Can't map path ~S" path)))
|
|
finally (error "Can't map path ~S" path)))
|
|
|
|
|
|
|
|
-(defun photo-item (info &optional incoming)
|
|
|
|
|
- `((:src . ,(map-path (aget :path info)))
|
|
|
|
|
- ,@(when incoming (list (cons :path (namestring (aget :path info)))))
|
|
|
|
|
- (:w . ,(first (aget :dim info)))
|
|
|
|
|
- (:h . ,(second (aget :dim info)))))
|
|
|
|
|
-
|
|
|
|
|
-(defun album-item (album &optional incoming)
|
|
|
|
|
- `((:title . ,(aget :title album))
|
|
|
|
|
- (:cover . ,(photo-item (aget :cover album)))
|
|
|
|
|
- ,@(when incoming (list (cons :path (namestring (aget :path album)))
|
|
|
|
|
- (cons :dest (guess-album-path (aget :path album)
|
|
|
|
|
- (aget :photos album)))))
|
|
|
|
|
- (:photos . ,(mapcar #'(lambda (p) (photo-item p incoming)) (aget :photos album)))))
|
|
|
|
|
-
|
|
|
|
|
(defun other-images (directory images)
|
|
(defun other-images (directory images)
|
|
|
(remove-if #'(lambda (img) (member img images :test #'equal))
|
|
(remove-if #'(lambda (img) (member img images :test #'equal))
|
|
|
(directory-images directory)))
|
|
(directory-images directory)))
|
|
@@ -204,7 +199,19 @@
|
|
|
(defvar *incoming-path* nil "Path for incoming photos")
|
|
(defvar *incoming-path* nil "Path for incoming photos")
|
|
|
(restas:define-route api/incoming ("api/incoming/"
|
|
(restas:define-route api/incoming ("api/incoming/"
|
|
|
:content-type "application/json")
|
|
:content-type "application/json")
|
|
|
- (json (mapcar #'(lambda (a) (album-item a t)) (load-albums-from-dir *incoming-path*))))
|
|
|
|
|
|
|
+ (json (fs-load-albums *incoming-path*)))
|
|
|
|
|
+
|
|
|
|
|
+(restas:define-route api/incoming-import ("api/incoming/import/"
|
|
|
|
|
+ :method :post
|
|
|
|
|
+ :content-type "application/json")
|
|
|
|
|
+ (let* ((album (json:decode-json-from-string (hunchentoot:raw-post-data :external-format :utf-8)))
|
|
|
|
|
+ (name (aget :name album))
|
|
|
|
|
+ (dest (aget :dest album))
|
|
|
|
|
+ (paths (aget :paths album)))
|
|
|
|
|
+ (if (uiop:relative-pathname-p dest)
|
|
|
|
|
+ (let ((new-id (import-album name (uiop:merge-pathnames* dest *photo-storage-path*) paths)))
|
|
|
|
|
+ (json (db-load-album new-id)))
|
|
|
|
|
+ 400)))
|
|
|
|
|
|
|
|
(restas:define-route api/albums ("api/albums/"
|
|
(restas:define-route api/albums ("api/albums/"
|
|
|
:content-type "application/json")
|
|
:content-type "application/json")
|