cl-irc-cvs May 2005

cl-irc-cvs@common-lisp.net

1 participants
1 discussions

[Cl-irc-cvs] CVS update: cl-irc/example/cliki-bot.asd cl-irc/example/cliki.lisp cl-irc/example/specbot.lisp
by lisppaste＠common-lisp.net 10 May '05

10 May '05

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

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

cl-irc-cvs May 2005