diff --git a/lib/DJabberd/SAXHandler.pm b/lib/DJabberd/SAXHandler.pm
index faa5fcb..4a571d7 100644
--- a/lib/DJabberd/SAXHandler.pm
+++ b/lib/DJabberd/SAXHandler.pm
@@ -188,7 +188,9 @@ sub _nodes_from_events {
push @$nodelist, DJabberd::XMLElement->new($ev->[1]{NamespaceURI},
$ev->[1]{LocalName},
$attr,
- _nodes_from_events($evlist, $start_idx, $end_idx));
+ _nodes_from_events($evlist, $start_idx, $end_idx),
+ undef,
+ $ev->[1]{Prefix});
next;
}
diff --git a/lib/DJabberd/XMLElement.pm b/lib/DJabberd/XMLElement.pm
index 94f1b12..0350592 100644
--- a/lib/DJabberd/XMLElement.pm
+++ b/lib/DJabberd/XMLElement.pm
@@ -7,6 +7,7 @@ use fields (
'children', # arrayref of child elements of this same type, or scalars for text nodes
'raw', # in some cases we have the raw xml and we have to create a fake XMLElement object
# business logic is that as_xml returns the raw stuff if it is exists, children has to be empty -- sky
+ 'prefix', # namepace prefix in use in this element
);
use DJabberd::Util;
@@ -23,7 +24,9 @@ sub new {
($self->{ns},
$self->{element},
$self->{attrs},
- $self->{children}) = @_;
+ $self->{children},
+ $self->{raw},
+ $self->{prefix}) = @_;
#my ($ns, $elementname, $attrs, $children) = @_;
#Carp::confess("children isn't an arrayref, is: $children") unless ref $children eq "ARRAY";
@@ -107,35 +110,92 @@ sub namespace {
return $self->{ns};
}
+sub _resolve_prefix {
+ my ($self, $nsmap, $def_ns, $uri, $attr) = @_;
+ if ($def_ns && $def_ns eq $uri) {
+ return '';
+ } elsif ($uri eq '') {
+ return '';
+ } elsif ($nsmap->{$uri}) {
+ $nsmap->{$uri}.':';
+ } else {
+ $nsmap->{___prefix_count} ||= 0;
+ my $count = $nsmap->{___prefix_count}++;
+ my $prefix = "nsp$count";
+ $nsmap->{$uri} = $prefix;
+ $nsmap->{$prefix} = $uri;
+ $attr->{'{http://www.w3.org/2000/xmlns}'.$prefix} = $uri;
+ return $prefix.':';
+ }
+}
+
sub as_xml {
my DJabberd::XMLElement $self = shift;
- my $nsmap = shift || {}; # localname -> uri, uri -> localname
- my $def_ns = shift;
+
+ my $nsmap = shift || { }; # localname -> uri, uri -> localname
+
+ # tons of places call as_xml, but nobody seems to care about
+ # the default namespace. It seems, however, that it is a common
+ # usage for "jabber:client" to be this default ns.
+ my $def_ns = shift || 'jabber:client';
my ($ns, $el) = ($self->{ns}, $self->{element});
+ if ($self->{prefix}) {
+ $nsmap->{$self->{prefix}} = $ns;
+ $nsmap->{$ns} = $self->{prefix};
+ }
my $attr_str = "";
my $attr = $self->{attrs};
+
+ $nsmap->{xmlns} = 'http://www.w3.org/2000/xmlns';
+ $nsmap->{'http://www.w3.org/2000/xmlns'} = 'xmlns';
+
+ # let's feed the nsmap...
+ foreach my $k (keys %$attr) {
+ if ($k =~ /^\{(.*)\}(.+)$/) {
+ my ($nsuri, $name) = ($1, $2);
+ if ($nsuri eq 'xmlns' ||
+ $nsuri eq 'http://www.w3.org/2000/xmlns/') {
+ $nsmap->{$name} = $attr->{$k};
+ $nsmap->{$attr->{$k}} = $name;
+ } elsif ($k eq '{}xmlns') {
+ $def_ns = $attr->{$k};
+ }
+ } elsif ($k eq 'xmlns') {
+ $def_ns = $attr->{$k};
+ }
+ }
+
+ my $nsprefix = $self->_resolve_prefix($nsmap, $def_ns, $ns, $attr);
+
foreach my $k (keys %$attr) {
- next if $k eq "{}xmlns";
- my $value = $attr->{$k};
- # FIXME: ignoring all namespaces on attributes
- $k =~ s!^\{(.*)\}!!;
- my $ns = $1;
- $attr_str .= " $k='" . DJabberd::Util::exml($value) . "'";
+ my $value = $attr->{$k};
+ if ($k =~ /^\{(.*)\}(.+)$/) {
+ my ($nsuri, $name) = ($1, $2);
+ if ($nsuri eq 'xmlns' ||
+ $nsuri eq 'http://www.w3.org/2000/xmlns/') {
+ $attr_str .= " xmlns:$name=\"" . DJabberd::Util::exml($value) . "\"";
+ } elsif ($k eq '{}xmlns') {
+ $attr_str .= " xmlns=\"".DJabberd::Util::exml($value)."\"";
+ } else {
+ my $nsprefix = $self->_resolve_prefix($nsmap, $def_ns, $nsuri);
+ $attr_str .= " $nsprefix$name=\"".DJabberd::Util::exml($value)."\"";
+ }
+ } else {
+ $attr_str .= " $k=\"" . DJabberd::Util::exml($value) . "\"";
+ }
}
- my $xmlns = (!$ns ||
- ($def_ns && $ns eq $def_ns) ||
- $ns eq "jabber:server" ||
- $ns eq "jabber:component:accept" ||
- $ns eq "jabber:client") ?
- "" : " xmlns='$ns'";
- my $innards = $self->innards_as_xml($nsmap, $ns, $def_ns);
+ my $innards = $self->innards_as_xml($nsmap, $def_ns);
$innards = "..." if $DJabberd::ASXML_NO_INNARDS && $innards;
- return length $innards ?
- "<$el$xmlns$attr_str>$innards$el>" :
- "<$el$xmlns$attr_str/>";
+
+ my $result = length $innards ?
+ "<$nsprefix$el$attr_str>$innards$nsprefix$el>" :
+ "<$nsprefix$el$attr_str/>";
+
+ return $result;
+
}
sub innards_as_xml {
@@ -170,6 +230,7 @@ sub clone {
$clone->{attrs} = { %{ $self->{attrs} } };
$clone->{children} = [ map { ref($_) ? $_->clone : $_ } @{ $self->{children} } ];
$clone->{raw} = $self->{raw};
+ $clone->{prefix} = $self->{prefix};
return $clone;
}
diff --git a/t/disco.t b/t/disco.t
index 67a488d..702fb4d 100644
--- a/t/disco.t
+++ b/t/disco.t
@@ -17,7 +17,7 @@ once_logged_in(sub {
");
- like($pa->recv_xml, qr{}, "Say we are a server");
+ like($pa->recv_xml, qr{}, "Say we are a server");
$pa->send_xml(qq{
});
- like($pa->recv_xml, qr{}, "We dont currently return anything");
+ like($pa->recv_xml, qr{}, "We dont currently return anything");
});
diff --git a/t/features-hook.t b/t/features-hook.t
index 18f2f62..a55f115 100644
--- a/t/features-hook.t
+++ b/t/features-hook.t
@@ -51,7 +51,7 @@ sub connect_and_get_features{
{
my $features = connect_and_get_features($client);
- is("",
+ is("",
$features, "should get features, including auth and nothing else");
}
$server->kill;
@@ -97,10 +97,10 @@ sub connect_and_get_features{
{
my $features = connect_and_get_features($client);
- is("".
- "".
- "".
- "",
+ is("".
+ "".
+ "".
+ "",
$features, "should get features, including auth and starttls");
}
$server->kill;
@@ -136,10 +136,10 @@ sub connect_and_get_features{
{
my $features = connect_and_get_features($client);
- is("".
- "".
+ is("".
+ "".
"".
- "",
+ "",
$features, "should get features, including auth and starttls");
}
$server->kill;
diff --git a/t/handle-stanza-hook.t b/t/handle-stanza-hook.t
index 6bf5dc6..f781b5e 100644
--- a/t/handle-stanza-hook.t
+++ b/t/handle-stanza-hook.t
@@ -69,7 +69,7 @@ my $client = Test::DJabberd::Client->new(server => $server, name => "client");
$client->send_xml(qq{});
# should get a stream error
is($client->recv_xml,
- "",
+ "",
"should get a stream error for bogus stanza");
pass "Done";
diff --git a/t/lib/djabberd-test.pl b/t/lib/djabberd-test.pl
index 8265789..79d5478 100644
--- a/t/lib/djabberd-test.pl
+++ b/t/lib/djabberd-test.pl
@@ -556,7 +556,7 @@ sub connect {
my $features = $self->recv_xml;
warn "FEATURES: $features" if $ENV{TESTDEBUG};
- die "no features" unless $features =~ /^recv_xml;
- like($xml, qr{}, "iq vcard query");
+ like($xml, qr{}, "iq vcard query");
like($xml, qr{\btype=.get\b}, "is a get");
# now we'll make pb be the broken libgaim. note the bogus from address.
diff --git a/t/xmlnamespace.t b/t/xmlnamespace.t
new file mode 100644
index 0000000..1db13eb
--- /dev/null
+++ b/t/xmlnamespace.t
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+use strict;
+use Test::More tests => 8;
+use lib 't/lib';
+
+require 'djabberd-test.pl';
+
+two_parties(sub {
+ my ($pa, $pb) = @_;
+ $pa->login;
+ $pb->login;
+
+ # now pa/pb send presence to become available resources
+ $pa->send_xml("");
+ $pb->send_xml("");
+ select(undef, undef, undef, 0.25);
+
+ # PA to PB
+ $pa->send_xml(qq{});
+
+ my $msg = $pb->recv_xml;
+ like($msg, qr/SOAP-ENV:Envelope/, "pb got Envelope in the correct prefix");
+ like($msg, qr/xmlns:SOAP-ENV/, "pb got SOAP-ENV prefix decl");
+ like($msg, qr/x0:foo/, "pb got foo in the correct prefix");
+ like($msg, qr/xmlns:x0/, "pb got x0 prefix decl");
+
+});
+