(in-package #:photo-store) (eval-when (:compile-toplevel :load-toplevel :execute) (restas::register-pkgmodule-traits 'photo-store) (restas:reconnect-all-routes)) ;; photos: id | album_id | filename | size | taken | width | height | lat | lon ;; albums: id | parent_id | path | date | name | description | cover_id | accessibility (defun imagep (path) (equal (string-downcase (pathname-type path)) "jpg")) (defun dirname (directory) (car (last (pathname-directory directory)))) (defun guess-album-title (directory photos) (declare (ignore photos)) (dirname 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) (loop for (base-path . base-url) in *path-url-mapping* for rel-path = (uiop:subpathp path base-path) when rel-path do (return (concatenate 'string base-url (namestring rel-path))) finally (error "Can't map path ~S" path))) (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")) ;; Assets file path (defparameter *assets-path* (asdf:system-relative-pathname :photo-store "assets/")) (restas:define-route assets/css ("css/:file" :content-type "text/css") (merge-pathnames file *assets-path*)) (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") (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))