Lisp-Geekend

Aus C3D2
Version vom 29. Mai 2007, 14:19 Uhr von Sven (Diskussion | Beiträge)
(Unterschied) ← Nächstältere Version | Aktuelle Version (Unterschied) | Nächstjüngere Version → (Unterschied)
Zur Navigation springen Zur Suche springen

Lisp-Geekend

Allgemeines

blitz plant ein Lisp-Geekend, auf dem ähnlich dem Dylan-Geekend die breite Öffentlichkeit (*hust*) dem Lisp-Virus ausgesetzt wird.

Geplante Themen

Themenwünsche

(einfach gewünschte Sachen der Liste anfügen)

"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

(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)