[Gd-chatter] r10738 - in trunk/libraries: xml-parser xmpp xmpp/xmpp-test
turbo24prg at gwydiondylan.org
turbo24prg at gwydiondylan.org
Mon May 15 20:42:12 CEST 2006
Author: turbo24prg
Date: Mon May 15 20:42:09 2006
New Revision: 10738
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.dylan
Log:
Bug: 7313
* improved the parser
Modified: trunk/libraries/xml-parser/library.dylan
==============================================================================
--- trunk/libraries/xml-parser/library.dylan (original)
+++ trunk/libraries/xml-parser/library.dylan Mon May 15 20:42:09 2006
@@ -111,7 +111,7 @@
use xml-parser;
export scan-xml-decl, scan-name, scan-s?, scan-xml-attributes,
- scan-start-tag;
+ scan-start-tag, scan-end-tag;
end module %productions;
define module simple-xml
Modified: trunk/libraries/xml-parser/productions.dylan
==============================================================================
--- trunk/libraries/xml-parser/productions.dylan (original)
+++ trunk/libraries/xml-parser/productions.dylan Mon May 15 20:42:09 2006
@@ -443,7 +443,7 @@
end if, vector(content)),
elt-name, attribs, *modify?*))
scan-beginning-of-tag(elt-name, attribs),
- { [">", scan-content(content), scan-etag(etag)],
+ { [">", scan-content(content), scan-end-tag(etag)],
["/>", no!(*last-tag-name*), set!(content, "")] }
end meta element;
@@ -533,7 +533,7 @@
//
// [42] ETag ::= '</' Name S? '>'
//
-define meta etag(name, s) => (name)
+define meta end-tag(name, s) => (name)
"</", scan-name(name),
do(if(*last-tag-name* & *last-tag-name* ~== name)
maybe-tag-mismatch("Close tag does not match open tag",
@@ -541,7 +541,7 @@
name, *last-tag-name*),
index, string);
end if), no!(*last-tag-name*), scan-s?(s), ">"
-end meta etag;
+ end meta end-tag;
// Content of Elements
//
Modified: trunk/libraries/xml-parser/simple-xml.dylan
==============================================================================
--- trunk/libraries/xml-parser/simple-xml.dylan (original)
+++ trunk/libraries/xml-parser/simple-xml.dylan Mon May 15 20:42:09 2006
@@ -253,9 +253,9 @@
prefix(element.name);
end method prefix;
-define method prefix (name :: <string>)
+define method prefix (name :: type-union(<string>, <symbol>))
=> (res :: <string>);
- split(name, ":")[0];
+ split(as(<string>, name), ':')[0];
end method prefix;
define generic real-name (object :: <object>) => (res :: <string>);
@@ -264,9 +264,9 @@
real-name(element.name);
end method real-name;
-define method real-name (name :: <string>)
+define method real-name (name :: type-union(<string>, <symbol>))
=> (res :: <string>);
- split(name, ":")[0];
+ split(as(<string>, name), ':')[1];
end method real-name;
define method namespace (element :: <element>)
Modified: trunk/libraries/xmpp/client.dylan
==============================================================================
--- trunk/libraries/xmpp/client.dylan (original)
+++ trunk/libraries/xmpp/client.dylan Mon May 15 20:42:09 2006
@@ -16,44 +16,104 @@
start-sockets();
client.socket := make(<tcp-socket>, host: client.jid.domain, port: port);
client.state := #"connected";
+ format-out("TEST: %s\n", real-name("foo:bar"));
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-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("!!! %=: %s\n", object-class(processing-instruction), processing-instruction.name);
- end if;
-// check if start
- 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 element started\n");
- end if;
-*/
- format-out("!!! depth: %=\n", parser-depth);
- else
- format-out("!!! not found!");
- end if;
+// let parser-depth = 0;
+// let stream-initiated? = #f;
+ let parsing-tag? = #f;
+ let parser-buffer = "";
+
+ // keep watching that start tags match end tags
+ let tag-queue = make(<deque>);
+
+ while (~ stream-at-end?(client.socket))
+ let received = read-element(client.socket);
+
+ block(read-next)
+ if (parsing-tag? = #f)
+ if (received = '<')
+ parsing-tag? := #t;
+ parser-buffer := add!(parser-buffer, received);
+ read-next();
+ elseif (size(tag-queue) = 0 & 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");
+ end if;
+ else
+ if (received = '>')
+ // seems as we got an element
+ parser-buffer := add!(parser-buffer, received);
+ format-out(">>> %s\n", parser-buffer);
+
+ // could be the start tag of an element
+ let (index, start-tag, opened-element?) = scan-start-tag(parser-buffer);
+ if (start-tag & opened-element?)
+ format-out("!!! (start) %s (%s)\n", start-tag, real-name(start-tag));
+ // should be closed later
+ push-last(tag-queue, start-tag);
+ format-out("!!! now at depth: %d\n", size(tag-queue));
+ // dispatch();
+ parser-buffer := "";
+ parsing-tag? := #f;
+ read-next();
+ elseif (start-tag & ~ opened-element?)
+ format-out("!!! (empty) %s (%s)\n", start-tag, real-name(start-tag));
+ // dispatch();
+ parser-buffer := "";
+ parsing-tag? := #f;
+ read-next();
+ end if;
+
+ // could be the end tag of an element
+ let (index, end-tag, opened-element?) = scan-end-tag(parser-buffer);
+ if (end-tag)
+ format-out("!!! (end) %s (%s)\n", end-tag, real-name(end-tag));
+ // should close the last started tag
+ if (as(<symbol>, end-tag) = last(tag-queue))
+ format-out("!!! (successful end) %s (%s)\n", end-tag, real-name(end-tag));
+ pop-last(tag-queue);
+ format-out("!!! now at depth: %d\n", size(tag-queue));
+ // dispatch();
+ parser-buffer := "";
+ parsing-tag? := #f;
+ read-next();
+ else
+ //!!! error: not-well formed xml: start/end tag mismatch
+ format-out("!!! (WANTED end) %s (%s)\n", last(tag-queue), real-name(last(tag-queue)));
+ end if;
+ end if;
+
+ // could be a xml declaration
+ let (index, processing-instruction) = scan-xml-decl(parser-buffer);
+ if (processing-instruction)
+ format-out("!!! %=: %s\n", object-class(processing-instruction), processing-instruction.name);
+ parser-buffer := "";
+ parsing-tag? := #f;
+ read-next();
+ end if;
+
+ else
+ //XXX we allow everything in a tag
+ if (received ~= '\n')
+ parser-buffer := add!(parser-buffer, received);
+ end if;
+ read-next();
+ end if;
+ end if;
+ end block;
+
end while;
+ format-out("!!! OOOOHHHH! NOOOOO!");
exception (condition :: <condition>)
disconnect(client);
format-out("client: listen: Error: %=", condition);
end block;
+
end method listen;
define method disconnect (client :: <xmpp-client>)
@@ -107,11 +167,12 @@
end meta start-tag;
*/
-
+/*
define collector maybe-elements (c) => (c)
- loop([do(collect()])
+ loop([scan-maybe-element(c), do(collect(c))])
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.dylan
==============================================================================
--- trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan (original)
+++ trunk/libraries/xmpp/xmpp-test/xmpp-test.dylan Mon May 15 20:42:09 2006
@@ -4,7 +4,8 @@
copyright:
define function main(name :: <string>, #rest strings)
-// let 1 = 0;
+// format-out("%=\n", prefix("foo:bar"));
+// format-out("%=\n", real-name("foo:bar"));
/*
let jid = make(<jid>, domain: "foo");
format-out("%=, %=, %=\n", jid.node, jid.domain, jid.resource);
@@ -220,7 +221,7 @@
*/
- let client = make(<xmpp-client>, jid: make(<jid>, node: "dylan", domain: "benkstein.net"));
+ let client = make(<xmpp-client>, jid: make(<jid>, node: "dylan", domain: "192.168.0.2"));
let stream = make(<xmpp-stream>, to: client.jid.domain);
// connect(client);
@@ -243,7 +244,7 @@
end block;
*/
block()
- connect(client, port: 4222);
+ connect(client);
format-out("Connected to xmpp server at %s port: %d\n",
client.socket.remote-host.host-name,
client.socket.remote-port);
More information about the chatter
mailing list