我正在研究一个Moose角色，它允许消费类根据为一个或多个属性指定的'xml_path'选项发出XML，如下所示：
package MooseX::Role::EmitsXML::Trait::HasXMLPath;
use Moose::Role;
has xml_path => (
'is' => 'ro',
'isa' => 'Str',
'predicate' => 'has_xml_path',
);
has 'namespace' => (
'is' => 'ro',
'isa' => 'Str',
'predicate' => 'has_namespace',
);
has 'cdata' => (
'is' => 'ro',
'isa' => 'Bool',
'predicate' => 'has_cdata',
);
package MooseX::Role::EmitsXML;
our $VERSION = '0.01';
use Moose::Role;
use namespace::autoclean;
use XML::LibXML;
use Moose::Exporter;
sub has_xml {
my ($meta, $attr_name, %opts) = @_;
$opts{'traits'} ||= [];
push @{$opts{'traits'}}, 'MooseX::Role::EmitsXML::Trait::HasXMLPath';
$meta->add_attribute($attr_name, %opts);
}
Moose::Exporter->setup_import_methods(
with_meta => [qw(has_xml)],
also => [qw/Moose/],
);
sub to_xml {
my ( $self, @args ) = @_;
my $doc = XML::LibXML::Document->new();
for my $attr ( map { $self->meta->get_attribute($_) } $self->meta->get_attribute_list ) {
my $reader = $attr->get_read_method;
if ( $attr->does('XMLPath') && $attr->has_xml_path ) {
my $val = $self->$reader();
my $path = $attr->xml_path;
my @elements = split /\//, $path;
if ( $path =~ /^\// ) { # Throw away blank
shift @elements;
}
my $previous;
while ( my $element = shift @elements ) {
my $node;
my $attrs = extract_attrs($element);
( my $node_name = $element ) =~ s/\[.+?\]//g;
if ( !$previous ) {
if ( !$doc->documentElement ) {
$doc->setDocumentElement( XML::LibXML::Element->new($node_name) );
for my $key ( keys %{$attrs} ) {
$doc->documentElement->setAttribute( $key, $attrs->{$key} );
}
}
else {
my $root1 = $doc->documentElement->nodeName;
my $root2 = $element;
if ( $root1 ne $root2 ) {
die qq{MISMATCH! Root elements do not match: "$root1" <> "$root2"};
}
}
$node = $doc->documentElement;
}
else {
($node) = @{ $previous->find(qq{./$element}) };
if ( !$node ) {
$node = XML::LibXML::Element->new($node_name);
for my $key ( keys %{$attrs} ) {
$node->setAttribute( $key, $attrs->{$key} );
}
$previous->addChild($node);
}
}
$previous = $node;
}
# $previous has become the leaf here
$previous->appendText($val);
}
}
}
sub _extract_attrs {
my $element = shift;
my @attr_strings = ($element =~ m/(\[.+?\])/); # Capture everything between [ and ].
if (scalar @attr_strings > 1) {
die q{Invalid attribute specification. Specify multiple attrs as [@attr1=val1,@attr2=val2]};
}
my %attrs;
if (@attr_strings) {
for my $string (split /,/, $attr_strings[0]) {
my ($key, $val) = ($string =~ m/\[@?\s*(\w+)\s*=\s*"(\w+)"\s*\]/);
if (!$key) {
die qq{Malformed attribute specification: "$string". Should be [key="value"] (DOUBLE QUOTES MANDATORY)\n};
}
if (exists $attrs{$key}) {
warn qq{Duplicate key "$key" in attrs};
}
$attrs{$key} = $val;
}
}
return \%attrs;
}
no Moose::Role;
1;
然而，当我尝试使用它时：
package Product;
use Moose;
use MooseX::Role::EmitsXML;
# If I comment this out, has_xml works right ($meta is passed as first argument) but I don't have to_xml() available in the
# consuming class.
#
# If I don't, I have to_xml available in the consuming class, but has_xml doesn't work right.
with 'MooseX::Role::EmitsXML';
has_xml 'description' =>
( 'is' => 'ro', 'isa' => 'Str', 'xml_path' => '/Product/DescriptiveInformation/ProductDescription' );
has_xml 'item_number' => ( 'is' => 'ro', 'isa' => 'Str', 'xml_path' => '/Product/Identifiers/ItemNumber' );
has_xml 'catalog_number' => ( 'is' => 'ro', 'isa' => 'Str', 'xml_path' => '/Product/Identifiers/CatalogNumber' );
has_xml 'upc' => ( 'is' => 'ro', 'isa' => 'Int', 'xml_path' => '/Product/Identifiers/UPC' );
has_xml 'color' => ( 'is' => 'ro', 'isa' => 'Str', 'xml_path' => '/Product/DescriptiveInformation/Color' );
has 'that_je_ne_sais_quoi' => ('is' => 'ro', 'isa' => 'Str' );
1;
package main;
use Test::Most;
use XML::LibXML;
my %product_args = (
color => 'periwinkle',
upc => 1234567890123,
item_number => 'THX-1138',
catalog_number => 'KP-1652051819',
description => q{Oh, yes. It's very nice!},
that_je_ne_sais_quoi => q{Something French. Or maybe Swahili.},
);
ok my $p = Product->new(%product_args), 'Created instance of class using role';
ok my $xml = $p->to_xml, 'Output XML';
ok my $doc = XML::LibXML::parse_string($xml), 'XML is valid (or at least parseable)';
for my $key (keys %product_args) {
my $attr = $p->meta->get_attribute($key);
if ($key ne 'that_je_ne_sais_quoi') {
ok $attr->can('has_xml_path'), qq{Predicate 'has_xml_path' present for "$key"};
ok my $path = $attr->xml_path, qq{Got an XML path for "$key"};
1;
}
}
正如评论所说，如果我注释掉with 'MooseX::Role::EmitsXML'，那么has_xml会将消费包的元类作为第一个参数，但消费包没有to_xml。如果我取消注释，消费包将获得to_xml，但has_xml不会获取消费包元类。我怎样才能同时获得to_xml和has_xml糖？
答案 0 :(得分：0)
以太，这不是如何完成的。相反，提供with_xml的角色需要在单独的包中定义，“终极”角色应该将上述内容应用于消费类，如下所示：
package MooseX::Role::EmitsXML::Trait::HasXMLPath;
use Moose::Role;
has xml_path => (
'is' => 'ro',
'isa' => 'Str',
'predicate' => 'has_xml_path',
);
has 'namespace' => (
'is' => 'ro',
'isa' => 'Str',
'predicate' => 'has_namespace',
);
has 'cdata' => (
'is' => 'ro',
'isa' => 'Bool',
'predicate' => 'has_cdata',
);
package MooseX::Role::EmitsXML::ToXML;
# This package provides the to_xml() method to the consuming class
our $VERSION = '0.01';
use Moose::Role;
use namespace::autoclean;
use XML::LibXML;
sub to_xml {
my ( $self, @args ) = @_;
my $doc = XML::LibXML::Document->new();
for my $attr ( map { $self->meta->get_attribute($_) } $self->meta->get_attribute_list ) {
my $reader = $attr->get_read_method;
if ( $attr->does('MooseX::Role::EmitsXML::Trait::HasXMLPath') && $attr->has_xml_path ) {
my $val = $self->$reader();
my $path = $attr->xml_path;
my @elements = split /\//, $path;
if ( $path =~ /^\// ) { # Throw away blank
shift @elements;
}
my $previous;
while ( my $element = shift @elements ) {
my $node;
my $attrs = extract_attrs($element);
( my $node_name = $element ) =~ s/\[.+?\]//g;
if ( !$previous ) {
if ( !$doc->documentElement ) {
$doc->setDocumentElement( XML::LibXML::Element->new($node_name) );
for my $key ( keys %{$attrs} ) {
$doc->documentElement->setAttribute( $key, $attrs->{$key} );
}
}
else {
my $root1 = $doc->documentElement->nodeName;
my $root2 = $element;
if ( $root1 ne $root2 ) {
die qq{MISMATCH! Root elements do not match: "$root1" <> "$root2"};
}
}
$node = $doc->documentElement;
}
else {
($node) = @{ $previous->find(qq{./$element}) };
if ( !$node ) {
$node = XML::LibXML::Element->new($node_name);
for my $key ( keys %{$attrs} ) {
$node->setAttribute( $key, $attrs->{$key} );
}
$previous->addChild($node);
}
}
$previous = $node;
}
# $previous has become the leaf here
$previous->appendText($val);
}
}
return "$doc";
}
sub _extract_attrs {
my $element = shift;
my @attr_strings = ($element =~ m/(\[.+?\])/); # Capture everything between [ and ].
if (scalar @attr_strings > 1) {
die q{Invalid attribute specification. Specify multiple attrs as [@attr1=val1,@attr2=val2]};
}
my %attrs;
if (@attr_strings) {
for my $string (split /,/, $attr_strings[0]) {
my ($key, $val) = ($string =~ m/\[@?\s*(\w+)\s*=\s*"(\w+)"\s*\]/);
if (!$key) {
die qq{Malformed attribute specification: "$string". Should be [key="value"] (DOUBLE QUOTES MANDATORY)\n};
}
if (exists $attrs{$key}) {
warn qq{Duplicate key "$key" in attrs};
}
$attrs{$key} = $val;
}
}
return \%attrs;
}
no Moose::Role;
1;
package MooseX::Role::EmitsXML;
# This package applies the role providing to_xml to the consuming class,
# and creates the 'has_xml' sugar
use Moose::Exporter;
sub has_xml {
my ($meta, $attr_name, %opts) = @_;
$opts{'traits'} ||= [];
push @{$opts{'traits'}}, 'MooseX::Role::EmitsXML::Trait::HasXMLPath';
$meta->add_attribute($attr_name, %opts);
}
Moose::Exporter->setup_import_methods(
with_meta => [qw(has_xml)],
base_class_roles => [qw(MooseX::Role::EmitsXML::ToXML)],
);