[Cl-irc-cvs] CVS update: cl-irc/example/clhs.lisp cl-irc/example/cliki-bot.asd cl-irc/example/cliki.lisp cl-irc/example/eliza-rules.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Tue Jun 1 13:48:12 UTC 2004
Update of /project/cl-irc/cvsroot/cl-irc/example
In directory common-lisp.net:/tmp/cvs-serv12457/example
Modified Files:
clhs.lisp cliki-bot.asd cliki.lisp eliza-rules.lisp
Log Message:
Portability fixes
Date: Tue Jun 1 06:48:12 2004
Author: bmastenbrook
Index: cl-irc/example/clhs.lisp
diff -u cl-irc/example/clhs.lisp:1.4 cl-irc/example/clhs.lisp:1.5
--- cl-irc/example/clhs.lisp:1.4 Sun Feb 1 06:11:56 2004
+++ cl-irc/example/clhs.lisp Tue Jun 1 06:48:12 2004
@@ -1,4 +1,4 @@
-;;;; $Id: clhs.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $
+;;;; $Id: clhs.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/clhs.lisp,v $
;;;; clhs.lisp - an example IRC bot for cl-irc
@@ -20,7 +20,7 @@
(in-package :clhs)
;;; CLHS. This will be the default lookup.
-(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/")
+(defparameter *hyperspec-pathname* #p"/Users/chandler/HyperSpec/")
(defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*))
@@ -167,8 +167,12 @@
(setf *clhs-connection* (connect :nickname *clhs-nickname* :server server))
(mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels)
(add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook)
- #+sbcl (start-background-message-handler *clhs-connection*)
- #-sbcl (read-message-loop *clhs-connection*))
+ #+(or sbcl
+ openmcl)
+ (start-background-message-handler *clhs-connection*)
+ #-(or sbcl
+ openmcl)
+ (read-message-loop *clhs-connection*))
(defun shuffle-hooks ()
(irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message)
Index: cl-irc/example/cliki-bot.asd
diff -u cl-irc/example/cliki-bot.asd:1.1 cl-irc/example/cliki-bot.asd:1.2
--- cl-irc/example/cliki-bot.asd:1.1 Sat Jan 17 11:19:55 2004
+++ cl-irc/example/cliki-bot.asd Tue Jun 1 06:48:12 2004
@@ -1,4 +1,4 @@
-;;;; $Id: cliki-bot.asd,v 1.1 2004/01/17 19:19:55 bmastenbrook Exp $
+;;;; $Id: cliki-bot.asd,v 1.2 2004/06/01 13:48:12 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $
;;;; See the LICENSE file for licensing information.
@@ -17,10 +17,9 @@
:licence "MIT"
:description "IRC bot for SBCL"
:depends-on
- #+sbcl (:cl-irc :cl-ppcre)
- #-sbcl (:sbcl)
+ (:cl-irc :cl-ppcre)
:properties ((#:author-email . "cl-irc-devel at common-lisp.net")
- (#:date . "$Date: 2004/01/17 19:19:55 $")
+ (#:date . "$Date: 2004/06/01 13:48:12 $")
((#:albert #:output-dir) . "doc/api-doc/")
((#:albert #:formats) . ("docbook"))
((#:albert #:docbook #:template) . "book")
@@ -30,4 +29,4 @@
(:file "eliza-rules"
:depends-on ("mp2eliza"))
(:file "cliki"
- :depends-on ("mp2eliza"))))
\ No newline at end of file
+ :depends-on ("mp2eliza"))))
Index: cl-irc/example/cliki.lisp
diff -u cl-irc/example/cliki.lisp:1.4 cl-irc/example/cliki.lisp:1.5
--- cl-irc/example/cliki.lisp:1.4 Sun Feb 1 06:11:56 2004
+++ cl-irc/example/cliki.lisp Tue Jun 1 06:48:12 2004
@@ -1,4 +1,4 @@
-;;;; $Id: cliki.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $
+;;;; $Id: cliki.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $
;;;; cliki.lisp - CLiki as an infobot; only works on SBCL.
@@ -7,7 +7,7 @@
;;; cliki.lisp, and invoke (cliki::start-cliki-bot "desirednickname"
;;; "desiredserver" "#channel1" "#channel2" "#channel3" ...)
-(defpackage :cliki (:use :common-lisp :irc :sb-bsd-sockets :cl-ppcre)
+(defpackage :cliki (:use :common-lisp :irc :cl-ppcre)
(:export :start-cliki-bot :*cliki-nickserv-password*
:*respond-to-general-hellos*))
(in-package :cliki)
@@ -50,31 +50,47 @@
(or port-start (length url)))))
(subseq url 7 host-end)))
+#+(or ccl allegro)
+(defun socket-connect (host port)
+ (#+ccl ccl:make-socket
+ #+allegro socket:make-socket
+ :connect :active
+ :remote-host host
+ :remote-port port))
+
+#+sbcl
+(defun socket-connect (host port)
+ (let ((s (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses
+ (sb-bsd-sockets:get-host-by-name host))) port)
+ (sb-bsd-sockets:socket-make-stream s
+ :element-type 'character
+ :input t
+ :output t
+ :buffering :none)))
+
(defun url-connection (url)
- (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))
- (host (url-host url))
- (port (url-port url)))
- (declare (ignore port))
- (socket-connect
- s (car (host-ent-addresses (get-host-by-name (url-host url))))
- (url-port url))
- (let ((stream (socket-make-stream s :input t :output t :buffering :full)))
- ;; 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))))
+ (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"))
@@ -83,13 +99,33 @@
;(format t "hi ~A~%" str)
str)
+#+sbcl
+(defmacro host-with-timeout (timeout &body body)
+ `(sb-ext:with-timeout ,timeout , at body))
+
+#+ccl
+(defmacro host-with-timeout (timeout &body body)
+ `(let ((interrupt-thread nil))
+ (setf interrupt-thread
+ (ccl:process-run-function 'timeout
+ (let ((process ccl:*current-process*))
+ (lambda ()
+ (sleep ,timeout)
+ (ccl:process-interrupt process
+ (lambda ()
+ (signal 'openmcl-timeout)))))))
+ (unwind-protect
+ (progn , at body)
+ (if interrupt-thread
+ (ccl:process-kill interrupt-thread)))))
+
(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
- (sb-ext:with-timeout 5
+ (host-with-timeout 5
(destructuring-bind (response headers stream)
(block got
(loop
@@ -138,7 +174,7 @@
(defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.")
-(defun cliki-lookup (term-with-question)
+(defun cliki-lookup (term-with-question &optional sender)
(let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2")))
(setf first-pass (regex-replace-all "\\s\\s+" first-pass ""))
(setf first-pass (regex-replace-all "\\s*$" first-pass ""))
@@ -156,9 +192,15 @@
(setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass ""))
(or
(if (string-equal first-pass "help") *cliki-bot-help*)
- (if (scan "^(?i)hello(\\s|$)" first-pass) "what's up?")
- (if (scan "^(?i)hi(\\s|$)" first-pass) "what's up?")
- (if (scan "^(?i)yo(\\s|$)" first-pass) "what's up?")
+ (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?")
+ (if (scan "^(?i)hi(\\s|$)*" first-pass) "what's up?")
+ (if (scan "^(?i)yo(\\s|$)*" first-pass) "what's up?")
+ (if (scan "^(?i)thank(s| you)(\\s|!|\\?|\\.|$)*" first-pass)
+ (if sender
+ (format nil "~A: you failed the inverse turing test!" sender)
+ "you failed the inverse turing test!"))
+ (if (scan "^(?i)version(\\s|!|\\?|\\.|$)*" first-pass)
+ (format nil "This is the minion bot, running on a ~A (~A) and running under ~A ~A." (machine-type) (machine-version) (lisp-implementation-type) (lisp-implementation-version)))
(if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.")
(aif (or (let ((term (cdr (assoc first-pass *small-definitions* :test #'string-equal))))
(if term (if (stringp term) term (cliki-lookup (car term)))))
@@ -183,7 +225,7 @@
(defun msg-hook (message)
(let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message)))))
(if (valid-cliki-message message)
- (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "")))
+ (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") (source message)))
(if (string-equal (first (arguments message)) *cliki-nickname*)
(privmsg *cliki-connection* respond-to (cliki-lookup (trailing-argument message)))
(if (anybody-here (trailing-argument message))
@@ -203,8 +245,7 @@
(mapcar #'(lambda (channel) (join *cliki-connection* channel)) channels)
(add-hook *cliki-connection* 'irc::irc-privmsg-message 'msg-hook)
(add-hook *cliki-connection* 'irc::irc-notice-message 'notice-hook)
- #+sbcl (start-background-message-handler *cliki-connection*)
- #-sbcl (read-message-loop *cliki-connection*))
+ (start-background-message-handler *cliki-connection*))
(defun shuffle-hooks ()
(irc::remove-hooks *cliki-connection* 'irc::irc-privmsg-message)
Index: cl-irc/example/eliza-rules.lisp
diff -u cl-irc/example/eliza-rules.lisp:1.2 cl-irc/example/eliza-rules.lisp:1.3
--- cl-irc/example/eliza-rules.lisp:1.2 Sun Feb 1 06:11:56 2004
+++ cl-irc/example/eliza-rules.lisp Tue Jun 1 06:48:12 2004
@@ -21,6 +21,9 @@
(((?* ?x) bot (?* ?y))
(|I'm| not a |bot.| I prefer the term |``electronically composed''.|))
+ ((seen ?x)
+ (?x was last seen 5y6m14d32h43m10s |ago,| saying |"minion: when are you going to support seen?"|))
+
(((?* ?x) did you (?* ?y))
(|no, I didn't| ?y)
(|yes, I| ?y))
@@ -34,6 +37,9 @@
(Thanks!))
((bot snack)
+ (Thanks!))
+
+ ((welcome (?* ?y))
(Thanks!))
((not much) (good))
More information about the cl-irc-cvs
mailing list