[Tkabber-dev] r1152 - in trunk/tkabber: . jabberlib-tclxml jabberlib-tclxml/tclxml

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Thu Jul 12 00:01:34 MSD 2007


Author: sergei
Date: 2007-07-12 00:01:33 +0400 (Thu, 12 Jul 2007)
New Revision: 1152

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/jabberlib-tclxml/jabberlib.tcl
   trunk/tkabber/jabberlib-tclxml/jlibcomponent.tcl
   trunk/tkabber/jabberlib-tclxml/namespaces.tcl
   trunk/tkabber/jabberlib-tclxml/tclxml/sgmlparser.tcl
Log:
	* jabberlib-tclxml/tclxml/sgmlparser.tcl,
	  jabberlib-tclxml/namespaces.tcl,
	  jabberlib-tclxml/jabberlib.tcl,
	  jabberlib-tclxml/jlibcomponent.tcl: Made XML namespace prefixes
	  converted to xmlns attributes. Still ignore invalid prefixes.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-07-10 09:17:13 UTC (rev 1151)
+++ trunk/tkabber/ChangeLog	2007-07-11 20:01:33 UTC (rev 1152)
@@ -1,3 +1,11 @@
+2007-07-11  Sergei Golovan  <sgolovan at nes.ru>
+
+	* jabberlib-tclxml/tclxml/sgmlparser.tcl,
+	  jabberlib-tclxml/namespaces.tcl,
+	  jabberlib-tclxml/jabberlib.tcl,
+	  jabberlib-tclxml/jlibcomponent.tcl: Made XML namespace prefixes
+	  converted to xmlns attributes. Still ignore invalid prefixes.
+
 2007-07-09  Sergei Golovan  <sgolovan at nes.ru>
 
 	* hooks.tcl: Allowed hook priority to take real value instead of

Modified: trunk/tkabber/jabberlib-tclxml/jabberlib.tcl
===================================================================
--- trunk/tkabber/jabberlib-tclxml/jabberlib.tcl	2007-07-10 09:17:13 UTC (rev 1151)
+++ trunk/tkabber/jabberlib-tclxml/jabberlib.tcl	2007-07-11 20:01:33 UTC (rev 1152)
@@ -1138,11 +1138,15 @@
 		eval [list client presence $connid $from $type $x] $param
 	    }
 	}
-	stream:error {
-	    parse_stream_error $connid $xmldata
+	error {
+	    if {[wrapper:getattr $vars xmlns] == $::NS(stream)} {
+		parse_stream_error $connid $xmldata
+	    }
 	}
-	stream:features {
-	    parse_stream_features $connid $children
+	features {
+	    if {[wrapper:getattr $vars xmlns] == $::NS(stream)} {
+		parse_stream_features $connid $children
+	    }
 	}
     }
 }

Modified: trunk/tkabber/jabberlib-tclxml/jlibcomponent.tcl
===================================================================
--- trunk/tkabber/jabberlib-tclxml/jlibcomponent.tcl	2007-07-10 09:17:13 UTC (rev 1151)
+++ trunk/tkabber/jabberlib-tclxml/jlibcomponent.tcl	2007-07-11 20:01:33 UTC (rev 1152)
@@ -61,7 +61,7 @@
 
     jlib::register_element $state(-connid) handshake \
 	[list [namespace code parse] $token]
-    jlib::register_element $state(-connid) stream:error \
+    jlib::register_element $state(-connid) error \
 	[list [namespace code parse] $token]
     
     return $token
@@ -76,7 +76,7 @@
     ::LOG "(jlibcomponent::free $token)"
 
     jlib::unregister_element $state(-connid) handshake
-    jlib::unregister_element $state(-connid) stream:error
+    jlib::unregister_element $state(-connid) error
 
     catch { unset state }
     catch { rename $token "" }
@@ -114,8 +114,10 @@
 	handshake {
 	    finish $token OK {}
 	}
-	stream:error {
-	    finish $token ERR [streamerror:message $xmldata]
+	error {
+	    if {[wrapper:getattr $vars xmlns] = $::NS(stream)} {
+		finish $token ERR [streamerror:message $xmldata]
+	    }
 	}
     }
 }
@@ -162,7 +164,7 @@
 
     # Unregister elements after handshake
     jlib::unregister_element $state(-connid) handshake
