/XML-Simple-2.20/t/8_Namespaces.t

  1
  2use strict;
  3use warnings;
  4use Test::More;
  5use File::Spec;
  6use IO::File;
  7
  8
  9eval { require XML::SAX; };
 10if($@) {
 11  plan skip_all => 'no XML::SAX';
 12}
 13
 14eval { require XML::NamespaceSupport; };
 15if($@) {
 16  plan skip_all => "no XML::NamespaceSupport";
 17}
 18if($XML::NamespaceSupport::VERSION < 1.04) {
 19  plan skip_all => "XML::NamespaceSupport is too old (upgrade to 1.04 or better)";
 20}
 21
 22plan tests => 8;
 23
 24
 25##############################################################################
 26#                   S U P P O R T   R O U T I N E S
 27##############################################################################
 28
 29##############################################################################
 30# Copy a file
 31#
 32
 33sub CopyFile {
 34  my($Src, $Dst) = @_;
 35
 36  open(IN, $Src) || return(undef);
 37  local($/) = undef;
 38  my $Data = <IN>;
 39  close(IN);
 40
 41  open(OUT, ">$Dst") || return(undef);
 42  print OUT $Data;
 43  close(OUT);
 44
 45  return(1);
 46}
 47
 48
 49##############################################################################
 50#                      T E S T   R O U T I N E S
 51##############################################################################
 52
 53use XML::Simple;
 54
 55# Force default behaviour of using SAX parser if it is available (which it
 56# is or we wouldn't be here).
 57
 58$XML::Simple::PREFERRED_PARSER = '';
 59
 60# Confirm that by default qnames are not expanded on input
 61
 62my $xml = q(<config xmlns:perl="http://www.perl.com/">
 63  <perl:list count="3" perl:type="array">
 64    <item>one</item>
 65    <item>two</item>
 66    <item>three</item>
 67    <test xmlns:perl="http://www.microsoft.com" perl:tm="trademark" />
 68  </perl:list>
 69</config>);
 70
 71my $expected = {
 72  'perl:list' => {
 73    'count' => '3',
 74    'item' => [
 75      'one',
 76      'two',
 77      'three'
 78    ],
 79    'perl:type' => 'array',
 80    'test' => {
 81      'xmlns:perl' => 'http://www.microsoft.com',
 82      'perl:tm' => 'trademark',
 83    }
 84  },
 85  'xmlns:perl' => 'http://www.perl.com/'
 86};
 87
 88my $opt = XMLin($xml);
 89is_deeply($opt, $expected, 'qnames are not expanded by default');
 90
 91
 92# Try again with nsexpand option set
 93
 94$expected = {
 95  '{http://www.perl.com/}list' => {
 96    'count' => '3',
 97    'item' => [
 98      'one',
 99      'two',
100      'three'
101    ],
102    '{http://www.perl.com/}type' => 'array',
103    'test' => {
104      '{http://www.microsoft.com}tm' => 'trademark',
105      '{http://www.w3.org/2000/xmlns/}perl' => 'http://www.microsoft.com'
106    }
107  },
108  '{http://www.w3.org/2000/xmlns/}perl' => 'http://www.perl.com/'
109};
110
111$opt = XMLin($xml, nsexpand => 1);
112is_deeply($opt, $expected, 'qnames are expanded on request');
113
114
115# Confirm that output expansion does not occur by default
116
117$opt = {
118  '{http://www.w3.org/2000/xmlns/}perl' => 'http://www.perl.com/',
119  '{http://www.perl.com/}attr' => 'value',
120  'bare' => 'Beer!',
121  '{http://www.perl.com/}element' => [ 'data' ],
122};
123
124$xml = XMLout($opt);
125like($xml, qr{
126  ^\s*<opt
127  (\s+{http://www.w3.org/2000/xmlns/}perl="http://www.perl.com/"
128  |\s+{http://www.perl.com/}attr="value"
129  |\s+bare="Beer!"){3}
130  \s*>
131  \s*<{http://www.perl.com/}element\s*>data</{http://www.perl.com/}element\s*>
132  \s*</opt>
133  \s*$
134}sx, 'clarkian names not converted to qnames on output by default');
135
136
137# Confirm nsexpand option works on output
138
139$xml = XMLout($opt, nsexpand => 1);
140ok($xml =~ m{
141  ^\s*<opt
142  (\s+xmlns:perl="http://www.perl.com/"
143  |\s+perl:attr="value"
144  |\s+bare="Beer!"){3}
145  \s*>
146  \s*<perl:element\s*>data</perl:element\s*>
147  \s*</opt>
148  \s*$
149}sx, 'clarkian names are converted to qnames on output on request');
150
151
152# Check that default namespace is correctly read in ...
153
154$xml = q(<opt xmlns="http://www.orgsoc.org/">
155  <list>
156    <member>Tom</member>
157    <member>Dick</member>
158    <member>Larry</member>
159  </list>
160</opt>
161);
162
163$expected = {
164  'xmlns' => 'http://www.orgsoc.org/',
165  '{http://www.orgsoc.org/}list' => {
166    '{http://www.orgsoc.org/}member' => [ 'Tom', 'Dick', 'Larry' ],
167  }
168};
169
170$opt = XMLin($xml, nsexpand => 1);
171is_deeply($opt, $expected, 'expansion of default namespace works');
172
173
174# ... and written out
175
176$xml = XMLout($opt, nsexpand => 1);
177like($xml, qr{
178  ^\s*<opt
179  \s+xmlns="http://www.orgsoc.org/"
180  \s*>
181  \s*<list>
182  \s*<member>Tom</member>
183  \s*<member>Dick</member>
184  \s*<member>Larry</member>
185  \s*</list>
186  \s*</opt>
187  \s*$
188}sx, 'default namespaces are output correctly too');
189
190
191# Check that the autogeneration of namespaces works as we expect
192
193$opt = {
194  'xmlns' => 'http://www.orgsoc.org/',
195  '{http://www.orgsoc.org/}list' => {
196    '{http://www.orgsoc.org/}member' => [ 'Tom', 'Dick', 'Larry' ],
197    '{http://www.phantom.com/}director' => [ 'Bill', 'Ben' ],
198  }
199};
200
201$xml = XMLout($opt, nsexpand => 1);
202my $prefix = '';
203if($xml =~ m{<list\s+xmlns:(\w+)="http://www.phantom.com/"\s*>}) {
204  $prefix = $1;
205}
206  # regex match split in two to workaround 5.8.1/utf8/regex match prob
207like($xml, qr{
208  \s*<opt
209  \s+xmlns="http://www.orgsoc.org/"
210  \s*>
211  .*?
212  </list>
213  \s*</opt>
214}sx, 'namespace prefixes are generated automatically (part 1)');
215
216like($xml, qr{
217  (\s*<member>Tom</member>
218   \s*<member>Dick</member>
219   \s*<member>Larry</member>
220  |\s*<${prefix}:director>Bill</${prefix}:director>
221   \s*<${prefix}:director>Ben</${prefix}:director>){2}
222  #\s*</list>
223}sx, 'namespace prefixes are generated automatically (part 2)');
224
225
226exit(0);
227