[Gd-chatter] r10737 - in trunk/libraries: xml-parser xmpp xmpp/xmpp-test
turbo24prg at gwydiondylan.org
turbo24prg at gwydiondylan.org
Sun May 14 18:57:07 CEST 2006
Author: turbo24prg
Date: Sun May 14 18:57:04 2006
New Revision: 10737
Modified:
trunk/libraries/xml-parser/library.dylan
trunk/libraries/xml-parser/productions.dylan
trunk/libraries/xml-parser/simple-xml.dylan
trunk/libraries/xmpp/client.dylan
trunk/libraries/xmpp/xmpp-test/xmpp-test-exports.dylan
trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan
Log:
Bug: 7313
* still investigations and work in progress
Modified: trunk/libraries/xml-parser/library.dylan
==============================================================================
--- trunk/libraries/xml-parser/library.dylan (original)
+++ trunk/libraries/xml-parser/library.dylan Sun May 14 18:57:04 2006
@@ -10,7 +10,8 @@
export xml-parser,
simple-xml,
- %productions;
+ %productions,
+ printing;
end library;
define module xml-parser
@@ -39,26 +40,6 @@
create transform, transform-document, before-transform, <xform-state>;
end module xml-parser;
-define module simple-xml
- use common-dylan;
- use xml-parser;
-
- export \with-xml,
- \with-xml-builder,
- escape-xml,
- attribute,
- elements,
- add-attribute,
- remove-attribute,
- add-element,
- remove-element,
- import-element,
- namespace,
- add-namespace,
- remove-namespace,
- replace-element-text;
-end;
-
define module interface
use common-dylan, exclude: { format-to-string };
use streams;
@@ -99,6 +80,8 @@
use interface;
use transform;
+
+ create print-opening, print-attributes, print-closing;
end module printing;
define module collect
@@ -127,6 +110,33 @@
use interface;
use xml-parser;
- export scan-xml-decl;
+ export scan-xml-decl, scan-name, scan-s?, scan-xml-attributes,
+ scan-start-tag;
end module %productions;
+define module simple-xml
+ use common-dylan;
+ use common-extensions;
+ use streams;
+ use xml-parser;
+ use printing;
+
+ export \with-xml,
+ \with-xml-builder,
+ escape-xml,
+ attribute,
+ elements,
+ add-attribute,
+ remove-attribute,
+ add-element,
+ remove-element,
+ import-element,
+ namespace,
+ add-namespace,
+ remove-namespace,
+ replace-element-text,
+ prefix,
+ real-name,
+ start-tag;
+
+end module printing;
Modified: trunk/libraries/xml-parser/productions.dylan
==============================================================================
--- trunk/libraries/xml-parser/productions.dylan (original)
+++ trunk/libraries/xml-parser/productions.dylan Sun May 14 18:57:04 2006
@@ -447,6 +447,13 @@
["/>", no!(*last-tag-name*), set!(content, "")] }
end meta element;
+define meta start-tag (elt-name, attribs, started-new-element) => (elt-name, started-new-element)
+ scan-beginning-of-tag(elt-name, attribs), {
+ [">", set!(started-new-element, #t)],
+ ["/>", set!(started-new-element, #f)]
+ }
+end meta start-tag;
+
// This make-element preserves capitalization of the tag-name
define method make-element(k :: <sequence>, n :: <symbol>, a :: <sequence>,
mod :: <boolean>) => (elt :: <element>)
Modified: trunk/libraries/xml-parser/simple-xml.dylan
==============================================================================
--- trunk/libraries/xml-parser/simple-xml.dylan (original)
+++ trunk/libraries/xml-parser/simple-xml.dylan Sun May 14 18:57:04 2006
@@ -247,6 +247,28 @@
end for;
end method import-element;
+define generic prefix (object :: <object>) => (res :: <string>);
+define method prefix (element :: <element>)
+ => (res :: <string>);
+ prefix(element.name);
+end method prefix;
+
+define method prefix (name :: <string>)
+ => (res :: <string>);
+ split(name, ":")[0];
+end method prefix;
+
+define generic real-name (object :: <object>) => (res :: <string>);
+define method real-name (element :: <element>)
+ => (res :: <string>);
+ real-name(element.name);
+end method real-name;
+
+define method real-name (name :: <string>)
+ => (res :: <string>);
+ split(name, ":")[0];
+end method real-name;
+
define method namespace (element :: <element>)
=> (xmlns :: false-or(<string>));
let xmlns = attribute(element, "xmlns");
@@ -280,3 +302,12 @@
end if;
replace-element.text := escape-xml(text);
end method replace-element-text;
+
+define method start-tag (e :: <element>)
+ => (tag :: <string>);
+ let stream = make(<string-stream>, direction: #"output");
+ print-opening(e, *printer-state*, stream);
+ print-attributes(e.attributes, *printer-state*, stream);
+ print-closing("", stream);
+ stream-contents(stream);
+end method start-tag;
Modified: trunk/libraries/xmpp/client.dylan
==============================================================================
--- trunk/libraries/xmpp/client.dylan (original)
+++ trunk/libraries/xmpp/client.dylan Sun May 14 18:57:04 2006
@@ -3,8 +3,6 @@
author:
copyright:
-define variable *parser-depth* = 0;
-
define class <xmpp-client> (<object>)
slot jid :: <jid>,
required-init-keyword: jid:;
@@ -18,36 +16,39 @@
start-sockets();
client.socket := make(<tcp-socket>, host: client.jid.domain, port: port);
client.state := #"connected";
- make(<thread>, function: curry(listen, client));
+ make(<thread>, priority: $background-priority, function: curry(listen, client));
end method connect;
define method listen (client :: <xmpp-client>)
block ()
let stanza-complete? = #f;
+ let parser-depth = 0;
while (#t)
- let (received, found?) = read-to(client.socket, '>');
- received := concatenate(received, ">");
- format-out(">>> %=\n", received);
+ let (received, found?) = read-through(client.socket, '>');
+ format-out(">>> %s\n", received);
//XXX should strip spaces before first element!
if (found? & (received[0] = '<'))
//check xml-decl
let (index, processing-instruction) = scan-xml-decl(received);
if (processing-instruction)
- format-out("!!! %=: %=\n", object-class(processing-instruction), processing-instruction.name);
- end if;
+ format-out("!!! %=: %s\n", object-class(processing-instruction), processing-instruction.name);
+ end if;
// check if start
- format-out("!!! %=\n", "Check for element start");
-
- let (index, name) = scan-start-of-tag("<foo"); // scan-start-tag(received);
- if (name)
- format-out("!!! (start) %=\n", name);
- *parser-depth* := *parser-depth* + 1;
+ let (index, name, opened-element?) = scan-start-tag(received);
+ format-out("!!! %= %= %=\n", index, name, opened-element?);
+/* if (name)
+//format-out("!!! (start) %s - (current depth) %d\n", real-name(name), *parser-depth* + 1);
+// *parser-depth* := *parser-depth* + 1;
+ format-out("!!! started element: %=\n", name);
+ parser-depth := parser-depth + 1;
else
- format-out("!!! no start!\n");
+ format-out("!!! no start element started\n");
end if;
- format-out("%=\n", received);
+*/
+ format-out("!!! depth: %=\n", parser-depth);
+ else
+ format-out("!!! not found!");
end if;
-//dispatch(received);
end while;
exception (condition :: <condition>)
disconnect(client);
@@ -63,7 +64,7 @@
define method send (client :: <xmpp-client>, data)
write-line(client.socket, as(<string>, data));
force-output(client.socket);
- format-out("<<< %=\n", data);
+ format-out("<<< %s\n", data);
end method send;
define method password-setter (password, client :: <xmpp-client>)
@@ -72,11 +73,11 @@
password;
end method password-setter;
-define meta start-of-tag(elt-name, sym-name, attribs, s)
- => (sym-name, attribs)
- "<", scan-name(elt-name), scan-s?(s), scan-xml-attributes(attribs),
+/*
+define meta start-of-tag(elt-name, sym-name, attribs, s) => (elt-name, attribs)
+ "<", scan-name(elt-name), scan-s?(s), scan-xml-attributes(attribs), ">"
// (push(*tag-name-with-proper-capitalization*, elt-name)),
- set!(sym-name, as(<symbol>, elt-name))
+//set!(sym-name, as(<symbol>, elt-name))
end meta start-of-tag;
define meta start-tag
@@ -88,7 +89,7 @@
define meta end-tag (name, s) => (name)
"</", scan-name(name), scan-s?(s), ">"
end meta end-tag;
-
+*/
/*
define method valid-xmpp-data? (data :: <string>)
=> (res :: <boolean>);
@@ -99,4 +100,18 @@
end if;
end method valid-xmpp-data?;
*/
-//define method dispatch (
+
+/*
+define meta start-tag (elt-name, sym-name, attribs, s) => (elt-name, atts)
+ "<", scan-name(elt-name), scan-s?(s), scan-xml-attributes(attribs), ">"
+end meta start-tag;
+*/
+
+
+define collector maybe-elements (c) => (c)
+ loop([do(collect()])
+end collector maybe-element;
+
+define collector maybe-element (c) => (c)
+ "<", loop({[">", do(collect('>')), finish()], [accept(c), do(collect(c))]})
+end collector elements;
Modified: trunk/libraries/xmpp/xmpp-test/xmpp-test-exports.dylan
==============================================================================
--- trunk/libraries/xmpp/xmpp-test/xmpp-test-exports.dylan (original)
+++ trunk/libraries/xmpp/xmpp-test/xmpp-test-exports.dylan Sun May 14 18:57:04 2006
@@ -19,4 +19,6 @@
use simple-xml;
use xmpp;
use meta;
+ use %productions;
+ use printing;
end module;
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 Sun May 14 18:57:04 2006
@@ -4,7 +4,7 @@
copyright:
define function main(name :: <string>, #rest strings)
-
+// let 1 = 0;
/*
let jid = make(<jid>, domain: "foo");
format-out("%=, %=, %=\n", jid.node, jid.domain, jid.resource);
@@ -219,10 +219,8 @@
format-out("%=\n", test-document.node-children);
*/
-format-out("%=\n", parse-document("<stream:stream xmlns:stream='http://etherx.jabber.org/streams' id='4463ACD5' xmlns='jabber:client' from='192.168.0.1'></stream:stream>"));
-//start-sockets();
- let client = make(<xmpp-client>, jid: make(<jid>, node: "foo", domain: "192.168.0.1"));
+ let client = make(<xmpp-client>, jid: make(<jid>, node: "dylan", domain: "benkstein.net"));
let stream = make(<xmpp-stream>, to: client.jid.domain);
// connect(client);
@@ -245,16 +243,13 @@
end block;
*/
block()
- connect(client);
+ connect(client, port: 4222);
format-out("Connected to xmpp server at %s port: %d\n",
client.socket.remote-host.host-name,
client.socket.remote-port);
- send(client, stream);
+ send(client, start-tag(stream));
while (#t)
-//foo
end while;
-
-//close(client-socket);
disconnect(client);
format-out("Connection closed. Bye\n");
exception (condition :: <condition>)
@@ -291,10 +286,7 @@
*/
exit-application(0);
end function main;
-/*
-define meta positions (space) => (space)
- "1", scan-s(space), "2", scan-s(space), "3", scan-s(space), "4"
-end meta positions;
-*/
+
+
// Invoke our main() function.
main(application-name(), application-arguments());
More information about the chatter
mailing list