File Coverage

blib/lib/Catmandu/Fix/xml_write.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Catmandu::Fix::xml_write;

our $VERSION = '0.16';

use Catmandu::Sane;
use Moo;
use XML::Struct::Writer;
use XML::LibXML::Reader;
use Catmandu::Fix::Has;

with 'Catmandu::Fix::Base';

has field      => (fix_arg => 1);
has attributes => (fix_opt => 1);
has pretty     => (fix_opt => 1);
has encoding   => (fix_opt => 1, default => sub { 'UTF-8' });
has version    => (fix_opt => 1);
has standalone => (fix_opt => 1);
has xmldecl    => (fix_opt => 1, default => sub { 1 });

has _writer => (
    is      => 'ro',
    lazy    => 1,
    builder => sub {
        XML::Struct::Writer->new(
            map { $_ => $_[0]->$_ } grep { defined $_[0]->$_ }
            qw(attributes pretty encoding version standalone xmldecl)
        );
    }
);

sub emit {
    my ($self,$fixer) = @_;

    my $path = $fixer->split_path($self->field);
    my $key = pop @$path;

    my $writer = $fixer->capture($self->_writer);
    my $pretty = $fixer->capture($self->pretty);

    return $fixer->emit_walk_path($fixer->var,$path,sub{
        my $var = $_[0];
        $fixer->emit_get_key($var,$key,sub{
            my $var = $_[0];
            return "${var} = (ref(${var}) =~ 'XML::LibXML::Document=')" .
                   "? ${var}->serialize(${pretty}) : do {".
                       "my \$s=''; ${writer}->to(\\\$s); ${writer}->write(${var}); \$s" .
                   "}";
        });
    });
}

1;
__END__