[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
Erik Enge
eenge at common-lisp.net
Mon Nov 10 16:18:24 UTC 2003
Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv5661
Modified Files:
web-server.lisp
Log Message:
updating for araneida 0.80.
Date: Mon Nov 10 11:18:23 2003
Author: eenge
Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.1.1.1 lisppaste2/web-server.lisp:1.2
--- lisppaste2/web-server.lisp:1.1.1.1 Mon Nov 3 12:17:53 2003
+++ lisppaste2/web-server.lisp Mon Nov 10 11:18:23 2003
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $
+;;;; $Id: web-server.lisp,v 1.2 2003/11/10 16:18:23 eenge Exp $
;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -12,122 +12,130 @@
(contents nil :type string)
(universal-time nil :type integer))
-(defun say-handler (request rest)
- (araneida:request-send-headers request)
- (irc:send-irc-message *connection* :privmsg rest (channel *connection*))
- (princ
- (html
- `(html
- (head
- (title "Sent!"))
- (body
- ,(format nil "Your text was sent to ~A!" (channel *connection*)))))))
+(defclass new-paste-handler (araneida:handler) ())
+
+(defclass submit-paste-handler (araneida:handler)
+ ((username
+ :accessor username
+ :initform "")
+ (title
+ :accessor title
+ :initform "")
+ (text
+ :accessor text
+ :initform "")))
-(defun display-handler (request rest)
+(defclass display-paste-handler (araneida:handler) ())
+
+(defmethod araneida:handle-request-response ((handler new-paste-handler) method request)
(araneida:request-send-headers request :expires 0)
- (write-sequence
- (let ((pnumber (parse-integer rest :junk-allowed t)))
- (if (not pnumber)
- (html
- `(html (head (title "Invalid paste number!"))
- (body (h1 ,(format nil "The supplied paste number is not an integer.")))))
- (let ((thepaste (some #'(lambda (e) (and (eql pnumber (paste-number e)) e)) *pastes*)))
- (if (not thepaste)
- (html
- `(html (head (title "Invalid paste number!"))
- (body (h1 ,(format nil "No paste numbered ~A could be found." pnumber)))))
- (html
- `(html (head (title ,(format nil "Paste number ~A" pnumber)))
- (body (h3 ,(format nil "Paste number ~A: ~A" pnumber (encode-for-pre (paste-title thepaste))))
- ,(format nil "Pasted by ~A" (encode-for-pre (paste-user thepaste)))
- (hr)
- ((pre) ,(encode-for-pre (paste-contents thepaste))))))))))
- (araneida:request-stream request)))
-
-(defun new-paste-form ()
- `((form :method post :action ,(araneida:urlstring *new-paste-url*))
- "Enter a username, title, and paste contents into the fields below. If you choose a unique username for your pastes then other users will be able to search for your pastes (not now)."
- (hr)
- "Enter your username: " ((input :type text :name username)) (br)
- "Enter a title: " ((input :type text :name title)) (br)
- "Enter your paste: " (br) ((textarea :rows 24 :cols 80 :name text))
- (br)
- ((input :type submit))
- ((input :type reset))))
-
-#|(defun search-paste-handler (request rest)
- (request-send-headers request :expires 0)
- (write-sequence
- (html
- `(html
- (head (title "Search Pastes"))
- (body
- ,@(let ((username-param (body-param "USERNAME" (request-body request)))
- (title-param (body-param "TITLE" (request-body request)))
- (text-param (body-param "TEXT" (request-body request))))
- (if (not (or username-param title-param text-param))
- `((h1 "Search for pastes")
- `((form :method post :action ,(urlstring *search-paste-url*))
- "Enter one or more of a username, title, or paste contents to search for. The searches are exact substring searches."
- (hr)
- "Search for a username: " ((input :type text :name username)) (br)
- "Search for a title: " ((input :type text :name title)) (br)
- "Search for a paste: " ((input :type text :name text)) (br)
- ((input :type submit))
- ((input :type reset)))))))))))|#
+ (new-paste-form request))
-(defun new-paste-handler (request rest)
+(defun new-paste-form (request &optional (message ""))
+ (araneida:html-stream
+ (araneida:request-stream request)
+ `(html
+ (head (title "Paste"))
+ (body
+ (h1 "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*) ".")
+ (hr)
+ (table
+ (tr
+ (th "Enter your username:")
+ (td ((input :type text :name username))))
+ (tr
+ (th "Enter a title:")
+ (td ((input :type text :name title))))
+ (tr
+ ((th :valign top) "Enter your paste:")
+ (td ((textarea :rows 24 :cols 80 :name text))))
+ (tr
+ ((td :colspan 2) ((input :type submit))))
+ (tr
+ ((td :colspan 2) ((input :type reset))))))))))
+
+(defmethod araneida:handle-request-response ((handler submit-paste-handler) method request)
+ (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request)))
+ (setf (title handler) (araneida:body-param "TITLE" (araneida:request-body request)))
+ (setf (text handler) (araneida:body-param "TEXT" (araneida:request-body request)))
+ (araneida:request-send-headers request)
+
+ (let ((username (username handler))
+ (title (title handler))
+ (text (text handler)))
+ (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-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 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*)))))))))))
+
+(defmethod araneida:handle-request-response ((handler display-paste-handler) method request)
(araneida:request-send-headers request :expires 0)
- (write-sequence
- (html
- `(html
- (head (title "Paste"))
- (body
- ,@(let ((username-param (body-param "USERNAME" (araneida:request-body request)))
- (title-param (body-param "TITLE" (araneida:request-body request)))
- (text-param (body-param "TEXT" (araneida:request-body request))))
- (print 'hi)
- (if (not username-param) ;;; We weren't supplied a paste
- `((h1 "Enter your paste")
- ,(new-paste-form))
- (if (string= username-param "")
- `(((font :color red) "Please enter a valid username!")
- (br)
- (h1 "Enter your paste")
- ,(new-paste-form))
- (if (or (not title-param) (string= title-param ""))
- `(((font :color red) "Please enter a valid title!")
- (h1 "Enter your paste")
- ,(new-paste-form))
- (if (or (not text-param) (string= text-param ""))
- `(((font :color red) "Please enter some text for your paste!")
- (h1 "Enter your paste")
- ,(new-paste-form))
- (progn
- (incf *paste-counter*)
- (push (make-paste :number *paste-counter*
- :user username-param
- :title title-param
- :contents text-param
- :universal-time (get-universal-time)) *pastes*)
- (let ((theurl (urlstring (merge-url *display-paste-url* (prin1-to-string *paste-counter*)))))
- (irc:send-irc-message connection
- :privmsg (format nil "~A pasted ~A at ~A" username-param title-param theurl)
- (channel connection))
- `((h1 "Pasted!")
- "Your paste should be available at " ((a :href ,theurl) ,theurl))))))))))))
- (araneida:request-stream request)))
-
-(araneida:export-server *paste-server*)
-
-(araneida:export-handler *new-paste-url*
- #'new-paste-handler
- :method t :stage :response)
-
-(araneida:export-handler *say-url*
- #'say-handler
- :match :prefix :method t :stage :response)
-
-(araneida:export-handler *display-paste-url*
- #'display-handler
- :match :prefix :method t :stage :response)
+ ; XXX request-unhandled-part will be exported in 0.81
+ (let* ((paste-number (parse-integer
+ (araneida::request-unhandled-part request)
+ :junk-allowed t))
+ (paste (some #'(lambda (element)
+ (and (eql paste-number (paste-number element))
+ element)) *pastes*)))
+ (if paste
+ (araneida:html-stream
+ (araneida:request-stream request)
+ `(html
+ (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))))))
+ (araneida:html-stream
+ (araneida:request-stream request)
+ `(html
+ (head
+ (title "Invalid paste number" ,paste-number))
+ (body
+ (h1 "No paste numberd " ,paste-number "could be found.")))))))
+
+(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 'submit-paste-handler)
+ (araneida:urlstring *submit-paste-url*) t)
+
+(araneida:install-handler
+ (araneida:http-listener-handler *paste-listener*)
+ (make-instance 'display-paste-handler)
+ (araneida:urlstring *display-paste-url*) nil)
+
More information about the Lisppaste-cvs
mailing list