From pvaneynde at common-lisp.net  Sat Jul  2 20:58:15 2005
From: pvaneynde at common-lisp.net (Peter Van Eynde)
Date: Sat,  2 Jul 2005 22:58:15 +0200 (CEST)
Subject: [Cl-irc-cvs] CVS update: cl-irc/debian/changelog
	cl-irc/debian/control 
Message-ID: <20050702205815.7363088529@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc/debian
In directory common-lisp.net:/tmp/cvs-serv15122/debian

Modified Files:
	changelog control 
Log Message:
note new version, use darcs-buildpackage
Date: Sat Jul  2 22:58:13 2005
Author: pvaneynde

Index: cl-irc/debian/changelog
diff -u cl-irc/debian/changelog:1.7 cl-irc/debian/changelog:1.8
--- cl-irc/debian/changelog:1.7	Thu Mar  3 10:23:00 2005
+++ cl-irc/debian/changelog	Sat Jul  2 22:58:13 2005
@@ -1,3 +1,12 @@
+cl-irc (20050321-1) unstable; urgency=low
+
+  * New upstream
+  * New versioning scheme, now no longer a native package
+  * Updated policy version
+  * Now uses darcs-buildpackage
+
+ -- Peter Van Eynde <pvaneynd at debian.org>  Sat,  2 Jul 2005 22:52:51 +0200
+
 cl-irc (0.6.2) unstable; urgency=low
 
   * Updated package to current CVS (2005-03-03) 


Index: cl-irc/debian/control
diff -u cl-irc/debian/control:1.4 cl-irc/debian/control:1.5
--- cl-irc/debian/control:1.4	Thu Mar  3 10:23:00 2005
+++ cl-irc/debian/control	Sat Jul  2 22:58:13 2005
@@ -3,11 +3,11 @@
 Priority: optional
 Maintainer: Peter Van Eynde <pvaneynd at debian.org>
 Build-Depends-Indep: debhelper (>> 4.0.0)
-Standards-Version: 3.6.1.1
+Standards-Version: 3.6.2.1
 
 Package: cl-irc
 Architecture: all
-Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37), cl-split-sequence
+Depends: common-lisp-controller (>= 3.37), cl-split-sequence
 Description: Common Lisp Internet Relay Chat Library
  cl-irc provides a library for Common Lisp programs to interact with
  IRC servers. This library has been most tested with SBCL.



From lisppaste at common-lisp.net  Thu Jul 28 18:31:13 2005
From: lisppaste at common-lisp.net (Lisppaste and co.)
Date: Thu, 28 Jul 2005 20:31:13 +0200 (CEST)
Subject: [Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp 
Message-ID: <20050728183113.55E8E88547@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc/example
In directory common-lisp.net:/home/lisppaste/cl-irc/example

Modified Files:
	cliki.lisp 
Log Message:
No idea...

Date: Thu Jul 28 20:31:09 2005
Author: lisppaste

Index: cl-irc/example/cliki.lisp
diff -u cl-irc/example/cliki.lisp:1.29 cl-irc/example/cliki.lisp:1.30
--- cl-irc/example/cliki.lisp:1.29	Tue May 10 02:36:26 2005
+++ cl-irc/example/cliki.lisp	Thu Jul 28 20:31:08 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cliki.lisp,v 1.29 2005/05/10 00:36:26 lisppaste Exp $
+;;;; $Id: cliki.lisp,v 1.30 2005/07/28 18:31:08 lisppaste Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $
 
 ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL.
@@ -182,16 +182,19 @@
 
 (defvar *advice-db* nil)
 
+(defun advice-db ()
+  (when (not *advice-db*)
+    (with-open-file (ad *advice-file* :direction :input)
+      (setf *advice-db* (read ad))))
+  *advice-db*)
+
 (defun lookup-advice (num-str)
   (let ((num (parse-integer num-str :junk-allowed t)))
-    (when (not *advice-db*)
-      (with-open-file (ad *advice-file* :direction :input)
-        (setf *advice-db* (read ad))))
-    (or (cdr (assoc num *advice-db*))
+    (or (cdr (assoc num (advice-db)))
         "You can't just make up advice numbers and expect a response.")))
 
 (defun random-advice ()
-  (let ((item (random-element *advice-db*)))
+  (let ((item (random-element (advice-db))))
     (format nil "#~A: ~A" (car item) (cdr item))))
 
 (defun search-advice (str)
@@ -222,7 +225,7 @@
                     (if (and (not (zerop score))
                              (eql score max-score))
                         (push e max-score-items)))))
-          *advice-db*)
+          (advice-db))
     (if (zerop max-score)
         "You can't expect automated advice for everything."
         (let ((item (random-element max-score-items)))
@@ -271,47 +274,60 @@
       (if interrupt-thread
           (ccl:process-kill interrupt-thread)))))
 
