(defpackage :music
(:use :common-lisp :cl-who :hunchentoot)
(:export #:start-music-server #:stop-music-server #:insert-sample-data)
(:documentation "A simple music database with a web interface."))
(in-package :music)
(defvar *music-database-directory* "/tmp/music/")
(defun open-database ()
"Open the music database in DB-ROOT"
(ele:open-store (list :BDB *music-database-directory*)))
(defun close-database ()
(ele:close-store))
(defun %albums ()
(or (ele:get-from-root :albums)
(ele:add-to-root :albums (ele:make-btree))))
(defclass album ()
((id :type integer :reader id :initarg :id)
(title :type (or string null) :initarg :title :accessor title)
(artist :type (or string null) :initarg :artist :accessor artist)
(year :type (integer 0) :initarg :year :accessor year)
(genre :type genre :initarg :genre :accessor genre))
(:metaclass ele:persistent-metaclass))
(defmethod initialize-instance :around ((instance album) &rest keys &key genre id)
(unless id
(unless (ele:get-from-root :album-index)
(ele:add-to-root :album-index 0))
(setf id (ele:add-to-root :album-index (1+ (ele:get-from-root :album-index)))
keys (list* :id id keys)))
(etypecase genre
(genre (apply #'call-next-method instance keys))
(string
(remf keys :genre)
(apply #'call-next-method instance :genre (or (find-genre genre)
(find-genre "rock"))
keys))))
(defun insert-album (&key title artist year genre)
(let ((album (make-instance 'album :title title :artist artist :year year :genre genre)))
(setf (ele:get-value (id album) (%albums)) album)
album))
(defun find-album (&key title artist year genre)
(let ((results '()))
(etypecase genre
((or null genre) t)
(string (setf genre (find-genre genre))))
(ele:map-btree (lambda (id album)
(declare (ignore id))
(when (and (or (null title) (string= "" title) (string= title (title album)))
(or (null artist) (string= "" artist) (string= artist (artist album)))
(or (null year) (= year (year album)))
(or (null genre) (eql genre (genre album))))
(push album results)))
(%albums))
results))
(defun find-album-by-id (id)
(ele:get-value id (%albums)))
(defclass genre ()
((description :type string :initarg :description :accessor description))
(:metaclass ele:persistent-metaclass))
(defun %genres ()
(or (ele:get-from-root :genres)
(ele:add-to-root :genres (ele:make-btree))))
(defun find-genre (name)
(ele:get-value name (%genres)))
(defun insert-genre (name)
(setf (ele:get-value name (%genres)) (make-instance 'genre :description name)))
(setq *dispatch-table* (list 'dispatch-easy-handlers 'default-dispatcher))
(defvar *music-server* nil)
(defun start-music-server ()
(open-database)
(setf *music-server* (start-server :port 8080 :name 'music-server)
hunchentoot:*show-lisp-errors-p* t
hunchentoot:*show-lisp-backtraces-p* t))
(defun stop-music-server ()
(close-database)
(stop-server *music-server*))
(defun insert-sample-data ()
(insert-genre "rock")
(insert-genre "jazz")
(insert-genre "alternative")
(insert-album :title "Dark Side of the Moon"
:artist "Pink Floyd"
:year 1973
:genre "rock")
(insert-album :title "Hotel California"
:artist "The Eagles"
:year 1976
:genre "rock")
(insert-album :title "A Love Supreme"
:artist "John Coltrane"
:year 1964
:genre "jazz")
(insert-album :title "Kind of Blue"
:artist "Miles Davis"
:year 1959
:genre "jazz")
(insert-album :title "Doolittle"
:artist "Pixies"
:year 1989
:genre "alternative"))
(defmacro standard-page ((&key title) &body body)
`(with-html-output-to-string (*standard-output* nil :indent t)
(:html :xmlns "http://www.w3.org/1999/xhtml"
(:head
(:title ,title)
(:link :type "text/css" :rel "stylesheet" :href "/style.css")
(:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8"))
(:body
(:h1 ,title)
,@body))))
(define-easy-handler (music-listing :uri "/list")
(title artist year genre)
(when (stringp year)
(setf year (parse-integer year :junk-allowed t)))
(when (stringp genre)
(setf genre (find-genre genre)))
(let ((albums (sort (find-album :title title :artist artist :year year :genre genre)
#'string< :key #'title)))
(standard-page (:title "Album Listing")
(htm
(:table
(:tr
(:th "Title")
(:th "Artist")
(:th "Year")
(:th "Genre")
(:th))
(dolist (album albums)
(htm (:tr (:td (fmt (title album)))
(:td (fmt (artist album)))
(:td (fmt (princ-to-string (year album))))
(:td (fmt (description (genre album))))
(:td (:a :href (format nil "edit?id=~D" (id album)) "Edit")))))
(:form :action "list"
(:tr
(:td (:input :type "text" :name "title" :size 20))
(:td (:input :type "text" :name "artist" :size 20))
(:td (:input :type "text" :name "year" :size 6))
(:td (:input :type "text" :name "genre" :size 10))
(:td (:input :type "submit" :value "Search")))))
))))
(define-easy-handler (edit-entry :uri "/edit")
(id title artist year genre)
(standard-page (:title "Edit Album")
(let ((album (find-album-by-id (parse-integer id :junk-allowed t))))
(when title (setf (title album) title))
(when artist (setf (artist album) artist))
(when year (setf (year album) (parse-integer year)))
(when genre (setf (genre album) (find-genre genre)))
(htm
(:form :action "edit"
(:input :type "hidden" :name "id" :value id)
(:table
(:tr
(:td "Title") (:td (:input :type "text" :name "title" :value (title album))))
(:tr
(:td "Artist") (:td (:input :type "text" :name "artist" :value (artist album))))
(:tr
(:td "Year") (:td (:input :type "text" :name "year" :value (year album))))
(:tr
(:td "Genre")
(:td (:select :name "genre"
(ele:map-btree (lambda (name genre)
(htm (:option :selected (if (eql (genre album) genre)
t
nil)
:value name (fmt name))))
(%genres)))))
(:tr
(:td :colspan 2
(:input :type "submit" :value "Save Changes")))))
(:p (:a :href "list" "Done."))))))