From 7ac6f4bed8878513dacf3c6d471d0977db503627 Mon Sep 17 00:00:00 2001 From: Ivan Wills Date: Tue, 12 Aug 2014 05:44:24 +1000 Subject: [PATCH 1/4] Added test for classes wanting to set default values --- t/21_xpath_default.t | 58 +++++++++++++++++++++++++++++++++ t/data/auto/complex_element.has | 1 + t/data/auto/complex_element.pm | 13 ++++++++ t/data/auto/complex_element.xml | 17 ++++++++++ 4 files changed, 89 insertions(+) create mode 100644 t/21_xpath_default.t create mode 100644 t/data/auto/complex_element.has create mode 100644 t/data/auto/complex_element.pm create mode 100644 t/data/auto/complex_element.xml 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..32c8661 --- /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' => ( + xml_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 @@ + + + + + + + + + + + + + From d97aed9c27528df61931bc34b27fd74b8cdd9349 Mon Sep 17 00:00:00 2001 From: Ivan Wills Date: Tue, 12 Aug 2014 05:45:28 +1000 Subject: [PATCH 2/4] Implemented using new xml_default property to allow default values other than empty strings --- lib/XML/Rabbit/Trait/XPathValue.pm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) 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 + : ''; }; } From 0a82a31a66474915a36c076cdc89a8d5f8321df1 Mon Sep 17 00:00:00 2001 From: Ivan Wills Date: Tue, 12 Aug 2014 05:52:40 +1000 Subject: [PATCH 3/4] Added some documentation --- lib/XML/Rabbit/Sugar.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/XML/Rabbit/Sugar.pm b/lib/XML/Rabbit/Sugar.pm index 9c087de..3120b12 100644 --- a/lib/XML/Rabbit/Sugar.pm +++ b/lib/XML/Rabbit/Sugar.pm @@ -52,6 +52,9 @@ trait is automatically set to C. ... ; +Default values can be set with C as the C value will +be lost. + =cut sub has_xpath_value { From c877205361209adc0fc8a53c8199ce2a56e122ee Mon Sep 17 00:00:00 2001 From: Ivan Wills Date: Tue, 2 Sep 2014 03:55:10 +1000 Subject: [PATCH 4/4] Changed so that helper copies the attribute's "default" value to "xml_default" so from a users point of view the has_xpath_value helper works like normal Moose attribute helpers with defaults --- lib/XML/Rabbit/Sugar.pm | 8 +++----- t/data/auto/complex_element.pm | 2 +- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/lib/XML/Rabbit/Sugar.pm b/lib/XML/Rabbit/Sugar.pm index 3120b12..59cab35 100644 --- a/lib/XML/Rabbit/Sugar.pm +++ b/lib/XML/Rabbit/Sugar.pm @@ -52,20 +52,18 @@ trait is automatically set to C. ... ; -Default values can be set with C as the C value will -be lost. - =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/t/data/auto/complex_element.pm b/t/data/auto/complex_element.pm index 32c8661..af7f5db 100644 --- a/t/data/auto/complex_element.pm +++ b/t/data/auto/complex_element.pm @@ -5,7 +5,7 @@ use XML::Rabbit::Root; add_xpath_namespace 'xsd' => 'http://www.w3.org/2001/XMLSchema'; has_xpath_value 'element_form_default' => './@elementFormDefault' => ( - xml_default => 'unqualified', + default => 'unqualified', ); finalize_class;