groworld/hayfever/jabberer.scm

56 lines
1.6 KiB
Scheme
Raw Normal View History

2009-04-21 08:48:33 +00:00
#lang scheme
(require "xmpp-dave.ss")
(require scheme/class)
(require openssl)
(define jabberer%
(class object%
(field
(incoming '())
(outgoing '())
(thr 0)
(jid "")
(pass ""))
(define/public (get-incoming)
incoming)
(define/public (clear-incoming)
(set! incoming '()))
(define/public (send-msg to msg)
(set! outgoing (cons (list to msg) outgoing)))
(define (message-handler sz)
(printf "<---- ~a ~a~n" (message-from sz) (message-body sz))
(set! incoming (cons (list (message-from sz) (message-body sz)) incoming)))
(define/public (start j p)
(set! jid j)
(set! pass p)
(set! thr (thread run)))
(define/public (stop)
(kill-thread thr))
(define (run)
(with-xmpp-session jid pass
(set-xmpp-handler 'message message-handler)
(let loop ()
(when (not (null? outgoing))
(for-each
(lambda (msg)
(printf "----> ~a ~a~n" (car msg) (cadr msg))
(xmpp-send (message (car msg) (cadr msg))))
outgoing)
(set! outgoing '()))
(sleep 0.5)
(loop))))
(super-new)))
(define j (make-object jabberer%))
(send j start "plant0000001@fo.am" "plant0000001")
(send j send-msg "dave@fo.am" "woop")