[Gd-chatter] r10752 - in trunk/libraries/xmpp: . xmpp-test
turbo24prg at gwydiondylan.org
turbo24prg at gwydiondylan.org
Sat May 27 15:02:40 CEST 2006
Author: turbo24prg
Date: Sat May 27 15:02:37 2006
New Revision: 10752
Added:
trunk/libraries/xmpp/callback.dylan (contents, props changed)
Modified:
trunk/libraries/xmpp/client.dylan
trunk/libraries/xmpp/iq.dylan
trunk/libraries/xmpp/message.dylan
trunk/libraries/xmpp/presence.dylan
trunk/libraries/xmpp/xmpp-exports.dylan
trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan
trunk/libraries/xmpp/xmpp.lid
Log:
Bug: 7313
* callbacks
Added: trunk/libraries/xmpp/callback.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/xmpp/callback.dylan Sat May 27 15:02:37 2006
@@ -0,0 +1,18 @@
+module: xmpp
+synopsis:
+author:
+copyright:
+
+define class <callback> (<priority-queueable-mixin>)
+ slot reference :: <symbol>,
+ init-keyword: reference:;
+ slot handler :: <function>,
+ required-init-keyword: handler:;
+ slot priority :: <integer>,
+ required-init-keyword: priority:;
+end class <callback>;
+
+define method \< (callback1 :: <callback>, callback2 :: <callback>)
+ => (boolean :: <boolean>);
+ callback1.priority < callback2.priority;
+end method \<;
Modified: trunk/libraries/xmpp/client.dylan
==============================================================================
--- trunk/libraries/xmpp/client.dylan (original)
+++ trunk/libraries/xmpp/client.dylan Sat May 27 15:02:37 2006
@@ -12,14 +12,22 @@
required-init-keyword: jid:;
slot socket :: <tcp-socket>,
init-keyword: socket:;
- slot state :: one-of(#"disconnected", #"authenticating", #"connected");
+ slot state :: one-of(#"disconnected", #"connected") = #"disconnected";
+ slot message-callbacks :: <priority-queue> =
+ make(<priority-queue>, comparison-function: \>);
+ slot presence-callbacks :: <priority-queue> =
+ make(<priority-queue>, comparison-function: \>);
+ slot iq-callbacks :: <priority-queue> =
+ make(<priority-queue>, comparison-function: \>);
+ slot xml-callbacks :: <priority-queue> =
+ make(<priority-queue>, comparison-function: \>);
virtual slot password;
end class <xmpp-client>;
-define method connect (client :: <xmpp-client>, #key port :: <integer> = 5222, stream)
+define method connect (client :: <xmpp-client>, #key port :: <integer> = 5222, host, stream)
=> (connected :: <boolean>);
start-sockets();
- client.socket := make(<tcp-socket>, host: client.jid.domain, port: port);
+ client.socket := make(<tcp-socket>, host: host | client.jid.domain, port: port);
make(<thread>, priority: $background-priority, function: curry(listen, client));
if (~ stream)
stream := make(<xmpp-stream>, to: client.jid.domain);
@@ -40,6 +48,7 @@
let stream-running? = #f;
let parsing-tag? = #f;
let tag = "";
+ let buffer = "";
let current-element = #f;
let tag-queue = make(<deque>);
@@ -50,14 +59,22 @@
if (parsing-tag? = #f)
if (received = '<')
parsing-tag? := #t;
+ if (size(buffer) > 0 & ~ every?(method(x) x = '\n' end, buffer) & current-element)
+ //let xml-text = make(<char-string>, text: buffer);
+ format-out("||| %= %=\n", current-element, buffer);
+ format-out("||| %=\n", current-element.node-children);
+ current-element.node-children := concatenate(current-element.node-children, vector(make(<char-string>, text: buffer)));
+ format-out("||| %= %=\n", current-element, buffer);
+ buffer := "";
+ end if;
tag := add!(tag, received);
read-next();
elseif (~ stream-running? & received ~= '\n')
//!!! error: not well-formed xml: chars not contained in root element
format-out("!!! error: not well-formed xml: chars not contained in root element\n");
- elseif (stream-running? & current-element & received ~= '\n')
+ elseif (stream-running? & current-element)
//!!! collect chars into text of current-element!!!
- current-element.text := add!(current-element.text, received);
+ buffer := add(buffer, received);
read-next();
end if;
else
@@ -87,7 +104,7 @@
stream-running? := #t;
//!!! do something
format-out("!!! (X) %=\n", current-element);
- make(<thread>, function: curry(dispatch, current-element));
+ make(<thread>, function: curry(dispatch, client, current-element));
current-element := #f;
end if;
// cleanup
@@ -104,7 +121,7 @@
// empty stanza
if (size(tag-queue) < 2)
format-out("!!! (X) %=\n", element);
- make(<thread>, function: curry(dispatch, element));
+ make(<thread>, function: curry(dispatch, client, element));
else
add-element(current-element, element);
end if;
@@ -132,7 +149,7 @@
stream-running? := #f;
//!!! what do do here? thread?!
else
- make(<thread>, function: curry(dispatch, current-element));
+ make(<thread>, function: curry(dispatch, client, current-element));
end if;
end if;
current-element := current-element.element-parent;
@@ -200,11 +217,15 @@
if (~ data.id)
data.id := "foo";
end if;
-
- send(client, data, awaits-result?: awaits-result?);
-/*
- if received.kind_of? XMLStanza and received.id == xml.id
-*/
+
+ let result = send(client, data, awaits-result?: awaits-result?);
+ if (awaits-result?)
+ if (result.id ~= data.id)
+ signal("id-missmatch");
+ else
+ result;
+ end if;
+ end if;
end method send-with-id;
define method password-setter (password, client :: <xmpp-client>)
@@ -213,15 +234,36 @@
password;
end method password-setter;
-define method dispatch (element :: <element>)
+define method dispatch (client :: <xmpp-client>, element :: <element>)
+// let stanza = element;
+ format-out("!!! (X2) %=\n", element);
+ let stanza = select (element.name)
+ #"message" => as(<message>, element);
+ #"presence" => as(<presence>, element);
+ #"iq" => as(<iq>, element);
+ otherwise => element;
+ end select;
with-lock (*stanza-lock*)
if (~ *available-stanza*)
release-all(*parsed-stanza*);
end if;
- *available-stanza* := element;
+ *available-stanza* := stanza;
end with-lock;
-
- format-out("!!! (X2) %=\n", element);
+ format-out("!!! (X2) %=\n", stanza);
+ format-out("!!! (X2) %=\n", object-class(stanza));
+ let callbacks = select (stanza by instance?)
+ <message> => client.message-callbacks;
+ <presence> => client.presence-callbacks;
+ <iq> => client.iq-callbacks;
+ otherwise => client.xml-callbacks;
+ end select;
+ block (return)
+ for (callback in callbacks)
+ if (callback.handler(client, stanza))
+ return();
+ end if;
+ end for;
+ end block;
end method dispatch;
define method authenticate (client :: <xmpp-client>, password, #key digest = #t)
@@ -238,3 +280,13 @@
///!!! verify!!!
send-with-id(client, authentication, awaits-result?: #t);
end method authenticate;
+
+define method connected? (client :: <xmpp-client>)
+ => (res :: <boolean>)
+ client.state = #"connected"
+end method connected?;
+
+define method disconnected? (client :: <xmpp-client>)
+ => (res :: <boolean>)
+ client.state = #"disconnected"
+end method disconnected?;
Modified: trunk/libraries/xmpp/iq.dylan
==============================================================================
--- trunk/libraries/xmpp/iq.dylan (original)
+++ trunk/libraries/xmpp/iq.dylan Sat May 27 15:02:37 2006
@@ -129,3 +129,10 @@
add-element(iq, query);
iq;
end method make-registration;
+
+define method as (class == <iq>, element :: <element>)
+ => (res :: <iq>);
+ let iq = make(<iq>);
+ import-element(iq, element);
+ iq;
+end method as;
Modified: trunk/libraries/xmpp/message.dylan
==============================================================================
--- trunk/libraries/xmpp/message.dylan (original)
+++ trunk/libraries/xmpp/message.dylan Sat May 27 15:02:37 2006
@@ -145,3 +145,10 @@
end if;
end if;
end method normalize;
+
+define method as (class == <message>, element :: <element>)
+ => (res :: <message>);
+ let message = make(<message>);
+ import-element(message, element);
+ message;
+end method as;
Modified: trunk/libraries/xmpp/presence.dylan
==============================================================================
--- trunk/libraries/xmpp/presence.dylan (original)
+++ trunk/libraries/xmpp/presence.dylan Sat May 27 15:02:37 2006
@@ -116,7 +116,7 @@
define method priority-setter (priority :: <integer>, presence :: <presence>)
=> (res :: <integer>);
- remove-element(presence, "priority");
+ replace-element-text(presence, "priority", integer-to-string(priority));
priority;
end method priority-setter;
@@ -125,3 +125,10 @@
remove-element(presence, "priority");
priority;
end method priority-setter;
+
+define method as (class == <presence>, element :: <element>)
+ => (res :: <presence>)
+ let presence = make(<presence>);
+ import-element(presence, element);
+ presence;
+end method as;
Modified: trunk/libraries/xmpp/xmpp-exports.dylan
==============================================================================
--- trunk/libraries/xmpp/xmpp-exports.dylan (original)
+++ trunk/libraries/xmpp/xmpp-exports.dylan Sat May 27 15:02:37 2006
@@ -6,6 +6,7 @@
use network;
use xml-parser;
use meta;
+ use priority-queue;
export xmpp;
end library;
@@ -19,7 +20,8 @@
use streams;
use xml-parser;
use simple-xml;
-
+ use priority-queue;
+
//XXX
use standard-io;
use format-out;
@@ -72,10 +74,17 @@
description, description-setter;
export <xmpp-client>,
- jid, socket, state,
+ jid, jid-setter,
+ socket, socket-setter,
+ state, state-setter,
+ message-callbacks,
+ message-callbacks-setter,
connect, disconnect,
- send, authenticate;
-
+ send, authenticate,
+ connected?, disconnected?;
+
+ export <callback>;
+
export normalize,
id, id-setter,
from, from-setter,
Modified: trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan
==============================================================================
--- trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan (original)
+++ trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan Sat May 27 15:02:37 2006
@@ -221,20 +221,46 @@
*/
- let client = make(<xmpp-client>, jid: make(<jid>, node: "foo", domain: "192.168.0.1", resource: "xmpp"));
+ let callback1 = make(<callback>, reference: #"default", priority: 3, handler: method (client, message)
+ format-out("CCC (1) %= %=\n", client, message);
+ if (message.body)
+ send(client, make(<message>, to: message.from, type: #"chat", body: concatenate("You said: '", message.body, "'")));
+ end if;
+ #f;
+ end);
+
+/*
+ let callback2 = make(<callback>, reference: #"default", priority: 2, handler: method (client, element)
+ format-out("CCC (2) %= %=\n", client, element);
+ #t;
+ end);
+
+ let callback3 = make(<callback>, reference: #"default", priority: 1, handler: method (client, element)
+ format-out("CCC (3) %= %=\n", client, element);
+ #f;
+ end);
+*/
+ let client = make(<xmpp-client>, jid: make(<jid>, node: "dylan", domain: "pentabarf.org", resource: "xmpp"));
+
+ add!(client.message-callbacks, callback1);
+// add!(client.message-callbacks, callback2);
+// add!(client.message-callbacks, callback3);
+
let stream = make(<xmpp-stream>, to: client.jid.domain);
block()
- if (~ connect(client))
+ if (~ connect(client, host: "benkstein.net", port: 4222))
exit-application(1);
end if;
format-out("Connected to xmpp server at %s port: %d\n",
client.socket.remote-host.host-name,
client.socket.remote-port);
- authenticate(client, "foo", digest: #f);
-
- let result = send(client, make(<message>, to: "foo at 192.168.0.1/Psi", body: "foo"), awaits-result?: #t);
- format-out("### (X3) %=\n", result);
+ authenticate(client, "test", digest: #f);
+ send(client, make(<presence>, priority: 23));
+ send(client, make(<message>, to: "turbo24prg at jabber.ccc.de", type: #"chat", body: "This is turbot speaking, your friendly JabberBot written in Dylan."));
+ send(client, make(<message>, to: "turbo24prg at jabber.ccc.de", type: #"chat", body: "I'll echo everything you say!"));
+// let result = send(client, make(<message>, to: "dylan at pentabarf.org/Psi", body: "This is turbot speaking."), awaits-result?: #t);
+// format-out("### (X3) %=\n", result);
while (#t)
end while;
@@ -245,7 +271,6 @@
exception (condition :: <condition>)
format-out("xmpp-test: Error: %=\n", condition);
end block;
-
exit-application(0);
end function main;
Modified: trunk/libraries/xmpp/xmpp.lid
==============================================================================
--- trunk/libraries/xmpp/xmpp.lid (original)
+++ trunk/libraries/xmpp/xmpp.lid Sat May 27 15:02:37 2006
@@ -16,3 +16,4 @@
stanza-error
connection
client
+ callback
More information about the chatter
mailing list