t/8_Namespaces.t

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