@@ -6,6 +6,19 @@ Mark Overmeer.
Plans and unwanted limitations? see README.todo
+version 1.45: Mon Aug 11 09:16:56 CEST 2014
+
+ Fixes:
+ - reader: optional substitutionGroup's
+ - tests: disable t/03duration.t when tzset is not supported
+ (Windows) [cpantesters]
+ - remove default elements_qualified => 'TOP' [Ciaran Deignan]
+ - the nodePath is not unique enough for the cache, in case
+ of [René Keldermann] Requires XML::LibXML 2.0100
+
+ Improvements:
+ - use prefixes in $path (for errors) when known.
+
version 1.44: Wed May 28 09:23:24 CEST 2014
Changes:
@@ -42,11 +42,11 @@
"Test::Deep" : "0.095",
"Test::More" : "0.54",
"XML::Compile::Tester" : "0.9",
- "XML::LibXML" : "1.94",
+ "XML::LibXML" : "2.01",
"bignum" : "0.1"
}
}
},
"release_status" : "stable",
- "version" : "1.44"
+ "version" : "1.45"
}
@@ -28,6 +28,6 @@ requires:
Test::Deep: 0.095
Test::More: 0.54
XML::Compile::Tester: 0.9
- XML::LibXML: 1.94
+ XML::LibXML: 2.01
bignum: 0.1
-version: 1.44
+version: 1.45
@@ -4,10 +4,10 @@ use 5.008;
WriteMakefile
( NAME => 'XML::Compile'
- , VERSION => '1.44'
+ , VERSION => '1.45'
, PREREQ_PM =>
- { XML::LibXML => 1.94
+ { XML::LibXML => 2.0100
, XML::Compile::Tester => 0.90
, IO => 1.22
, Log::Report => 1.03
@@ -1,5 +1,5 @@
-=== README for XML-Compile version 1.44
-= Generated on Wed May 28 09:23:39 2014 by OODoc 2.01
+=== README for XML-Compile version 1.45
+= Generated on Thu Aug 7 15:14:55 2014 by OODoc 2.01
There are various ways to install this module:
@@ -9,16 +9,16 @@ There are various ways to install this module:
(2) if you use Windows, have a look at http://ppm.activestate.com/
(3) if you have downloaded this module manually (as root/administrator)
- gzip -d XML-Compile-1.44.tar.gz
- tar -xf XML-Compile-1.44.tar
- cd XML-Compile-1.44
+ gzip -d XML-Compile-1.45.tar.gz
+ tar -xf XML-Compile-1.45.tar
+ cd XML-Compile-1.45
perl Makefile.PL
make # optional
make test # optional
make install
For usage, see the included manual-pages or
- http://search.cpan.org/dist/XML-Compile-1.44/
+ http://search.cpan.org/dist/XML-Compile-1.45/
Please report problems to
http://rt.cpan.org/Dist/Display.html?Queue=XML-Compile
@@ -214,8 +214,8 @@ Try turning on debugging with:
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -7,7 +7,7 @@ use strict;
package XML::Compile::Iterator;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use XML::Compile::Util qw/pack_type type_of_node SCHEMA2001i/;
@@ -132,8 +132,8 @@ Returns the textContent of the L<node()|XML::Compile::Iterator/"Attributes">, or
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,7 +8,7 @@ no warnings 'recursion';
package XML::Compile::Schema::BuiltInFacets;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'Exporter';
@@ -32,8 +32,8 @@ The content is not for end-users, but called by the schema translator.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,7 +8,7 @@ no warnings 'recursion';
package XML::Compile::Schema::BuiltInTypes;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'Exporter';
@@ -365,8 +365,8 @@ Probably the same rules as L<anyURI()|XML::Compile::Schema::BuiltInTypes/"URI">.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,7 +8,7 @@ use strict;
package XML::Compile::Schema::Instance;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use Log::Report 'xml-compile', syntax => 'SHORT';
@@ -176,8 +176,8 @@ anyway).
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,7 +8,7 @@ use strict;
package XML::Compile::Schema::NameSpaces;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use Log::Report 'xml-compile', syntax => 'SHORT';
@@ -148,8 +148,8 @@ This method implements L<XML::Compile::Schema::useSchema()|XML::Compile::Schema/
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,7 +8,7 @@ use strict;
package XML::Compile::Schema::Specs;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use Log::Report 'xml-compile', syntax => 'SHORT';
@@ -58,8 +58,8 @@ Returns the uri of all predefined schemas.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -5,7 +5,7 @@
package XML::Compile::Schema;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'XML::Compile';
@@ -335,7 +335,6 @@ sub template($@)
$args{mixed_elements} ||= 'ATTRIBUTES';
$args{default_values} ||= 'EXTEND';
$args{abstract_types} ||= 'ERROR';
- $args{elements_qualified} ||= 'TOP';
exists $args{include_namespaces}
or $args{include_namespaces} = 1;
@@ -695,7 +695,7 @@ improvements: read and understand the comments in the text.
-Option --Default
abstract_types 'ERROR'
attributes_qualified <undef>
- elements_qualified 'TOP'
+ elements_qualified <undef>
include_namespaces <true>
indent " "
key_rewrite []
@@ -1676,8 +1676,8 @@ then still only one prefix is added.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -4,7 +4,7 @@
# Pod stripped from pm file by OODoc 2.01.
package XML::Compile::Translate::Reader;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'XML::Compile::Translate';
@@ -131,9 +131,7 @@ sub makeSequence($@)
my $code
= (ref $action eq 'BLOCK' || ref $action eq 'ANY')
? sub { $action->($_[0]) }
- : sub {
-#warn "T=$take ", $_[0] && $_[0]->currentType;
- $action->($_[0] && $_[0]->currentType eq $take ? $_[0]:undef)};
+ : sub { $action->($_[0] && $_[0]->currentType eq $take ? $_[0]:undef)};
return bless $code, 'BLOCK';
}
@@ -212,8 +210,7 @@ sub makeChoice($@)
my @special_errors;
foreach (@specials)
- {
- my @d = try { $_->($tree) };
+ { my @d = try { $_->($tree) };
return @d if !$@ && @d;
push @special_errors, $@->wasFatal->message if $@;
}
@@ -312,6 +309,7 @@ sub makeAll($@)
sub makeBlockHandler
{ my ($self, $path, $label, $min, $max, $process, $kind, $multi) = @_;
+#warn "BLOCK $label $min $max";
# flatten the HASH: when a block appears only once, there will
# not be an additional nesting in the output tree.
if($max ne 'unbounded' && $max==1)
@@ -499,9 +497,6 @@ sub makeElementHref
sub makeElement
{ my ($self, $path, $ns, $childname, $do) = @_;
sub { my $tree = shift;
-#warn "NT=", ($tree ? $tree->nodeType : 'undef'), ' expected ', $childname;
-#use Carp qw/cluck/;
-#cluck if $childname =~ /c1_a/;
my $value = defined $tree && $tree->nodeType eq $childname
? $do->($tree) : $do->(undef);
defined $value ? ($childname => $value) : ();
@@ -580,6 +575,9 @@ sub makeElementAbstract
# complexType and complexType/ComplexContent
#
+# Be warned that the location reported in 'path' may not be the actual
+# location, caused by the cashing of compiled schema components. The
+# path you see is the first path where that element was encountered.
sub _not_processed($$)
{ my ($child, $path) = @_;
error __x"element `{name}' not processed for {path} at {where}"
@@ -590,6 +588,7 @@ sub _not_processed($$)
sub makeComplexElement
{ my ($self, $path, $tag, $elems, $attrs, $attrs_any,undef,$is_nillable) = @_;
my @e = @$elems; my @a = @$attrs;
+
my @elems = odd_elements @$elems;
my @attrs = (odd_elements(@$attrs), @$attrs_any);
@@ -610,8 +609,6 @@ my @e = @$elems; my @a = @$attrs;
@elems > 1 || @attrs and return
sub { my $tree = shift or return ();
my $node = $tree->node;
-#warn $node->toString(1);
-#warn "@e @a";
my %complex = ((map $_->($tree), @elems), (map $_->($node), @attrs));
_not_processed $tree->currentChild, $path
@@ -622,7 +619,6 @@ my @e = @$elems; my @a = @$attrs;
@elems || return
sub { my $tree = shift or return ();
-
_not_processed $tree->currentChild, $path
if $tree->currentChild;
@@ -931,16 +927,17 @@ sub makeSubstgroup
keys %do or return bless sub { () }, 'BLOCK';
bless
- sub { my $tree = shift;
- my $type = ($tree ? $tree->currentType : undef)
+ sub { my $tree = shift;
+ my $type = ($tree ? $tree->currentType : undef)
or error __x"no data for substitution group {type} at {path}"
, type => $base, path => $path;
- my $do = $do{$type}
- or return;
+ my $do = $do{$type} or return ();
my @subst = $do->[1]($tree->descend);
+ @subst or return ();
+
$tree->nextChild;
- @subst ? ($do->[0] => $subst[1]) : (); # key-rewrite
+ ($do->[0] => $subst[1]); # key-rewrite
}, 'BLOCK';
}
@@ -1186,22 +1183,23 @@ sub _decodeAfter($$)
sub makeBlocked($$$)
{ my ($self, $where, $class, $type) = @_;
+ my $err_type = $self->prefixed($type) || $type;
# errors are produced in class=misfit to allow other choices to succeed.
$class eq 'anyType'
? { st => sub { error __x"use of `{type}' blocked at {where}"
- , type => $type, where => $where, _class => 'misfit';
+ , type => $err_type, where => $where, _class => 'misfit';
}}
: $class eq 'simpleType'
? { st => sub { error __x"use of {class} `{type}' blocked at {where}"
- , class => $class, type => $type, where => $where
+ , class => $class, type => $err_type, where => $where
, _class => 'misfit';
}}
: $class eq 'complexType'
? { elems => [] }
: $class eq 'ref'
? { st => sub { error __x"use of referenced `{type}' blocked at {where}"
- , type => $type, where => $where, _class => 'misfit';
+ , type => $err_type, where => $where, _class => 'misfit';
}}
: panic "blocking of $class for $type not implemented";
}
@@ -301,8 +301,8 @@ with some extra checks.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -5,7 +5,7 @@
package XML::Compile::Translate::Template;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'XML::Compile::Translate';
@@ -83,8 +83,8 @@ of the specified class.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -5,7 +5,7 @@
package XML::Compile::Translate::Writer;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'XML::Compile::Translate';
@@ -198,10 +198,13 @@ sub makeChoice($@)
my ($doc, $values) = @_;
defined $values or return ();
foreach my $take (keys %do)
- { return $do{$take}->($doc, delete $values->{$take})
+ {
+#warn "TAKE($take) = ", (defined $values->{$take} ? 'defined' : "undef");
+ return $do{$take}->($doc, delete $values->{$take})
if defined $values->{$take};
}
+#warn "TRY SPECIALS";
my $starter = keys %$values;
foreach (@specials)
{ my @d = try { $_->($doc, $values) };
@@ -217,6 +220,7 @@ sub makeChoice($@)
return @d;
}
+#warn "BLURK!";
# blurk... any element with minOccurs=0 or default?
foreach (values %do)
{ my @d = try { $_->($doc, undef) };
@@ -478,6 +482,7 @@ sub nil($)
sub makeComplexElement
{ my ($self, $path, $tag, $elems, $attrs, $any_attr,undef, $is_nillable) = @_;
+my @e = @$elems;
my @elems = odd_elements @$elems;
my @attrs = @$attrs;
my $tags = join ', ', grep defined
@@ -499,15 +504,15 @@ sub makeComplexElement
or error __x"complex `{tag}' requires data at {path}"
, tag => $tag, path => $path, _class => 'misfit';
- error __x"complex `{tag}' requires a HASH of input data, not `{found}' at {path}"
- , tag => $tag, found => (ref $data || $data), path => $path;
+ error __x"complex `{tag}' requires a HASH of input data, not `{got}' at {path}"
+ , tag => $tag, got => (ref $data || $data), path => $path;
}
my $copy = { %$data }; # do not destroy callers hash
my @childs = ($is_nillable && (delete $copy->{_} || '') eq 'NIL')
? $doc->createAttribute($nilattr => 'true')
- : map {$_->($doc, $copy)} @elems;
+ : map($_->($doc, $copy), @elems);
for(my $i=0; $i<@attrs; $i+=2)
{ push @childs, $attrs[$i+1]->($doc, delete $copy->{$attrs[$i]});
@@ -1115,22 +1120,23 @@ sub _decodeAfter($$)
sub makeBlocked($$$)
{ my ($self, $where, $class, $type) = @_;
+ my $err_type = $self->prefixed($type);
# errors are produced in class=misfit to allow other choices to succeed.
$class eq 'anyType'
? { st => sub { error __x"use of `{type}' blocked at {where}"
- , type => $type, where => $where, _class => 'misfit';
+ , type => $err_type, where => $where, _class => 'misfit';
}}
: $class eq 'simpleType'
? { st => sub { error __x"use of {class} `{type}' blocked at {where}"
- , class => $class, type => $type, where => $where
+ , class => $class, type => $err_type, where => $where
, _class => 'misfit';
}}
: $class eq 'complexType'
? { elems => [] }
: $class eq 'ref'
? { st => sub { error __x"use of referenced `{type}' blocked at {where}"
- , type => $type, where => $where, _class => 'misfit';
+ , type => $err_type, where => $where, _class => 'misfit';
}}
: panic "blocking of $class for $type not implemented";
}
@@ -212,8 +212,8 @@ writer considerably.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,7 +8,7 @@ no warnings 'recursion'; # trees can be quite deep
package XML::Compile::Translate;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
# Errors are either in _class 'usage': called with request
@@ -78,7 +78,7 @@ sub compile($@)
{ my ($self, $item, %args) = @_;
@$self{keys %args} = values %args; # dirty
- my $path = $item;
+ my $path = $self->prefixed($item) || $item;
ref $item
and panic "expecting an item as point to start at $path";
@@ -165,14 +165,13 @@ sub nsContext($)
# top elements are to be qualified unless there is no targetNamespace
my %context = (tns => $tns, qual_top => ($tns ? 1 : 0));
-#use Data::Dumper;
-#warn "DEF=",Dumper $def;
my $el_qual = $def->{efd} eq 'qualified';
if(exists $self->{elements_qualified})
{ my $qual = $self->{elements_qualified} || 0;
if($qual eq 'TOP')
- { $tns or error __x"application requires that element `{name}' has a targetNamespace", name => $def->{full};
+ { $tns or error __x"application requires that element `{name}' has a targetNamespace"
+ , name => $def->{full};
}
else
{ $el_qual = $qual eq 'ALL' ? 1 : $qual eq 'NONE' ? 0 : $qual;
@@ -192,7 +191,6 @@ sub nsContext($)
}
}
$context{qual_attr} = $at_qual;
-#warn Dumper \%context;
\%context;
}
@@ -544,21 +542,6 @@ sub element($)
&& $parent->localname eq 'schema';
my $where = $tree->path;
-#warn "ELEMENT $where, $is_global";
-
- if(my $ref = $node->getAttribute('ref'))
- { my $where = $tree->path . "/$ref";
- (my $ln = $ref) =~ s/.*://;
- my $refname = $self->rel2abs($tree, $node, $ref);
- return () if $self->blocked($where, ref => $refname);
-
- my $def = $self->namespaces->find(element => $refname)
- or error __x"cannot find ref element '{name}' at {where}"
- , name => $refname, where => $where, _class => 'schema';
-
- my $refnode = $def->{node};
- return $self->element($tree->descend($refnode, $ln));
- }
my $name = $node->getAttribute('name')
or error __x"element has no name nor ref at {where}"
@@ -569,8 +552,6 @@ sub element($)
# or a local name.
my $context = $self->{_context};
-#use Data::Dumper;
-#warn "CONTEXT=",Dumper $context;
# Determine the context of this element. When it is a global, we need
# to set-up a new context until end-of-function.
@@ -579,12 +560,10 @@ sub element($)
my ($qual, $ns, $fullname);
if($is_global)
- { $ns = $node->getAttribute('targetNamespace')
- || $parent->getAttribute('targetNamespace');
+ { $ns = $node->getAttribute('targetNamespace')
+ || $parent->getAttribute('targetNamespace');
$fullname= pack_type $ns, $name;
- my $def = $self->namespaces->find(element => $fullname);
-#use Data::Dumper;
-#warn "FULLNAME $fullname, ", Dumper $def;
+ my $def = $self->namespaces->find(element => $fullname);
$context = $self->nsContext($def);
$qual = $context->{qual_top};
@@ -605,14 +584,15 @@ sub element($)
, form => $form, where => $where, _class => 'schema';
}
-#warn "QUAL $name? $qual";
local $self->{_context} = $context if $is_global;
my $nodetype = $qual ? $fullname : $name;
# Handle re-usable fragments, fight against combinatorial explosions
- my $nodeid = $node->nodePath.'#'.$fullname;
+ my $nodeid = $node->unique_key; #$node->nodePath.'#'.$fullname;
my $already = $self->{_created}{$nodeid};
+#warn "$nodeid; ", $node+0,"\n" if $already;
+#undef $already;
return ($nodetype, $already) if $already;
# Detect recursion
@@ -786,9 +766,8 @@ sub particle($)
return $self->anyElement($tree, $min, $max)
if $local eq 'any';
- my $name = $node->getAttribute('name');
my ($label, $process)
- = $local eq 'element' ? $self->element($tree->descend($node,$name))
+ = $local eq 'element' ? $self->particleElement($tree)
: $local eq 'group' ? $self->particleGroup($tree)
: $local =~ $particle_blocks ? $self->particleBlock($tree)
: error __x"unknown particle type '{name}' at {where}"
@@ -813,6 +792,27 @@ sub particle($)
$self->makeElementHandler($where, $key, $min,$max, $required, $process);
}
+sub particleElement($)
+{ my ($self, $tree) = @_;
+
+ my $node = $tree->node;
+ if(my $ref = $node->getAttribute('ref'))
+ { my $where = $tree->path . "/$ref";
+ my $refname = $self->rel2abs($tree, $node, $ref);
+ return () if $self->blocked($where, ref => $refname);
+
+ my $def = $self->namespaces->find(element => $refname)
+ or error __x"cannot find ref element '{name}' at {where}"
+ , name => $refname, where => $where, _class => 'schema';
+
+ return $self->element($tree->descend($def->{node}
+ , $self->prefixed($refname)));
+ }
+
+ my $name = $node->getAttribute('name');
+ $self->element($tree->descend($node, $name));
+}
+
# blockLabel KIND, LABEL
# Particle blocks, like `sequence' and `choice', which have a maxOccurs
# (maximum occurrence) which is 2 of more, are represented by an ARRAY
@@ -855,7 +855,7 @@ sub particleGroup($)
or error __x"cannot find group `{name}' at {where}"
, name => $typename, where => $where, _class => 'schema';
- my $group = $tree->descend($dest->{node}, $dest->{local});
+ my $group = $tree->descend($dest->{node}, $self->prefixed($typename));
return () if $group->nrChildren==0;
$group->nrChildren==1
@@ -926,7 +926,7 @@ sub substitutionGroup($$$$$)
my $longest = max map length, @full;
my @c = map sprintf("%-${longest}s %s",$_,$self->keyRewrite($_)), @full;
local $" = "\n ";
- trace "substitutionGroup $fullname$\"SG=$label ($labelrw)$\"@c";
+ trace "substitutionGroup $fullname$\"BASE=$label ($labelrw)$\"@c";
}
my @elems;
@@ -396,8 +396,8 @@ element does not contains sub-elements, otherwise the XML node.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -7,7 +7,7 @@ use strict;
package XML::Compile::Util;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'Exporter';
@@ -111,8 +111,8 @@ Translate an XML::LibXML::Node into a packed type.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,7 +8,7 @@ use strict;
package XML::Compile;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use Log::Report 'xml-compile';
@@ -295,8 +295,8 @@ other modules.
=head1 SEE ALSO
-This module is part of XML-Compile distribution version 1.44,
-built on May 28, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
+This module is part of XML-Compile distribution version 1.45,
+built on August 11, 2014. Website: F<http://perl.overmeer.net/xml-compile/>
Other distributions in this suite:
L<XML::Compile>,
@@ -8,8 +8,15 @@ use File::Spec;
use POSIX qw/strftime tzset/;
use lib 'lib', 't';
-use Test::More tests => 16;
use XML::Compile::Util qw/duration2secs add_duration/;
+use Test::More;
+
+# On some platforms (Windows), tzset is not supported so we cannot produce
+# consistent time output.
+eval { tzset };
+plan skip_all => $@ if $@;
+
+plan tests => 16;
# examples taken from http://www.schemacentral.com/sc/xsd/t-xsd_duration.html
@@ -38,7 +45,7 @@ sub t($) {strftime "%Y-%m-%dT%H:%M:%S", gmtime shift}
# used to calculate some fixed reference point in time
# my $now = time;
-my $now = 1397731609; # 2014-04-17T10:46:49
+my $now = 1397731609; # 2014-04-17T10:46:49Z
#print "$now=",t($now), "\n";
cmp_ok(t(add_duration('P2Y6M5DT12H35M30S', $now)), 'eq', '2016-10-22T23:22:19');
@@ -36,12 +36,12 @@ __SCHEMA__
ok(defined $schema);
my $error = error_w($schema, test2 => {test1 => 42});
-is($error, "attempt to instantiate abstract element `test1' at {http://test-types}test2/test1");
+is($error, "attempt to instantiate abstract element `test1' at {http://test-types}test2/me:test1");
$error = error_r($schema, test2 => <<__XML);
<test2><test1>43</test1></test2>
__XML
-is($error, "abstract element `test1' used at {http://test-types}test2/test1");
+is($error, "abstract element `test1' used at {http://test-types}test2/me:test1");
# abstract elements are skipped from the docs
my $out = templ_perl($schema, "{$TestNS}test2", abstract_types => 1, skip_header => 1);
@@ -110,7 +110,7 @@ __XML
$error = error_r $schema, test1 => <<__XML;
<test1><t1>10</t1><head>11</head><t3>12</t3></test1>
__XML
-is($error, "abstract element `head' used at {$TestNS}test1/head");
+is($error, "abstract element `head' used at {$TestNS}test1/one:head");
### test2
@@ -102,10 +102,10 @@ set_compile_defaults
#
my $error = error_r($schema, test1 => '<test1>11</test1>');
-is($error, "use of `{$OtherNS}t1' blocked at {$TestNS}test1");
+is($error, "use of `other:t1' blocked at {$TestNS}test1");
$error = error_w($schema, test1 => 11);
-is($error, "use of `{$OtherNS}t1' blocked at {$TestNS}test1");
+is($error, "use of `other:t1' blocked at {$TestNS}test1");
# should still work
test_rw($schema, test2 => '<test2>12</test2>', 12);
@@ -115,29 +115,29 @@ test_rw($schema, test2 => '<test2>12</test2>', 12);
#
$error = error_r($schema, test3 => XML::LibXML::Attr->new('test3', 13));
-is($error, "use of simpleType `{$OtherNS}t3' blocked at {$TestNS}test3/\@test3");
+is($error, "use of simpleType `other:t3' blocked at {$TestNS}test3/\@test3");
$error = error_w($schema, test3 => 13);
-is($error, "use of simpleType `{$OtherNS}t3' blocked at {$TestNS}test3/\@test3");
+is($error, "use of simpleType `other:t3' blocked at {$TestNS}test3/\@test3");
test_rw($schema, test4 => XML::LibXML::Attr->new(test4 => '14')
, 14, ' test4="14"');
$error = error_r($schema, test5 => '<test5>15</test5>');
-is($error, "use of simpleType `{$OtherNS}t5' blocked at {$TestNS}test5#sres");
+is($error, "use of simpleType `other:t5' blocked at {$TestNS}test5#sres");
$error = error_w($schema, test5 => 15);
-is($error, "use of simpleType `{$OtherNS}t5' blocked at {$TestNS}test5#sres");
+is($error, "use of simpleType `other:t5' blocked at {$TestNS}test5#sres");
#
# complexType choice
#
$error = error_r($schema, test6 => '<test6><a>16</a></test6>');
-is($error, "use of `{$OtherNS}t6' blocked at {$TestNS}test6/a");
+is($error, "use of `other:t6' blocked at {$TestNS}test6/a");
$error = error_w($schema, test6 => { a => 16 });
-is($error, "use of `{$OtherNS}t6' blocked at {$TestNS}test6/a");
+is($error, "use of `other:t6' blocked at {$TestNS}test6/a");
test_rw($schema, test6 => '<test6><b>16</b></test6>', {b => 16});
@@ -160,10 +160,10 @@ $error = error_w($schema, test9 => { t9 => 90 });
is($error, "no match for required block `cho_test1' at {$TestNS}test9");
$error = error_r($schema, test9 => '<test9><test1>91</test1></test9>');
-is($error, "use of `{$OtherNS}t1' blocked at {$TestNS}test9/test1");
+is($error, "use of `other:t1' blocked at {$TestNS}test9/me:test1");
$error = error_w($schema, test9 => { test1 => 91 });
-is($error, "use of `{$OtherNS}t1' blocked at {$TestNS}test9/test1");
+is($error, "use of `other:t1' blocked at {$TestNS}test9/me:test1");
test_rw($schema, test9 => '<test9><test2>92</test2></test9>', {test2 => 92});
@@ -178,9 +178,9 @@ $error = error_w($schema, test10 => { t10 => 100 });
is($error, "tag `t10' not used at {$TestNS}test10");
$error = error_r($schema, test10 => '<test10><test1>101</test1></test10>');
-is($error, "use of `{$OtherNS}t1' blocked at {$TestNS}test10/test1");
+is($error, "use of `other:t1' blocked at {$TestNS}test10/me:test1");
$error = error_w($schema, test10 => { test1 => 101 });
-is($error, "use of `{$OtherNS}t1' blocked at {$TestNS}test10/test1");
+is($error, "use of `other:t1' blocked at {$TestNS}test10/me:test1");
test_rw($schema, test10 => '<test10><test2>102</test2></test10>', {test2 => 102});
@@ -7,7 +7,7 @@ use strict;
package TestTools;
use vars '$VERSION';
-$VERSION = '1.44';
+$VERSION = '1.45';
use base 'Exporter';