← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/horae/jaunty

« back to all changes in this revision

Viewing changes to 0CPAN/XML-Simple-2.14/t/8_Namespaces.t

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/XML-Simple-2.14/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