-    jlib::unregister_element $state(-connid) stream:error
+    jlib::unregister_element $state(-connid) error
 
     if {[info exists state(-command)]} {
 	uplevel #0 $state(-command) [list $res $msg]

Modified: trunk/tkabber/jabberlib-tclxml/namespaces.tcl
===================================================================
--- trunk/tkabber/jabberlib-tclxml/namespaces.tcl	2007-07-10 09:17:13 UTC (rev 1151)
+++ trunk/tkabber/jabberlib-tclxml/namespaces.tcl	2007-07-11 20:01:33 UTC (rev 1152)
@@ -15,6 +15,7 @@
 
 namespace eval :: {
     array set NS [list \
+	stream	    "http://etherx.jabber.org/streams" \
 	tls	    "urn:ietf:params:xml:ns:xmpp-tls" \
 	sasl	    "urn:ietf:params:xml:ns:xmpp-sasl" \
 	bind	    "urn:ietf:params:xml:ns:xmpp-bind" \

Modified: trunk/tkabber/jabberlib-tclxml/tclxml/sgmlparser.tcl
===================================================================
--- trunk/tkabber/jabberlib-tclxml/tclxml/sgmlparser.tcl	2007-07-10 09:17:13 UTC (rev 1151)
+++ trunk/tkabber/jabberlib-tclxml/tclxml/sgmlparser.tcl	2007-07-11 20:01:33 UTC (rev 1152)
@@ -902,7 +902,7 @@
 		if {[string first > $elemText] >= 0} {
 
 		    # Now piece the attribute list back together
-		    regexp ($Name)[cl $Wsp]*=[cl $Wsp]*("|')(.*) $brokenattr discard attname delimiter attvalue
+		    regexp ($Name)[cl $Wsp]*=[cl $Wsp]*(\"|')(.*) $brokenattr discard attname delimiter attvalue
 		    regexp (.*)>([cl ^>]*)\$ $elemText discard remattlist elemText
 		    regexp ([cl ^$delimiter]*)${delimiter}(.*) $remattlist discard remattvalue remattlist
 
@@ -936,52 +936,63 @@
     # Check for namespace declarations
     upvar #0 $options(namespaces) namespaces
     set nsdecls {}
-#    if {[llength $attr]} {
-#	array set attrlist $attr
-#	foreach {attrName attrValue} [array get attrlist xmlns*] {
-#	    unset attrlist($attrName)
-#	    set colon [set prefix {}]
-#	    if {[regexp {^xmlns(:(.+))?$} $attrName discard colon prefix]} {
-#		switch -glob [string length $colon],[string length $prefix] {
-#		    0,0 {
-#			# default NS declaration
-#			lappend state(defaultNSURI) $attrValue
-#			lappend state(defaultNS) [llength $state(stack)]
-#			lappend nsdecls $attrValue {}
-#		    }
-#		    0,* {
-#			# Huh?
-#		    }
-#		    *,0 {
-#			# Error
-#			uplevel #0 $state(-warningcommand) "no prefix specified for namespace URI \"$attrValue\" in element \"$tag\""
-#		    }
-#		    default {
-#			set namespaces($prefix,[llength $state(stack)]) $attrValue
-#			lappend nsdecls $attrValue $prefix
-#		    }
-#		}
-#	    }
-#	}
-#	if {[llength $nsdecls]} {
-#	    set nsdecls [list -namespacedecls $nsdecls]
-#	}
-#	set attr [array get attrlist]
-#    }
+    if {[llength $attr]} {
+	array set attrlist $attr
+	foreach {attrName attrValue} [array get attrlist xmlns*] {
+	    unset attrlist($attrName)
+	    set colon [set prefix {}]
+	    if {[regexp {^xmlns(:(.+))?$} $attrName discard colon prefix]} {
+		switch -glob [string length $colon],[string length $prefix] {
+		    *,0 -
+		    0,0 {
+			# *,0 is a HACK: Ignore empty namespace prefix
+			# TODO: investigate it
+			# default NS declaration
+			lappend state(defaultNSURI) $attrValue
+			lappend state(defaultNS) [llength $state(stack)]
+			lappend nsdecls $attrValue {}
+		    }
+		    0,* {
+			# Huh?
+		    }
+		    *,0 {
+			# Error
+			uplevel #0 $state(-warningcommand) \
+			    "no prefix specified for namespace URI \"$attrValue\" in element \"$tag\""
+		    }
+		    default {
+			set namespaces($prefix,[llength $state(stack)]) $attrValue
+			lappend nsdecls $attrValue $prefix
+		    }
+		}
+	    }
+	}
+	if {[llength $nsdecls]} {
+	    set nsdecls [list -namespacedecls $nsdecls]
+	}
+	set attr [array get attrlist]
+    }
 
     # Check whether this element has an expanded name
     set ns {}
-#    if {[regexp {([^:]+):(.*)$} $tag discard prefix tag]} {
-#	set nsspec [lsort -dictionary -decreasing [array names namespaces $prefix,*]]
-#	if {[llength $nsspec]} {
-#	    set nsuri $namespaces([lindex $nsspec 0])
-#	    set ns [list -namespace $nsuri]
-#	} else {
-#	    uplevel #0 $options(-errorcommand) [list namespaceundeclared "no namespace declared for prefix \"$prefix\" in element $tag"]
-#	}
-#    } elseif {[llength $state(defaultNSURI)]} {
-#	set ns [list -namespace [lindex $state(defaultNSURI) end]]
-#    }
+    if {[regexp {([^:]+):(.*)$} $tag discard prefix tag1]} {
+	set nsspec [lsort -dictionary -decreasing [array names namespaces $prefix,*]]
+	if {[llength $nsspec]} {
+	    set tag tag1
+	    set nsuri $namespaces([lindex $nsspec 0])
+	    set ns [list -namespace $nsuri]
+	} else {
+	    # HACK: ignore undeclared namespace (and replace it by default one)
+	    # TODO: investigate it
+	    #uplevel #0 $options(-errorcommand) \
+	    #	[list namespaceundeclared "no namespace declared for prefix \"$prefix\" in element $tag"]
+	    if {[llength $state(defaultNSURI)]} {
+		set ns [list -namespace [lindex $state(defaultNSURI) end]]
+	    }
+	}
+    } elseif {[llength $state(defaultNSURI)]} {
+	set ns [list -namespace [lindex $state(defaultNSURI) end]]
+    }
 
     # Invoke callback
     set code [catch {uplevel #0 $options(-elementstartcommand) [list $tag $attr] $empty $ns $nsdecls} msg]



More information about the Tkabber-dev mailing list