[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Mon Apr 26 16:45:14 UTC 2004


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	web-server.lisp 
Log Message:
Commit whatever's lying around on disk

Date: Mon Apr 26 12:45:08 2004
Author: bmastenbrook

Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.44 lisppaste2/web-server.lisp:1.45
--- lisppaste2/web-server.lisp:1.44	Wed Mar 31 16:33:07 2004
+++ lisppaste2/web-server.lisp	Mon Apr 26 12:45:02 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.44 2004/03/31 21:33:07 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.45 2004/04/26 16:45:02 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -31,7 +31,6 @@
 (defclass syndication-handler (araneida:handler) ())
 
 (defmethod araneida:handle-request-response ((handler new-paste-handler) method request)
-  (araneida:request-send-headers request :expires 0)
   (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)))
@@ -39,8 +38,32 @@
 				   (list
 				    (substitute #\# #\/ (araneida::request-unhandled-part request) :test #'char=)
 				    (concatenate 'string "#"
-						 (araneida:request-cookie request "CHANNEL"))))))
-    (new-paste-form request :annotate annotate :default-channel default-channel)))
+						 (araneida:request-cookie request "CHANNEL"))
+				    (and (eql method :post)
+					 (araneida:body-param "channel"
+							      (araneida:request-body request)))))))
+    (cond
+     ((and default-channel (find default-channel *channels* :test #'string=))
+       (araneida:request-send-headers request :expires 0 :set-cookie (format nil "CHANNEL=~A; path=/" (subseq default-channel 1)))
+       (new-paste-form request :annotate annotate :default-channel default-channel))
+     (t (araneida:request-send-headers request :expires 0)
+	(araneida:html-stream
+	 (araneida:request-stream request)
+	 `(html
+	   (head
+	    (title "Select a channel")
+	    ,(rss-link-header))
+	   (body
+	    (h2 "Select a channel")
+	    ((form :method post :action ,(araneida:urlstring *new-paste-url*))
+	     "Please select a channel to lisppaste to: "
+	     ((select :name "channel")
+	      ((option :value ""))
+	      ,@(mapcar #'(lambda (e)
+			    `((option :value ,e)
+			      ,(encode-for-pre e))) *channels*))
+	     ((input :type submit :value "Submit")))
+	    ,@(bottom-links))))))))
 
 (defun bottom-links ()
   `((hr)
@@ -205,7 +228,7 @@
         ,@(bottom-links))))))
 
 (defun handle-rss-request (request &key full)
-  (araneida:request-send-headers request :expires 0)
+  (araneida:request-send-headers request :expires 0 :content-type "application/rss+xml")
   (format (araneida:request-stream request) "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>~C~C" #\Return #\Linefeed)
   (let ((discriminate-channel (if (not (string= (araneida::request-unhandled-part request) ""))
                                   (substitute #\# #\? (araneida::request-unhandled-part request)
@@ -242,10 +265,13 @@
                                                 (paste-annotations paste))))))
                                         (format nil "Paste to channel ~A with ~A annotations." (encode-for-pre (paste-channel paste)) (length (paste-annotations paste))))
                                     #\Return #\Linefeed))
-                        (if discriminate-channel
-                            (remove discriminate-channel *pastes* :test-not #'string-equal
-                                    :key #'paste-channel)
-                            *pastes*))
+			(loop
+			 for paste in
+			 (if discriminate-channel
+			     (remove discriminate-channel *pastes* :test-not #'string-equal
+				     :key #'paste-channel)
+			   *pastes*) for j from 1 to 20
+			   collect paste))
                 #\Return #\Linefeed)))))
 
 (defmethod araneida:handle-request-response ((handler rss-handler) method request)
@@ -278,10 +304,11 @@
               `((tr
                  (th "Select a channel:")
                  (td ((select :name "channel")
-                              ,@(mapcar #'(lambda (e)
-                                            `((option :value ,e ,@(if (string-equal e default-channel)
-                                                                      '(:selected)))
-                                              ,(encode-for-pre e))) *channels*))))))
+		      (option :value "")
+		      ,@(mapcar #'(lambda (e)
+				    `((option :value ,e ,@(if (string-equal e default-channel)
+							      '(:selected)))
+				      ,(encode-for-pre e))) *channels*))))))
         (tr
          (th "Enter your username:")
          (td ((input :type text :name "username"))))
@@ -302,10 +329,13 @@
         (text (araneida:body-param "text" (araneida:request-body request)))
         (annotate (araneida:body-param "annotate" (araneida:request-body request)))
         (channel (araneida:body-param "channel" (araneida:request-body request))))
-    (araneida:request-send-headers request :expires 0
-				   :set-cookie (format nil "CHANNEL=~A; path=/" (subseq channel 1)))
-    
+    (if (> (length channel) 1)
+	(araneida:request-send-headers request :expires 0
+				       :set-cookie (format nil "CHANNEL=~A; path=/" (subseq channel 1)))
+      (araneida:request-send-headers request :expires 0))
     (cond
+     ((zerop (length channel))
+      (new-paste-form request :message "Please select a channel." :default-channel channel))
      ((zerop (length username))
       (new-paste-form request :message "Please enter your username." :default-channel channel))
      ((zerop (length title))
@@ -315,7 +345,7 @@
      ((and annotate (not (parse-integer annotate :junk-allowed t)))
       (new-paste-form request :message "Malformed annotation request." :default-channel channel))
      ((not (member channel *channels* :test #'string-equal))
-      (new-paste-form request :message "Whatever channel that is, I don't know about it." :default channel))
+      (new-paste-form request :message "Whatever channel that is, I don't know about it." :default-channel channel))
      (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)))





More information about the Lisppaste-cvs mailing list