[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Wed Nov 12 04:19:39 UTC 2003
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*)
More information about the Lisppaste-cvs
mailing list