|
|
@@ -8,20 +8,40 @@
|
|
|
;; photos: id | album_id | filename | size | taken | width | height | lat | lon
|
|
|
;; albums: id | parent_id | path | date | name | description | cover_id | accessibility
|
|
|
|
|
|
-(defstruct photo url title width height)
|
|
|
+(defun imagep (path)
|
|
|
+ (equal (string-downcase (pathname-type path)) "jpg"))
|
|
|
|
|
|
+(defun dirname (directory)
|
|
|
+ (car (last (pathname-directory directory))))
|
|
|
|
|
|
-(defun load-photo (path)
|
|
|
- (let ((info (load-photo-info path)))
|
|
|
- (make-photo :url (map-path path)
|
|
|
- :title (aget :name info)
|
|
|
- :width (first (aget :dim info))
|
|
|
- :height (second (aget :dim info)))))
|
|
|
+(defun guess-album-title (directory photos)
|
|
|
+ (declare (ignore photos))
|
|
|
+ (dirname directory))
|
|
|
|
|
|
-(defun load-photos-from-dir (directory)
|
|
|
- (mapcar 'load-photo (remove-if-not #'(lambda (p)
|
|
|
- (equal (string-downcase (pathname-type p)) "jpg"))
|
|
|
- (uiop:directory-files directory))))
|
|
|
+(defvar *album-path-format*
|
|
|
+ '(:year "/" :year "-" (:month 2) "-" (:day 2) "-" :name "/"))
|
|
|
+
|
|
|
+(defun guess-album-path (directory photos)
|
|
|
+ (let ((from (reduce #'local-time:timestamp-minimum photos :key (agetter :created-at)))
|
|
|
+ (format (sublis `((:name . ,(dirname directory)))
|
|
|
+ *album-path-format*)))
|
|
|
+ (local-time:format-timestring nil from :format format)))
|
|
|
+
|
|
|
+(defun middle (seq)
|
|
|
+ (elt seq (/ (length seq) 2)))
|
|
|
+
|
|
|
+(defun load-album (directory)
|
|
|
+ (let ((photos (mapcar 'load-photo-info (remove-if-not 'imagep (uiop:directory-files directory)))))
|
|
|
+ (when photos
|
|
|
+ (list (cons :title (guess-album-title directory photos))
|
|
|
+ (cons :path (guess-album-path directory photos))
|
|
|
+ (cons :cover (middle photos))
|
|
|
+ (cons :photos 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)))))
|
|
|
|
|
|
(defvar *path-url-mapping* nil "alist of path-2-url mapping")
|
|
|
(defun map-path (path)
|
|
|
@@ -30,13 +50,17 @@
|
|
|
when rel-path do (return (concatenate 'string base-url (namestring rel-path)))
|
|
|
finally (error "Can't map path ~S" path)))
|
|
|
|
|
|
-(defmethod yason:encode ((photo photo) &optional (stream *standard-output*))
|
|
|
- (yason:with-output (stream)
|
|
|
- (yason:with-object ()
|
|
|
- (yason:encode-object-element "src" (photo-url photo))
|
|
|
- (yason:encode-object-element "w" (photo-width photo))
|
|
|
- (yason:encode-object-element "h" (photo-height photo))
|
|
|
- (yason:encode-object-element "title" (photo-title photo)))))
|
|
|
+(defun photo-item (info)
|
|
|
+ `((:src . ,(map-path (aget :path info)))
|
|
|
+ (:title . ,(aget :name info))
|
|
|
+ (:w . ,(first (aget :dim info)))
|
|
|
+ (:h . ,(second (aget :dim info)))))
|
|
|
+
|
|
|
+(defun album-item (album)
|
|
|
+ `((:title . ,(aget :title album))
|
|
|
+ (:cover . ,(photo-item (aget :cover album)))
|
|
|
+ (:path . ,(namestring (aget :path album)))
|
|
|
+ (:photos . ,(mapcar 'photo-item (aget :photos album)))))
|
|
|
|
|
|
(restas:define-route main ("")
|
|
|
(asdf:system-relative-pathname :photo-store "index.html"))
|
|
|
@@ -51,15 +75,13 @@
|
|
|
(restas:define-route assets/js ("js/:file" :content-type "application/x-javascript")
|
|
|
(merge-pathnames file *assets-path*))
|
|
|
|
|
|
+(defun json (object)
|
|
|
+ (json:encode-json-to-string object))
|
|
|
|
|
|
(defvar *incoming-path* nil "Path for incoming photos")
|
|
|
(restas:define-route incoming ("incoming/"
|
|
|
:content-type "application/json")
|
|
|
- (with-output-to-string (stream)
|
|
|
- (yason:encode
|
|
|
- (loop for subdir in (uiop:subdirectories *incoming-path*)
|
|
|
- append (load-photos-from-dir subdir))
|
|
|
- stream)))
|
|
|
+ (json (mapcar 'album-item (load-albums-from-dir *incoming-path*))))
|
|
|
|
|
|
(defun start (&key (address "0.0.0.0") (port 8800))
|
|
|
(restas:start '#:photo-store :address address :port port))
|