[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