+(defun http-get-recursively (url)
+  (destructuring-bind (status headers stream)
+      (trivial-http:http-get url)
+    (if (and (eql status 302)
+	     (assoc :location headers))
+	(progn
+	  (close stream)
+	  (http-get-recursively (cdr (assoc :location headers))))
+	(list status headers stream))))
+
 (defun cliki-first-sentence (term)
-  (host-with-timeout
-   5
-   (let* ((cliki-url (format nil "http://www.cliki.net/~A"
+  (let* ((cliki-url (format nil "http://www.cliki.net/~A"
 			     (encode-for-url term)))
 	  (url (concatenate 'string cliki-url "?source")))
      (block cliki-return
        (handler-case
-	   (let ((stream (third (trivial-http:http-get url))))
-	     (unwind-protect
-		  (if (not stream)
-		      nil
-		      ;;(format nil "The term ~A was not found in CLiki." term)
-		      (let ((first-line ""))
-			(loop for i from 1 to 5 do ;; scan the first 5 lines
-                             (progn
-                               (multiple-value-bind (next-line missing-newline-p)
-                                   (read-line stream nil)
-                                 (if next-line
-                                     (setf first-line (concatenate 'string first-line (string #\newline) next-line))
-                                     (return-from cliki-return (format nil "The end of the page was reached before a definition was found in ~A" cliki-url))))
-                               (setf first-line (regex-replace-all "\\r" first-line " "))
-                               (setf first-line (regex-replace-all "\\n" first-line " "))
-                               (setf first-line (regex-replace-all "_\\(([^)]*)\\)" first-line "\\1"))
-                               (setf first-line (regex-replace-all "#H\\(([^)]*)\\)" first-line "\\1"))
-                               (setf first-line (regex-replace-all "\\*\\(([^)]*)\\)" first-line "\\1"))
-                               (setf first-line (regex-replace-all "<[^>]+>" first-line ""))
-                               (setf first-line (regex-replace-all "^(([^.]|\\.\\S)+)\\.\\s+.*$" first-line "\\1."))
-                               (setf first-line (regex-replace-all "(\\s)\\s+" first-line "\\1"))
-                               (setf first-line (regex-replace-all "^\\s*(.+\\S)\\s*$" first-line "\\1"))
-                               (when (scan "^([^.]|\\.\\S)+[.?!]$" first-line)
-                                 (setf first-line (concatenate 'string first-line " " cliki-url))
-                                 (return-from cliki-return first-line))))
-			(format nil "No definition was found in the first 5 lines of ~A" cliki-url)))
-	       (if stream (close stream))))
+	   (host-with-timeout
+	    5
+	    (destructuring-bind (status headers stream)
+		(http-get-recursively url)
+	     (declare (ignore headers))
+	     ;; Please don't hack on this when tired; it's easy to make it leak fds.
+	       (unwind-protect
+		 (if (or (not (eql status 200)) (not stream))
+			nil
+			;;(format nil "The term ~A was not found in CLiki." term)
+			(let ((first-line ""))
+			  (loop for i from 1 to 5 do ;; scan the first 5 lines
+			       (progn
+				 (multiple-value-bind (next-line missing-newline-p)
+				     (read-line stream nil)
+				   (if next-line
+				       (setf first-line (concatenate 'string first-line (string #\newline) next-line))
+				       (return-from cliki-return (format nil "The end of the page was reached before a definition was found in ~A" cliki-url))))
+				 (setf first-line (regex-replace-all "\\r" first-line " "))
+				 (setf first-line (regex-replace-all "\\n" first-line " "))
+				 (setf first-line (regex-replace-all "_\\(([^)]*)\\)" first-line "\\1"))
+				 (setf first-line (regex-replace-all "#H\\(([^)]*)\\)" first-line "\\1"))
+				 (setf first-line (regex-replace-all "\\*\\(([^)]*)\\)" first-line "\\1"))
+				 (setf first-line (regex-replace-all "<[^>]+>" first-line ""))
+				 (setf first-line (regex-replace-all "^(([^.]|\\.\\S)+)\\.\\s+.*$" first-line "\\1."))
+				 (setf first-line (regex-replace-all "(\\s)\\s+" first-line "\\1"))
+				 (setf first-line (regex-replace-all "^\\s*(.+\\S)\\s*$" first-line "\\1"))
+				 (when (scan "^([^.]|\\.\\S)+[.?!]$" first-line)
+				   (setf first-line (concatenate 'string first-line " " cliki-url))
+				   (return-from cliki-return first-line))))
+			  (format nil "No definition was found in the first 5 lines of ~A" cliki-url)))
+		 (if stream (close stream)))))
 	 (condition (c &rest whatever) (return-from cliki-return (regex-replace-all "\\n" (format nil "An error was encountered in lookup: ~A." c) " ")))))
-     )))
+     ))
 
 (defun shorten (url)
   (handler-case
-      (let ((stream (http-get (format nil "http://shorl.com/create.php?url=~A" url))))
+      (let ((stream (trivial-http:http-get (format nil "http://shorl.com/create.php?url=~A" url))))
         (finish-output t)
         (unwind-protect
              (when stream
@@ -478,7 +494,7 @@
               )))))))))
     
 (defun cliki-lookup (term-with-question &key sender channel)
-  (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2"))
+  (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)([?.!,;]*)$" term-with-question "\\2"))
         (should-send-cant-find t))
     (setf first-pass (regex-replace-all "\\s\\s+" first-pass " "))
     (setf first-pass (regex-replace-all "\\s*$" first-pass ""))
@@ -675,22 +691,25 @@
 	  (scan "^(?i)\\s*(hello|hi|yo)\\s*(channel|room|people|ppl|all|peeps|)\\s*$" string))))
 
 (defun msg-hook (message)
-  (handler-case
-      (progn
-        (scan-for-more (trailing-argument message))
-        (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message)))))
-          (if (valid-cliki-message message)
-              (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") :sender (source message) :channel (first (irc:arguments message)))))
-                (and response (privmsg *cliki-connection* respond-to response)))
-              (if (string-equal (first (arguments message)) *cliki-nickname*)
-                  (aif (cliki-lookup (trailing-argument message) :sender (source message))
-                       (privmsg *cliki-connection* respond-to it))
-                  (if (anybody-here (trailing-argument message))
-                      (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message))))))
-          (take-care-of-memos respond-to (source message))))
-    (serious-condition (c)
-      (format *trace-output* "Caught error: ~A~%" c)
-      #+sbcl (sb-debug:backtrace 5 *trace-output*))))
+  (handler-bind
+      ((serious-condition (lambda (c)
+	 (format *trace-output* "Caught error: ~A~%" c)
+	 #+nil (sb-debug:backtrace 10 *trace-output*)
+	 (format *trace-output* "~A~%"
+		 (nthcdr 10 (sb-debug:backtrace-as-list)))
+	 (return-from msg-hook))))
+    (progn
+      (scan-for-more (trailing-argument message))
+      (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message)))))
+	(if (valid-cliki-message message)
+	    (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") :sender (source message) :channel (first (irc:arguments message)))))
+	      (and response (privmsg *cliki-connection* respond-to response)))
+	    (if (string-equal (first (arguments message)) *cliki-nickname*)
+		(aif (cliki-lookup (trailing-argument message) :sender (source message))
+		     (privmsg *cliki-connection* respond-to it))
+		(if (anybody-here (trailing-argument message))
+		    (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message))))))
+	(take-care-of-memos respond-to (source message))))))
 
 (defvar *cliki-nickserv-password* "")