[Cl-irc-cvs] CVS update: cl-irc/example/cliki-bot.asd cl-irc/example/cliki.lisp cl-irc/example/specbot.lisp

Lisppaste and co. lisppaste at common-lisp.net
Tue May 10 00:36:29 UTC 2005


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

Modified Files:
	cliki-bot.asd cliki.lisp specbot.lisp 
Log Message:
Whee! leak fewer fds by using trivial-http

Date: Tue May 10 02:36:26 2005
Author: lisppaste

Index: cl-irc/example/cliki-bot.asd
diff -u cl-irc/example/cliki-bot.asd:1.3 cl-irc/example/cliki-bot.asd:1.4
--- cl-irc/example/cliki-bot.asd:1.3	Tue Jul 27 22:39:42 2004
+++ cl-irc/example/cliki-bot.asd	Tue May 10 02:36:26 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cliki-bot.asd,v 1.3 2004/07/27 20:39:42 bmastenbrook Exp $
+;;;; $Id: cliki-bot.asd,v 1.4 2005/05/10 00:36:26 lisppaste Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -17,9 +17,9 @@
     :licence "MIT"
     :description "IRC bot for SBCL"
     :depends-on
-      (:cl-irc :cl-ppcre :split-sequence)
+      (:cl-irc :cl-ppcre :split-sequence :trivial-http)
     :properties ((#:author-email . "cl-irc-devel at common-lisp.net")
-                 (#:date . "$Date: 2004/07/27 20:39:42 $")
+                 (#:date . "$Date: 2005/05/10 00:36:26 $")
                  ((#:albert #:output-dir) . "doc/api-doc/")
                  ((#:albert #:formats) . ("docbook"))
                  ((#:albert #:docbook #:template) . "book")


Index: cl-irc/example/cliki.lisp
diff -u cl-irc/example/cliki.lisp:1.28 cl-irc/example/cliki.lisp:1.29
--- cl-irc/example/cliki.lisp:1.28	Tue Nov 23 03:54:08 2004
+++ cl-irc/example/cliki.lisp	Tue May 10 02:36:26 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cliki.lisp,v 1.28 2004/11/23 02:54:08 bmastenbrook Exp $
+;;;; $Id: cliki.lisp,v 1.29 2005/05/10 00:36:26 lisppaste Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $
 
 ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL.
@@ -239,41 +239,6 @@
                       (funcall (intern "PASTE-CHANNEL" :lisppaste) paste)
                       (funcall (intern "PASTE-DISPLAY-URL" :lisppaste) paste))))))
 
-(defun url-port (url)
-  (assert (string-equal url "http://" :end1 7))
-  (let ((path-start (position #\/ url :start 7)))
-    (let ((port-start (position #\: url :start 7 :end path-start)))
-      (if port-start (parse-integer url :start (1+ port-start) :junk-allowed t) 80))))
-
-(defun url-host (url)
-  (assert (string-equal url "http://" :end1 7))
-  (let* ((port-start (position #\: url :start 7))
-	 (host-end (min (or (position #\/ url :start 7) (length url))
-			(or port-start (length url)))))
-    (subseq url 7 host-end)))
-
-(defun url-connection (url)
-  (let* ((host (url-host url))
-         (port (url-port url))
-         (stream (socket-connect host port)))
-    ;; we are exceedingly unportable about proper line-endings here.
-    ;; Anyone wishing to run this under non-SBCL should take especial care
-
-    (format stream "GET ~A HTTP/1.0~%Host: ~A~%User-Agent: CLiki Bot~%~%" url host)
-    (force-output stream)
-    (list
-     (let* ((l (read-line stream))
-            (space (position #\Space l)))
-       (parse-integer l :start (1+ space) :junk-allowed t))
-     (loop for line = (read-line stream nil nil)
-           until (or (null line) (eql (elt line 0) (code-char 13)))
-           collect
-           (let ((colon (position #\: line)))
-             (cons (intern (string-upcase (subseq line 0 colon)) :keyword)
-                   (string-trim (list #\Space (code-char 13))
-                                (subseq line (1+ colon))))))
-     stream)))
-
 (defun encode-for-url (str)
   (setf str (regex-replace-all " " str "%20"))
   (setf str (regex-replace-all "," str "%2C"))
@@ -306,35 +271,21 @@
       (if interrupt-thread
           (ccl:process-kill interrupt-thread)))))
 
-(defun http-get (url)
+(defun cliki-first-sentence (term)
   (host-with-timeout
    5
-   (destructuring-bind (response headers stream)
-       (block got
-         (loop
-          (destructuring-bind (response headers stream) (url-connection url)
-            (unless (member response '(301 302))	       
-              (return-from got (list response headers stream)))
-            (close stream)
-            (setf stream nil)
-            (setf url (cdr (assoc :location headers))))))
-     (if (not (eql response 200))
-         nil
-         stream))))
-
-(defun cliki-first-sentence (term)
-  (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 (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
+   (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)
@@ -353,10 +304,10 @@
                                (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) " ")))))
-    ))
+			(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
@@ -529,7 +480,7 @@
 (defun cliki-lookup (term-with-question &key sender channel)
   (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\\s+" first-pass " "))
     (setf first-pass (regex-replace-all "\\s*$" first-pass ""))
     (let ((scanned (or (nth-value 1 (scan-to-strings "^add\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass))
                        (nth-value 1 (scan-to-strings "^add\\s+(.+)\\s+as:*\\s+(.+)$" first-pass)))))


Index: cl-irc/example/specbot.lisp
diff -u cl-irc/example/specbot.lisp:1.12 cl-irc/example/specbot.lisp:1.13
--- cl-irc/example/specbot.lisp:1.12	Tue Nov 23 03:54:08 2004
+++ cl-irc/example/specbot.lisp	Tue May 10 02:36:26 2005
@@ -1,4 +1,4 @@
-;;;; $Id: specbot.lisp,v 1.12 2004/11/23 02:54:08 bmastenbrook Exp $
+;;;; $Id: specbot.lisp,v 1.13 2005/05/10 00:36:26 lisppaste Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/specbot.lisp,v $
 
 ;;;; specbot.lisp - an example IRC bot for cl-irc
@@ -160,10 +160,19 @@
                      (or *load-truename*
                          *default-pathname-defaults*)))))
 
+(defparameter *man-file*
+  (merge-pathnames "man.lisp-expr"
+                   (make-pathname
+                    :directory
+                    (pathname-directory
+                     (or *load-truename*
+                         *default-pathname-defaults*)))))
+
 (defun start-specbot (nick server &rest channels)
   (add-simple-alist-lookup *754-file* 'ieee754 "ieee754" "Section numbers of IEEE 754")
   (add-simple-alist-lookup *ppc-file* 'ppc "ppc" "PowerPC assembly mnemonics")
   (add-simple-alist-lookup *sus-file* 'sus "posix" "Single UNIX Specification")
+  (add-simple-alist-lookup *man-file* 'man "man" "Mac OS X Man Pages")
   (setf *nickname* nick)
   (setf *connection* (connect :nickname *nickname* :server server))
   (mapcar #'(lambda (channel) (join *connection* channel)) channels)




More information about the cl-irc-cvs mailing list