From c8b60bee86b626724c6ae69ad8a7cc156f72b68f Mon Sep 17 00:00:00 2001
From: Sven <Sven@wiki.c3d2.de/w>
Date: Wed, 4 Jan 2006 16:19:10 +0000
Subject: [PATCH] code reingepasted

---
 Lisp-Geekend.mw | 102 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)

diff --git a/Lisp-Geekend.mw b/Lisp-Geekend.mw
index 8b6e6783..5c468ccf 100644
--- a/Lisp-Geekend.mw
+++ b/Lisp-Geekend.mw
@@ -18,3 +18,105 @@
 
 * Webprogrammierung ([http://common-lisp.net/movies/hello-world.torrent UnCommonWeb Hello World])
 "It was pretty slick when Marco fixed an error in some code while Firefox was blocked trying to display the page, then was able to compile the fixed code and finish serving the request to the browser."
+
+==xmpp-demo.lisp==
+<pre>
+(defpackage :xmpp-demo
+    (:use "COMMON-LISP" "EXCL" "XMPP" "MP"
+	  "NET.ASERVE" "NET.HTML.GENERATOR"))
+(in-package :xmpp-demo)
+
+(defclass bot-connection (connection)
+  ((event-thread :accessor event-thread)))
+
+(defmethod authenticate ((con bot-connection))
+  (auth con "blitz" cl-user::*jabber-pw* "allegrocl"))
+
+(defmethod start-event-thread ((con bot-connection))
+  (setf (event-thread con)
+	(process-run-function "xmpp"
+			      (lambda ()
+				(receive-stanza-loop con)))))
+
+;; Parsing
+
+(defun ensure-keyword (str)
+  (values (intern (string-upcase str) "KEYWORD")))
+
+(defun parse-command (str)
+  (multiple-value-bind (match? whole cmd rest)
+      (match-re "(\\S+)\\s*(.*)" str)
+    (if match?
+	(values (ensure-keyword cmd) rest)
+	(error "Invalid command."))))
+
+;; -> CMD arg
+
+;; Links
+
+(defvar *links* nil)
+
+(defstruct link
+  url submitter)
+
+;; Handler fun
+
+(defvar *cn* nil
+  "Our current connection")
+
+(defun start-it ()
+  (setq *cn* (connect :hostname "spaceboyz.net"
+		      :class 'bot-connection))
+  (authenticate *cn*)
+  (start-event-thread *cn*))
+
+(defmethod handle ((con bot-connection) (event message))
+  (handler-case
+      (multiple-value-bind (cmd parameter)
+	  (parse-command (body event))
+	(case cmd
+	  (:hello (message con (from event) "Hello you!"))
+	  (:url (push (make-link :url parameter
+				 :submitter (from event))
+		      *links*))
+	))
+    (t (c) (message con "blitz@spaceboyz.net"
+		   (format nil "~A" c)))))
+
+
+;; HTML
+
+(defun html-redirect (url &optional (delay 0))
+  (html
+   (:html
+    (:head ((:meta :http-equiv "Refresh"
+		   :content (format nil "~A; URL=~A" delay url)))))))
+
+(defun xmpp-render (req ent)
+  (with-http-response (req ent)
+    (with-http-body (req ent)
+      (let ((go (request-query-value "go" req)))
+	(if go
+	    (let ((submitter (link-submitter (find go *links* :key 'link-url :test 'string=))))
+	      (when submitter
+		(message *cn* submitter
+			 (format nil "Your link ~A was followed." go)))
+	      (html-redirect go))
+	    (html
+	     (:html
+	      (:body (:h1 "XMPP Demo")
+		     (:table
+		      (:tr (:th "Submitter")
+			   (:th "URL"))
+		      (loop for link in *links*
+			    do (html
+				(:tr (:td (:princ-safe (link-submitter link)))
+				     (:td ((:a :href (format nil "/xmpp?~A"
+							     (query-to-form-urlencoded
+							      (list (cons "go" (link-url link))))))
+					   (:princ-safe (link-url link)))))))))
+	      )))))))
+
+(publish :path "/xmpp"
+	 :function 'xmpp-render)
+</pre>