(in-package :quickit)
(defun parse-form-slots (s)
"Parse slots from a url-part of the form name1=value1&name2=value2..."
(if (or (null s) (equal s ""))
nil
(let* ((index0 (if (char= (aref s 0) #\?) 1 0))
(index1 (position #\= s))
(index2 (position #\& s)))
(if index1
(cons (list (subseq s index0 index1)
(urlstring-unescape (subseq s (1+ index1) index2)))
(and index2
(parse-form-slots (subseq s (1+ index2)))))
nil))))
(defvar *demo-url*
(make-url :scheme "http" :host "abstractnonsense.org" :port 8000))
(defvar *listener*
(make-instance 'serve-event-http-listener
:port (url-port *demo-url*)))
(defvar articles nil)
(defvar next-id 0)
(defclass article ()
((description
:initarg :description
:initform ""
:reader article-description)
(url
:initarg :url
:initform (error "Must supply a URL")
:reader article-url)
(score
:initarg :score
:initform 100
:accessor article-score)
(id
:initform (incf next-id)
:reader article-id)))
(defun make-article (description url score)
(make-instance 'article :description description :url url :score score))
(defun print-articles ()
(with-output-to-string (out)
(dolist (article articles out)
(format out "<a href=http://abstractnonsense.org:8000/rankdown?id=~A><img border=0 src=down.png></a> <a href=\"~A\">~A</a> (score ~A)<br>"
(article-id article) (article-url article) (article-description article) (article-score article)))))
(defun first-n-or-less (n sequence)
(subseq sequence 0 (min n (length sequence))))
(defun normalise-articles ()
(setf articles (first-n-or-less 25 (sort articles #'> :key #'article-score))))
(defclass main-handler (handler)
())
(defun print-main-page (request)
(request-send-headers request)
(html-stream
(request-stream request)
`(html (head (title "Quickit"))
(body ((table :width "100%") (tr (td (h1 "Quickit"))
(td "<p class=right><a href=http://abstractnonsense.org:8000/submit>Submit a link</a></p>")))
(p ,(print-articles))))))
(defmethod handle-request-response ((handler main-handler) (method (eql :get)) request)
(print-main-page request))
(defclass submit-handler (handler)
())
(defmethod handle-request-response ((handler submit-handler) method request)
(let* ((url (request-unhandled-part request))
(params (parse-form-slots url))
(description (second (assoc "description" params :test #'equalp)))
(url (second (assoc "url" params :test #'equalp))))
(cond ((or (null url) (equal url ""))
(request-send-headers request)
(html-stream
(request-stream request)
`(html (head (title "Submit link"))
(body (h1 "Submit a link")
((form :method "get")
(p "Description: " ((input :name "description" :type "text" :size "50" :value "")))
(p "URL: " ((input :name "url" :type "text" :size "50" :value "")))
(p ((input :name "Submit" :value "Submit" :type "submit"))))))))
(t
(unless (find url articles :key #'article-url :test #'equalp)
(push (make-article description url 100) articles)
(normalise-articles))
(print-main-page request)))))
(defclass rankdown-handler (handler)
())
(defmethod handle-request-response ((handler rankdown-handler) method request)
(let* ((url (request-unhandled-part request))
(params (parse-form-slots url))
(id (second (assoc "id" params :test #'equalp))))
(let* ((nid (parse-integer id :junk-allowed t))
(article (find nid articles :key #'article-id)))
(when article
(setf (article-score article) (max 0 (1- (article-score article))))
(normalise-articles))
(print-main-page request))))
(defun start-quickit ()
(install-handler (http-listener-handler *listener*)
(make-instance 'main-handler)
(urlstring (merge-url *demo-url* "/main"))
nil)
(install-handler (http-listener-handler *listener*)
(make-instance 'submit-handler)
(urlstring (merge-url *demo-url* "/submit"))
nil)
(install-handler (http-listener-handler *listener*)
(make-instance 'rankdown-handler)
(urlstring (merge-url *demo-url* "/rankdown"))
nil)
(install-handler (http-listener-handler *listener*)
(make-instance 'static-file-handler :pathname ".")
(urlstring *demo-url*) nil)
(start-listening *listener*))
(defun stop-quickit ()
(stop-listening *listener*)
(setf articles nil))