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


line stmt bran cond sub pod time code
1             package Catmandu::Fix::xml_write;
2             #ABSTRACT: parse XML
3             our $VERSION = '0.14'; #VERSION
4              
5 1     1   25955 use Catmandu::Sane;
  1         141133  
  1         7  
6 1     1   294 use Moo;
  1         2  
  1         5  
7 1     1   2359 use XML::Struct::Writer;
  0            
  0            
8             use XML::LibXML::Reader;
9              
10             with 'Catmandu::Fix::Base';
11              
12             has field => (is => 'ro', required => 1);
13             has attributes => (is => 'ro');
14             has pretty => (is => 'ro');
15             has encoding => (is => 'ro', default => sub { 'UTF-8' });
16             has version => (is => 'ro');
17             has standalone => (is => 'ro');
18             has xmldecl => (is => 'ro', default => sub { 1 });
19              
20             around BUILDARGS => sub {
21             my ($orig,$class,$field,%opts) = @_;
22             $orig->($class,
23             field => $field,
24             map { $_ => $opts{$_} } grep { defined $opts{$_} }
25             qw(attributes pretty encoding version standalone xmldecl)
26             );
27             };
28              
29             has _writer => (
30             is => 'ro',
31             lazy => 1,
32             builder => sub {
33             XML::Struct::Writer->new(
34             map { $_ => $_[0]->$_ } grep { defined $_[0]->$_ }
35             qw(attributes pretty encoding version standalone xmldecl)
36             );
37             }
38             );
39              
40             sub emit {
41             my ($self,$fixer) = @_;
42              
43             my $path = $fixer->split_path($self->field);
44             my $key = pop @$path;
45            
46             my $writer = $fixer->capture($self->_writer);
47             my $pretty = $fixer->capture($self->pretty);
48              
49             return $fixer->emit_walk_path($fixer->var,$path,sub{
50             my $var = $_[0];
51             $fixer->emit_get_key($var,$key,sub{
52             my $var = $_[0];
53             return "${var} = (ref(${var}) =~ 'XML::LibXML::Document=')" .
54             "? ${var}->serialize(${pretty}) : do {".
55             "my \$s=''; ${writer}->to(\\\$s); ${writer}->write(${var}); \$s" .
56             "}";
57             });
58             });
59             }
60              
61              
62             1;
63              
64             __END__