Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv6666
Modified Files: variable.lisp web-server.lisp Log Message: Added paste annotations and paste lister. Prettified HTML output for paste display and list. Added line of links to the bottom of all pages.
Date: Tue Nov 11 23:19:38 2003 Author: bmastenbrook
Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.3 lisppaste2/variable.lisp:1.4 --- lisppaste2/variable.lisp:1.3 Mon Nov 10 11:18:39 2003 +++ lisppaste2/variable.lisp Tue Nov 11 23:19:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.3 2003/11/10 16:18:39 eenge Exp $ +;;;; $Id: variable.lisp,v 1.4 2003/11/12 04:19:38 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -6,9 +6,9 @@ (in-package :lisppaste)
(defparameter *internal-http-port* 8081 - "Port lisppaste will listen on for WWW requests.") -(defparameter *external-http-port* 80 - "Port lisppaste will listen on for WWW requests.") + "Port lisppaste's araneida will listen on for requests from Apache.") +(defparameter *external-http-port* 8081 + "Port lisppaste's araneida will listen on for requests from remote clients.")
(defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") @@ -17,18 +17,22 @@ (araneida:merge-url (araneida:make-url :scheme "http" :host *paste-site-name* - :port *external-http-port*) "/paste/")) + :port *internal-http-port*) "/paste/"))
(defparameter *paste-external-url* (araneida:merge-url (araneida:make-url :scheme "http" - :host *paste-site-name*) "/paste/")) + :host *paste-site-name* + :port *external-http-port*) "/paste/"))
(defparameter *display-paste-url* (araneida:merge-url *paste-external-url* "display/"))
(defparameter *new-paste-url* (araneida:merge-url *paste-external-url* "new")) + +(defparameter *list-paste-url* + (araneida:merge-url *paste-external-url* "list"))
(defparameter *submit-paste-url* (araneida:merge-url *paste-external-url* "submit"))
Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.8 lisppaste2/web-server.lisp:1.9 --- lisppaste2/web-server.lisp:1.8 Tue Nov 11 09:55:37 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 23:19:38 2003 @@ -1,47 +1,90 @@ -;;;; $Id: web-server.lisp,v 1.8 2003/11/11 14:55:37 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.9 2003/11/12 04:19:38 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information.
(in-package :lisppaste)
-(defstruct (paste (:conc-name paste-)) +(defstruct paste (number nil :type integer) (user nil :type string) (title nil :type string) (contents nil :type string) - (universal-time nil :type integer)) + (universal-time nil :type integer) + (is-annotation nil :type boolean) + (annotations nil :type list) + (annotation-counter 0 :type integer))
(defclass new-paste-handler (araneida:handler) ())
-(defclass submit-paste-handler (araneida:handler) - ((username - :accessor username - :initform "") - (title - :accessor title - :initform "") - (text - :accessor text - :initform ""))) +(defclass list-paste-handler (araneida:handler) ()) + +(defclass submit-paste-handler (araneida:handler) ())
(defclass display-paste-handler (araneida:handler) ())
(defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (araneida:request-send-headers request :expires 0) - (new-paste-form request)) + (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request))) + (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t))) + (annotate (if annotate-number (find annotate-number *pastes* :key #'paste-number)))) + (new-paste-form request :annotate annotate))) + +(defun bottom-links () + `((hr) + ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") + " | " + ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes") + " | " + ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page"))) + +(defun time-delta (time) + (let ((delta (- (get-universal-time) time))) + (cond + ((< delta 1) "<Doc Brown>From the <i>future</i>...</Doc Brown>") + ((< delta 60) (format nil "~D seconds ago" delta)) + ((< delta (* 60 60)) (format nil "~D minutes ago" (floor delta 60))) + ((< delta (* 60 60 24)) (format nil "~D hours ago" (floor delta (* 60 60)))) + ((< delta (* 60 60 24 7)) (format nil "~D days ago" (floor delta (* 60 60 24)))) + ((< delta (* 60 60 24 7 487/16)) (format nil "~D weeks ago" (floor delta (* 60 60 24 7)))) + ((< delta (* 60 60 24 7 487/16 12)) (format nil "~D months ago" (floor delta (* 60 60 24 7 487/16)))) + (t (format nil "~D years ago" (floor delta (* 60 60 24 7 (+ 365 1/4))))))))
-(defun new-paste-form (request &optional (message "")) +(defmethod araneida:handle-request-response ((handler list-paste-handler) method request) + (araneida:request-send-headers request :expires 0) (araneida:html-stream (araneida:request-stream request) `(html - (head (title "Paste")) + (head (title "All pastes")) (body - (h1 "Enter your paste") + (center (h2 "All pastes in system")) + ((table :width "100%" :cellpadding 2) + (tr (td) (td "By") (td "When") (td "Titled") (td "Ann.")) + ,@(reverse (mapcar #'(lambda (paste) + `(tr ((td :nowrap) ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) + ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) + ((td :nowrap) ,(encode-for-pre (paste-user paste))) + ((td :nowrap) ,(time-delta (paste-universal-time paste))) + ((td :width "100%" :bgcolor "#F4F4F4" :nowrap) ,(encode-for-pre (paste-title paste))) + ((td :nowrap) ,(length (paste-annotations paste))))) + *pastes*))) + ,@(bottom-links))))) + +(defun new-paste-form (request &key (message "") (annotate nil)) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title ,(if annotate "Annotate" "Paste"))) + (body + (h1 ,(if annotate "Enter your annotation" "Enter your paste")) ((font :color red) (h2 ,message)) ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) (p "Enter a username, title, and paste contents into the fields below. The -paste will appear on " ,*channel* " @ " ,(irc:server-name *connection*) ".") +paste will be announced on " ,*channel* " @ " ,(irc:server-name *connection*) ".") + ,@(if annotate + `((p "This paste will be used to annotate " + ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))))) (hr) (table (tr @@ -55,47 +98,57 @@ (td ((textarea :rows 24 :cols 80 :name "text")))) (tr ((th) "Submit your paste:") - ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))))))) + ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) + ,@(bottom-links)))))
(defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (setf (username handler) (araneida:body-param "username" (araneida:request-body request)) - (title handler) (araneida:body-param "title" (araneida:request-body request)) - (text handler) (araneida:body-param "text" (araneida:request-body request))) - (araneida:request-send-headers request) - - (with-slots (username title text) handler + (let ((username (araneida:body-param "username" (araneida:request-body request))) + (title (araneida:body-param "title" (araneida:request-body request))) + (text (araneida:body-param "text" (araneida:request-body request))) + (annotate (araneida:body-param "annotate" (araneida:request-body request)))) + (araneida:request-send-headers request) + (cond - ((zerop (length username)) - (new-paste-form request "Please enter your username.")) - ((zerop (length title)) - (new-paste-form request "Please enter a title.")) - ((zerop (length text)) - (new-paste-form request "Please enter your paste.")) - (t - (progn - (incf *paste-counter*) - (let ((url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) - (external-url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) - (paste (make-paste :number *paste-counter* - :user username - :title title - :contents text - :universal-time (get-universal-time)))) - (irc:privmsg *connection* *channel* - (format nil "~A pasted ~A at ~A" username title external-url)) - (push paste *pastes*) - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title "Paste number " ,*paste-counter*)) - (body - (h1 "Pasted!") - (p "Your paste should be available at " ((a :href ,url) ,url) ", and -was also sent to " ,*channel* " @ " ,(irc:server-name *connection*))))))))))) + ((zerop (length username)) + (new-paste-form request :message "Please enter your username.")) + ((zerop (length title)) + (new-paste-form request :message "Please enter a title.")) + ((zerop (length text)) + (new-paste-form request :message "Please enter your paste.")) + ((and annotate (not (parse-integer annotate :junk-allowed t))) + (new-paste-form request :message "Malformed annotation request.")) + (t + + (let* ((paste-number (if annotate (parse-integer annotate :junk-allowed t) (incf *paste-counter*))) + (paste-to-annotate (if annotate (find paste-number *pastes* :key #'paste-number))) + (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))) + (let ((url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (if annotate + (concatenate 'string (prin1-to-string paste-number) + "#" + (prin1-to-string annotation-number)) + (prin1-to-string paste-number))))) + (paste (make-paste :number (if annotate annotation-number paste-number) + :user username + :title title + :contents text + :universal-time (get-universal-time)))) + (irc:privmsg *connection* *channel* + (if annotate + (format nil "~A annotated #~A with ~A at ~A" username paste-number title url) + (format nil "~A pasted ~A at ~A" username title url))) + (if annotate + (push paste (paste-annotations paste-to-annotate)) + (push paste *pastes*)) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*)) + (body + (h1 "Pasted!") + (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,*channel* " @ " ,(irc:server-name *connection*)) + ,@(bottom-links))))))))))
(defmethod araneida:handle-request-response ((handler display-paste-handler) method request) (araneida:request-send-headers request :expires 0) @@ -113,22 +166,61 @@ (head (title "Paste number " ,paste-number)) (body - (h2 "Paste number " ,paste-number ": " ,(encode-for-pre (paste-title paste))) - (p "Pasted by: " ,(encode-for-pre (paste-user paste))) - (hr) - (pre ,(encode-for-pre (paste-contents paste)))))) + ((table :width "100%" :cellpadding 2) + (tr ((td :align "left" :nowrap) "Paste number " ,paste-number ": ") + ((td :width "100%") (b ,(encode-for-pre (paste-title paste))))) + (tr ((td :align "left" :nowrap) "Pasted by: ") + ((td :width "100%") ,(encode-for-pre (paste-user paste)))) + (tr (td) + ((td :width "100%") ,(time-delta (paste-universal-time paste)))) + (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:") + (td)) + (tr (td (p))) + (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (pre ,(encode-for-pre (paste-contents paste))))) + ,@(if (paste-annotations paste) + `((tr (td (p)) (td)) + (tr ((th :align "left" :colspan 2) "Annotations for this paste: ")) + ,@(reduce #'append + (mapcar #'(lambda (a) + `((tr (td (p)) (td)) + (tr + (td ((a :name ,(prin1-to-string (paste-number a)))"Annotation title:")) + (td ,(encode-for-pre (paste-title a)))) + (tr + (td "Annotated by:") + (td ,(encode-for-pre (paste-user a)))) + (tr + (td) + (td ,(time-delta (paste-universal-time a)))) + (tr + ((td :valign "top" :nowrap) "Annotation contents:") + ((td :bgcolor "#F4F4F4" :width "100%") (pre ,(encode-for-pre (paste-contents a))))))) + (paste-annotations paste)))) + `((tr (td (p)) (td)) + (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations."))))) + (p) + ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste)))) + (center ((input :type submit :value "Annotate this paste")))) + ,@(bottom-links)))) (araneida:html-stream (araneida:request-stream request) `(html (head (title "Invalid paste number" ,paste-number)) (body - (h3 "No paste numbered " ,paste-number " could be found."))))))) + (h3 "No paste numbered " ,paste-number " could be found.") + ,@(bottom-links)))))))
(araneida:install-handler (araneida:http-listener-handler *paste-listener*) (make-instance 'new-paste-handler) (araneida:urlstring *new-paste-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'list-paste-handler) + (araneida:urlstring *list-paste-url*) t)
(araneida:install-handler (araneida:http-listener-handler *paste-listener*)