manakai/t/markup-xml-qname.t

#!/usr/bin/perl
use strict;
require Test::Simple;
require Message::Markup::XML;
use Message::Markup::XML::QName qw/UNDEF_URI NULL_URI DEFAULT_PFX/;
sub ok ($;$);
my $e = new Message::Markup::XML (type => '#element', local_name => 'test',
                                  namespace_uri => 'http://something.test/');

my @reg_p2n = (
               {
                prefix => q(test1),
                name   => q(http://test1.example/),
                result => 1,
               },
               {
                prefix => q(test1),
                name   => q(http://test1.example/),
                result => 1,
               },
               {
                prefix => q(test1),
                name   => q(http://test1.example/),
                opt    => {check_registered => 1},
                result => 1,
               },
               {
                prefix => q(test1),
                name   => q(http://test2.example/),
                opt    => {check_registered => 1},
                result => 0,
               },
               {
                prefix => q(test1),
                name   => q(http://test2.example/),
                result => 1,
               },
               {
                prefix => q(test1),
                name   => q(),
                result => 0,
               },
               {
                prefix => q(test1),
                name   => NULL_URI,
                result => 0,
               },
               {
                prefix => q(#default),
                name   => q(http://test2.example/),
                result => 1,
               },
               {
                prefix => DEFAULT_PFX,
                name   => q(http://test2.example/),
                result => 1,
               },
               {
                prefix => DEFAULT_PFX,
                name   => NULL_URI,
                result => 1,
               },
               {
                prefix => q:some-prefix:,
                name   => UNDEF_URI,
                result => 0,
               },
               {
                prefix => q:some-prefix:,
                name   => q<http://uri.test/>,
                opt    => {check_prefix => 1},
                result => 1,
               },
               {
                prefix => q:some invalid prefix:,
                name   => q<http://uri.test/>,
                opt    => {check_prefix => 1},
                result => 0,
               },
               {
                prefix => q:some-prefix-11:,
                name   => q<http://uri.test/>,
                opt    => {check_name => 1},
                result => 1,
               },
               {
                prefix => q:some-prefix-21:,
                name   => q<relative-uri>,
                opt    => {check_name => 1, check_name_uri_relative => 1},
                result => 0,
               },
               {
                prefix => q:some-prefix-31:,
                name   => q<relative-uri>,
                opt    => {check_name => 1, resolve_name_uri_relative => 1},
                result => 1,
               },
);

my @get_p2n = (
               {
                prefix => q:prefix-1.:,
                name   => q<http://foo.test/>,
                result => 1,
               },
               {
                prefix => q:prefix-2.:,
                name   => q<http://foo2.test/>,
                opt    => {___dont_register => 1},
                result => 0,
               },
               {
                prefix => q:prefix-2.:,
                name   => NULL_URI,
                opt    => {___dont_register => 1},
                result => 0,
               },
               {
                prefix => q:prefix-2.:,
                name   => UNDEF_URI,
                opt    => {___dont_register => 1},
                result => 0,
               },
               {
                prefix => DEFAULT_PFX,
                name   => UNDEF_URI,
                opt    => {___dont_register => 1},
                result => 0,
               },
               {
                prefix => DEFAULT_PFX,
                name   => NULL_URI,
                result => 0,
               },
               {
                prefix => DEFAULT_PFX,
                name   => NULL_URI,
                opt    => {use_name_null => 1, use_prefix_default => 1},
                result => 1,
               },
               {
                prefix => DEFAULT_PFX,
                name   => NULL_URI,
                opt    => {___dont_register => 1},
                result => 0,
               },
               {
                prefix => DEFAULT_PFX,
                name   => NULL_URI,
                opt    => {use_name_null => 1, use_prefix_default => 1,
                           ___dont_register => 1},
                result => 1,
               },
);

my @qname = (
             {
              qname  => q"foo",
              prefix => DEFAULT_PFX,
              lname  => q"foo",
              result => 1,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1},
             },
             {
              qname  => q"foo:bar",
              prefix => q"foo",
              lname  => q"bar",
              result => 1,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1},
             },
             {
              qname  => q"foo:0",
              prefix => q"foo",
              lname  => q"0",
              result => 0,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1},
             },
             {
              qname  => q"0:bar",
              prefix => q"0",
              lname  => q"bar",
              result => 0,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1},
             },
             {
              qname  => q"foo:",
              prefix => q"foo",
              lname  => q"",
              result => 0,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1},
             },
             {
              qname  => q":bar",
              prefix => q"",
              lname  => q"bar",
              result => 0,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1},
             },
             {
              qname  => q"*",
              prefix => DEFAULT_PFX,
              lname  => q"*",
              result => 1,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1, use_local_name_star => 1},
             },
             {
              qname  => q"foo:*",
              prefix => q"foo",
              lname  => q"*",
              result => 1,
              opt    => {check_qname => 1, check_prefix => 1,
                         check_local_name => 1, use_local_name_star => 1},
             },
);

Test::Simple->import (tests => scalar (@reg_p2n)
                             + scalar (@get_p2n) * 2
                             + scalar (@qname) * 2);

for (@reg_p2n) {
  my $chk = Message::Markup::XML::QName::register_prefix_to_name
    ($e, $_->{prefix} => $_->{name}, %{$_->{opt}||{}});
  ok ($chk->{success} == $_->{result}, $chk->{reason});
}
               
for (@get_p2n) {
  $e->{ns} = {};
  my $chk = Message::Markup::XML::QName::register_prefix_to_name
    ($e, $_->{prefix} => $_->{name}, %{$_->{opt}||{}})
      unless $_->{opt}->{___dont_register};
  ok (Message::Markup::XML::QName::prefix_to_name ($e, $_->{prefix},
                                                   %{$_->{opt}||{}})
      ->{name}
      eq ($_->{result} ? ($_->{result_name} || $_->{name}) : undef),
      ":$_->{prefix}: => <@{[$_->{result} ? ($_->{result_name} || $_->{name}) : undef]}>");
  ok (Message::Markup::XML::QName::name_to_prefix ($e, $_->{name},
                                                   %{$_->{opt}||{}})
      ->{prefix}
      eq ($_->{result} ? ($_->{result_prefix} || $_->{prefix}) : undef),
      "<$_->{name}> => :@{[$_->{result} ? ($_->{result_prefix} || $_->{prefix}) : undef]}:");
}

               
for (@qname) {
  my $chk = Message::Markup::XML::QName::split_qname ($_->{qname},
                                                      %{$_->{opt}||{}});
  if ($_->{result}) {
    ok $chk->{prefix}.':'.($chk->{local_name_star} ? '*' : $chk->{local_name})
    eq $_->{prefix} . ':' . $_->{lname},
      "$chk->{prefix}:$chk->{local_name}($chk->{local_name_star})";
  } else {
    ok $chk->{success} == $_->{result},
      "$chk->{prefix}:$chk->{local_name}($chk->{local_name_star})";
  }
  
  $chk = Message::Markup::XML::QName::join_qname
    ($_->{prefix}, $_->{lname}, %{$_->{opt}||{}});
  if ($_->{result}) {
    ok $chk->{qname} eq $_->{qname}, $chk->{qname};
  } else {
    ok $chk->{success} == $_->{result}, $chk->{qname};
  }
}

print $e;
1	#!/usr/bin/perl
2	use strict;
3	require Test::Simple;
4	require Message::Markup::XML;
5	use Message::Markup::XML::QName qw/UNDEF_URI NULL_URI DEFAULT_PFX/;
6	sub ok ($;$);
7	my $e = new Message::Markup::XML (type => '#element', local_name => 'test',
8	namespace_uri => 'http://something.test/');
9
10	my @reg_p2n = (
11	{
12	prefix => q(test1),
13	name => q(http://test1.example/),
14	result => 1,
15	},
16	{
17	prefix => q(test1),
18	name => q(http://test1.example/),
19	result => 1,
20	},
21	{
22	prefix => q(test1),
23	name => q(http://test1.example/),
24	opt => {check_registered => 1},
25	result => 1,
26	},
27	{
28	prefix => q(test1),
29	name => q(http://test2.example/),
30	opt => {check_registered => 1},
31	result => 0,
32	},
33	{
34	prefix => q(test1),
35	name => q(http://test2.example/),
36	result => 1,
37	},
38	{
39	prefix => q(test1),
40	name => q(),
41	result => 0,
42	},
43	{
44	prefix => q(test1),
45	name => NULL_URI,
46	result => 0,
47	},
48	{
49	prefix => q(#default),
50	name => q(http://test2.example/),
51	result => 1,
52	},
53	{
54	prefix => DEFAULT_PFX,
55	name => q(http://test2.example/),
56	result => 1,
57	},
58	{
59	prefix => DEFAULT_PFX,
60	name => NULL_URI,
61	result => 1,
62	},
63	{
64	prefix => q:some-prefix:,
65	name => UNDEF_URI,
66	result => 0,
67	},
68	{
69	prefix => q:some-prefix:,
70	name => q<http://uri.test/>,
71	opt => {check_prefix => 1},
72	result => 1,
73	},
74	{
75	prefix => q:some invalid prefix:,
76	name => q<http://uri.test/>,
77	opt => {check_prefix => 1},
78	result => 0,
79	},
80	{
81	prefix => q:some-prefix-11:,
82	name => q<http://uri.test/>,
83	opt => {check_name => 1},
84	result => 1,
85	},
86	{
87	prefix => q:some-prefix-21:,
88	name => q<relative-uri>,
89	opt => {check_name => 1, check_name_uri_relative => 1},
90	result => 0,
91	},
92	{
93	prefix => q:some-prefix-31:,
94	name => q<relative-uri>,
95	opt => {check_name => 1, resolve_name_uri_relative => 1},
96	result => 1,
97	},
98	);
99
100	my @get_p2n = (
101	{
102	prefix => q:prefix-1.:,
103	name => q<http://foo.test/>,
104	result => 1,
105	},
106	{
107	prefix => q:prefix-2.:,
108	name => q<http://foo2.test/>,
109	opt => {___dont_register => 1},
110	result => 0,
111	},
112	{
113	prefix => q:prefix-2.:,
114	name => NULL_URI,
115	opt => {___dont_register => 1},
116	result => 0,
117	},
118	{
119	prefix => q:prefix-2.:,
120	name => UNDEF_URI,
121	opt => {___dont_register => 1},
122	result => 0,
123	},
124	{
125	prefix => DEFAULT_PFX,
126	name => UNDEF_URI,
127	opt => {___dont_register => 1},
128	result => 0,
129	},
130	{
131	prefix => DEFAULT_PFX,
132	name => NULL_URI,
133	result => 0,
134	},
135	{
136	prefix => DEFAULT_PFX,
137	name => NULL_URI,
138	opt => {use_name_null => 1, use_prefix_default => 1},
139	result => 1,
140	},
141	{
142	prefix => DEFAULT_PFX,
143	name => NULL_URI,
144	opt => {___dont_register => 1},
145	result => 0,
146	},
147	{
148	prefix => DEFAULT_PFX,
149	name => NULL_URI,
150	opt => {use_name_null => 1, use_prefix_default => 1,
151	___dont_register => 1},
152	result => 1,
153	},
154	);
155
156	my @qname = (
157	{
158	qname => q"foo",
159	prefix => DEFAULT_PFX,
160	lname => q"foo",
161	result => 1,
162	opt => {check_qname => 1, check_prefix => 1,
163	check_local_name => 1},
164	},
165	{
166	qname => q"foo:bar",
167	prefix => q"foo",
168	lname => q"bar",
169	result => 1,
170	opt => {check_qname => 1, check_prefix => 1,
171	check_local_name => 1},
172	},
173	{
174	qname => q"foo:0",
175	prefix => q"foo",
176	lname => q"0",
177	result => 0,
178	opt => {check_qname => 1, check_prefix => 1,
179	check_local_name => 1},
180	},
181	{
182	qname => q"0:bar",
183	prefix => q"0",
184	lname => q"bar",
185	result => 0,
186	opt => {check_qname => 1, check_prefix => 1,
187	check_local_name => 1},
188	},
189	{
190	qname => q"foo:",
191	prefix => q"foo",
192	lname => q"",
193	result => 0,
194	opt => {check_qname => 1, check_prefix => 1,
195	check_local_name => 1},
196	},
197	{
198	qname => q":bar",
199	prefix => q"",
200	lname => q"bar",
201	result => 0,
202	opt => {check_qname => 1, check_prefix => 1,
203	check_local_name => 1},
204	},
205	{
206	qname => q"*",
207	prefix => DEFAULT_PFX,
208	lname => q"*",
209	result => 1,
210	opt => {check_qname => 1, check_prefix => 1,
211	check_local_name => 1, use_local_name_star => 1},
212	},
213	{
214	qname => q"foo:*",
215	prefix => q"foo",
216	lname => q"*",
217	result => 1,
218	opt => {check_qname => 1, check_prefix => 1,
219	check_local_name => 1, use_local_name_star => 1},
220	},
221	);
222
223	Test::Simple->import (tests => scalar (@reg_p2n)
224	+ scalar (@get_p2n) * 2
225	+ scalar (@qname) * 2);
226
227	for (@reg_p2n) {
228	my $chk = Message::Markup::XML::QName::register_prefix_to_name
229	($e, $_->{prefix} => $_->{name}, %{$_->{opt}\|\|{}});
230	ok ($chk->{success} == $_->{result}, $chk->{reason});
231	}
232
233	for (@get_p2n) {
234	$e->{ns} = {};
235	my $chk = Message::Markup::XML::QName::register_prefix_to_name
236	($e, $_->{prefix} => $_->{name}, %{$_->{opt}\|\|{}})
237	unless $_->{opt}->{___dont_register};
238	ok (Message::Markup::XML::QName::prefix_to_name ($e, $_->{prefix},
239	%{$_->{opt}\|\|{}})
240	->{name}
241	eq ($_->{result} ? ($_->{result_name} \|\| $_->{name}) : undef),
242	":$_->{prefix}: => <@{[$_->{result} ? ($_->{result_name} \|\| $_->{name}) : undef]}>");
243	ok (Message::Markup::XML::QName::name_to_prefix ($e, $_->{name},
244	%{$_->{opt}\|\|{}})
245	->{prefix}
246	eq ($_->{result} ? ($_->{result_prefix} \|\| $_->{prefix}) : undef),
247	"<$_->{name}> => :@{[$_->{result} ? ($_->{result_prefix} \|\| $_->{prefix}) : undef]}:");
248	}
249
250
251	for (@qname) {
252	my $chk = Message::Markup::XML::QName::split_qname ($_->{qname},
253	%{$_->{opt}\|\|{}});
254	if ($_->{result}) {
255	ok $chk->{prefix}.':'.($chk->{local_name_star} ? '*' : $chk->{local_name})
256	eq $_->{prefix} . ':' . $_->{lname},
257	"$chk->{prefix}:$chk->{local_name}($chk->{local_name_star})";
258	} else {
259	ok $chk->{success} == $_->{result},
260	"$chk->{prefix}:$chk->{local_name}($chk->{local_name_star})";
261	}
262
263	$chk = Message::Markup::XML::QName::join_qname
264	($_->{prefix}, $_->{lname}, %{$_->{opt}\|\|{}});
265	if ($_->{result}) {
266	ok $chk->{qname} eq $_->{qname}, $chk->{qname};
267	} else {
268	ok $chk->{success} == $_->{result}, $chk->{qname};
269	}
270	}
271
272	print $e;