#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{ package MyClass;
use Moo;
has [qw[ id name data ]] => (is => 'ro', required => 1);
sub job { my ($self) = @_; $self->data->{ $self->id } }
}
{ package MyClass::Builder::FromElements;
use Moo;
has root => (is => 'ro');
sub build {
my ($self, %data) = @_;
return 'MyClass'->new(data => \%data,
map +($_ => $self->root->findvalue("/r/$_")),
qw( id name ))
}
}
{ package MyClass::Builder::FromAttributes;
use Moo;
has root => (is => 'ro');
sub build {
my ($self, %data) = @_;
return 'MyClass'->new(data => \%data,
map +($_ => $self->root->findvalue("/r/\@$_")),
qw( id name ))
}
}
{ package MyClass::Builder::Factory;
use Moo;
use XML::LibXML;
has xml => (is => 'ro');
has _root => (is => 'lazy', init_arg => undef);
sub build_builder {
my ($self) = @_;
if (2 == $self->_root->findvalue('count(/r/id | /r/name)')) {
return MyClass::Builder::FromElements->new(root => $self->_root)
} elsif (2 == $self->_root->findvalue('count(/r/@id | /r/@name)')) {
return MyClass::Builder::FromAttributes->new(root => $self->_root)
} else {
die "Can't build.\n";
}
}
sub _build__root {
my ($self) = @_;
return 'XML::LibXML'->load_xml(string => $self->xml)->documentElement
}
}
my %DATA = (12 => 'CEO', 14 => 'CTO');
for my $xml (
'12John',
''
) {
my $builder = 'MyClass::Builder::Factory'->new(xml => $xml)->build_builder;
my $o = $builder->build(%DATA);
say join ', ', map $o->$_, qw( id name job );
}