diff --git a/lib/XML/Rabbit/Sugar.pm b/lib/XML/Rabbit/Sugar.pm index 9c087de..59cab35 100644 --- a/lib/XML/Rabbit/Sugar.pm +++ b/lib/XML/Rabbit/Sugar.pm @@ -55,14 +55,15 @@ trait is automatically set to C. =cut sub has_xpath_value { - my ($meta, $attr_name, $xpath_query, @moose_params) = @_; + my ($meta, $attr_name, $xpath_query, %moose_params) = @_; $meta->add_attribute($attr_name, is => 'ro', isa => 'Str', traits => [qw( XPathValue String )], xpath_query => $xpath_query, default => '', - @moose_params, + xml_default => $moose_params{default}, + %moose_params, ); return 1; } diff --git a/lib/XML/Rabbit/Trait/XPathValue.pm b/lib/XML/Rabbit/Trait/XPathValue.pm index 6b3802c..8b38476 100644 --- a/lib/XML/Rabbit/Trait/XPathValue.pm +++ b/lib/XML/Rabbit/Trait/XPathValue.pm @@ -3,11 +3,18 @@ use warnings; package XML::Rabbit::Trait::XPathValue; use Moose::Role; +use Scalar::Util qw(blessed); with 'XML::Rabbit::Trait::XPath'; # ABSTRACT: Single value xpath extractor trait +has xml_default => ( + is => 'ro', + isa => 'Str', + predicate => 'has_xml_default', +); + =method _build_default Returns a coderef that is run to build the default value of the parent attribute. Read Only. @@ -22,7 +29,9 @@ sub _build_default { $parent, $self->_resolve_xpath_query( $parent ), ); - return blessed($node) ? $node->to_literal . "" : ""; + return blessed($node) ? $node->to_literal + : $self->has_xml_default ? $self->xml_default + : ''; }; } diff --git a/t/21_xpath_default.t b/t/21_xpath_default.t new file mode 100644 index 0000000..b1f84a4 --- /dev/null +++ b/t/21_xpath_default.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Path::Class; +use Scalar::Util qw(blessed); + +my @xmls = grep {/[.]xml$/} dir('t/data/auto')->children; + +for my $xml (@xmls) { + test_xml($xml); +} + +done_testing; +exit; + +sub test_xml { + my ($xml_file) = @_; + my $pm_file = $xml_file; + $pm_file =~ s/[.]xml$/.pm/xms; + my $tests_file = $xml_file; + $tests_file =~ s/[.]xml$/.has/xms; + + my $module = require $pm_file; + + my $object = $module->new( file => "$xml_file" ); + isa_ok $object, $module; + + my @tests = file($tests_file)->slurp; + + for my $test (@tests) { + chomp $test; + local $TODO; + if ($test =~ s/^[#]//xms) { + $TODO = "Skipping test '$test' for $xml_file"; + } + + my ($search, $value) = split /\s+/, $test, 2; + is eval { search($object, $search) }, $value, "\$schema->$search == $value" + or note $@; + } +} + +sub search { + my ($obj, $query) = @_; + + my ($next, $rest) = split /->/, $query, 2; + + my $next_obj + = blessed $obj && $obj->can($next) ? $obj->$next() + : ref $obj eq 'ARRAY' ? $obj->[$next] + : ref $obj eq 'HASH' ? $obj->{$next} + : die "Can't get $query from $obj\n"; + + return $rest ? search($next_obj, $rest) : $next_obj; +} diff --git a/t/data/auto/complex_element.has b/t/data/auto/complex_element.has new file mode 100644 index 0000000..8a21fd3 --- /dev/null +++ b/t/data/auto/complex_element.has @@ -0,0 +1 @@ +element_form_default unqualified diff --git a/t/data/auto/complex_element.pm b/t/data/auto/complex_element.pm new file mode 100644 index 0000000..af7f5db --- /dev/null +++ b/t/data/auto/complex_element.pm @@ -0,0 +1,13 @@ +package MyComplexElement; + +use XML::Rabbit::Root; + +add_xpath_namespace 'xsd' => 'http://www.w3.org/2001/XMLSchema'; + +has_xpath_value 'element_form_default' => './@elementFormDefault' => ( + default => 'unqualified', +); + +finalize_class; + +'MyComplexElement'; diff --git a/t/data/auto/complex_element.xml b/t/data/auto/complex_element.xml new file mode 100644 index 0000000..e5a31cd --- /dev/null +++ b/t/data/auto/complex_element.xml @@ -0,0 +1,17 @@ + + + + + + + + + + + + +