File Coverage

blib/lib/Catmandu/Fix/xml_simple.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_simple;
2              
3             our $VERSION = '0.16';
4              
5 1     1   14948 use Catmandu::Sane;
  1         75363  
  1         5  
6 1     1   284 use Moo;
  1         2  
  1         4  
7 1     1   1686 use XML::Struct::Reader;
  0            
  0            
8             use XML::LibXML::Reader;
9             use Catmandu::Fix::Has;
10              
11             with 'Catmandu::Fix::Base';
12              
13             # TODO: avoid code duplication with xml_read
14              
15             has field => (fix_arg => 1);
16             has attributes => (fix_opt => 1);
17             has ns => (fix_opt => 1);
18             has content => (fix_opt => 1);
19             has root => (fix_opt => 1);
20             has depth => (fix_opt => 1);
21             has path => (fix_opt => 1);
22             has whitespace => (fix_opt => 1);
23              
24             sub simple { 1 }
25              
26             has _reader => (
27             is => 'ro',
28             lazy => 1,
29             builder => sub {
30             XML::Struct::Reader->new(
31             map { $_ => $_[0]->$_ } grep { defined $_[0]->$_ }
32             qw(attributes ns simple root depth content whitespace)
33             );
34             }
35             );
36              
37             sub emit {
38             my ($self,$fixer) = @_;
39              
40             my $path = $fixer->split_path($self->field);
41             my $key = pop @$path;
42            
43             my $reader = $fixer->capture($self->_reader);
44             my $xpath = $fixer->capture($self->path);
45             my $attributes = $fixer->capture($self->attributes);
46             # TODO: use XML::Struct::Simple instead
47             my $options = $fixer->capture({
48             map { $_ => $self->$_ } grep { defined $self->$_ }
49             qw(root depth attributes)
50             });
51              
52             return $fixer->emit_walk_path($fixer->var,$path,sub{
53             my $var = $_[0];
54             $fixer->emit_get_key($var,$key,sub{
55             my $var = $_[0];
56             return <
57             if (ref(${var}) and ref(${var}) =~ /^ARRAY/) {
58             ${var} = XML::Struct::simpleXML( ${var}, %{${options}} );
59             } else {
60             # TODO: code duplication with xml_read
61             my \$stream = XML::LibXML::Reader->new( string => ${var} );
62             ${var} = ${xpath}
63             ? [ ${reader}->readDocument(\$stream, ${xpath}) ]
64             : ${reader}->readDocument(\$stream);
65             }
66             PERL
67             });
68             });
69             }
70              
71             1;
72             __END__