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	wakaba	1.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;