| blib/lib/XML/Atom/Syndication/Content.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 58 | 80 | 72.5 |
| branch | 20 | 34 | 58.8 |
| condition | 11 | 15 | 73.3 |
| subroutine | 7 | 7 | 100.0 |
| pod | 2 | 3 | 66.6 |
| total | 98 | 139 | 70.5 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package XML::Atom::Syndication::Content; | ||||||
| 2 | 3 | 3 | 6450 | use strict; | |||
| 3 | 8 | ||||||
| 3 | 148 | ||||||
| 3 | |||||||
| 4 | 3 | 3 | 19 | use base qw( XML::Atom::Syndication::Object ); | |||
| 3 | 7 | ||||||
| 3 | 286 | ||||||
| 5 | |||||||
| 6 | 3 | 3 | 27 | use XML::Atom::Syndication::Util qw( utf8_off ); | |||
| 3 | 6 | ||||||
| 3 | 491 | ||||||
| 7 | 3 | 3 | 4479 | use MIME::Base64 qw( encode_base64 decode_base64 ); | |||
| 3 | 28123 | ||||||
| 3 | 3520 | ||||||
| 8 | |||||||
| 9 | XML::Atom::Syndication::Content->mk_accessors('attribute', 'type', 'src'); | ||||||
| 10 | XML::Atom::Syndication::Content->mk_accessors('attribute', 'mode') | ||||||
| 11 | ; # deprecated 0.3 accessors | ||||||
| 12 | |||||||
| 13 | sub init { | ||||||
| 14 | 13 | 13 | 0 | 64 | my $content = shift; | ||
| 15 | 13 | 50 | 81 | my %param = @_ == 1 ? (Body => $_[0]) : @_; # escaped text is assumed. | |||
| 16 | 13 | 83 | $content->SUPER::init(%param); | ||||
| 17 | 13 | 50 | my $e = $content->elem; | ||||
| 18 | 13 | 50 | 51 | if ($param{Body}) { | |||
| 19 | 0 | 0 | $content->body($param{Body}); | ||||
| 20 | } | ||||||
| 21 | 13 | 50 | 1720 | if ($param{Type}) { | |||
| 22 | 0 | 0 | $content->type($param{Type}); | ||||
| 23 | } | ||||||
| 24 | 13 | 76 | $content; | ||||
| 25 | } | ||||||
| 26 | |||||||
| 27 | 14 | 14 | 1 | 59 | sub element_name { 'content' } | ||
| 28 | |||||||
| 29 | sub body { | ||||||
| 30 | 11 | 11 | 1 | 30955 | my $content = shift; | ||
| 31 | 11 | 60 | my $elem = $content->elem; | ||||
| 32 | 11 | 59 | my $type = $elem->attributes->{'{}type'}; | ||||
| 33 | 11 | 101 | my $mode; | ||||
| 34 | 11 | 100 | 100 | 180 | if (!defined $type || $type eq 'text' || $type eq 'html') { | ||
| 100 | 100 | ||||||
| 50 | 66 | ||||||
| 66 | |||||||
| 35 | 6 | 18 | $mode = 'escaped'; | ||||
| 36 | } elsif ( $type eq 'xhtml' | ||||||
| 37 | || $type =~ | ||||||
| 38 | m{^(text/xml|application/xml|text/xml-external-parsed-entity)$} | ||||||
| 39 | || $type =~ m{[\+/]xml$}) { | ||||||
| 40 | 3 | 7 | $mode = 'xml'; | ||||
| 41 | } elsif ($type =~ m{text/.+}) { | ||||||
| 42 | 0 | 0 | $mode = 'escaped'; | ||||
| 43 | } else { | ||||||
| 44 | 2 | 5 | $mode = 'base64'; | ||||
| 45 | } | ||||||
| 46 | 11 | 100 | 33 | if (@_) { # set | |||
| 47 | 1 | 2 | my $data = shift; | ||||
| 48 | 1 | 50 | 6 | if ($mode eq 'base64') { # is binary | |||
| 50 | |||||||
| 49 | 0 | 0 | utf8_off($data); | ||||
| 50 | 0 | 0 | require XML::Elemental::Characters; | ||||
| 51 | 0 | 0 | my $b = XML::Elemental::Characters->new; | ||||
| 52 | 0 | 0 | $b->data(encode_base64($data, '')); | ||||
| 53 | 0 | 0 | $b->parent($elem); | ||||
| 54 | 0 | 0 | $elem->contents([$b]); | ||||
| 55 | } elsif ($mode eq 'xml') { # is xml | ||||||
| 56 | 0 | 0 | my $node = $data; | ||||
| 57 | 0 | 0 | 0 | unless (ref $node) { | |||
| 58 | 0 | 0 | my $copy = | ||||
| 59 | ' ' . $data |
||||||
| 60 | . ''; | ||||||
| 61 | 0 | 0 | eval { | ||||
| 62 | 0 | 0 | require XML::Elemental; | ||||
| 63 | 0 | 0 | my $parser = XML::Elemental->parser; | ||||
| 64 | 0 | 0 | my $xml = $parser->parse_string($copy); | ||||
| 65 | 0 | 0 | $node = $xml->contents->[0]; | ||||
| 66 | }; | ||||||
| 67 | 0 | 0 | 0 | return $content->error( | |||
| 68 | "Error parsing content body string as XML: $@") | ||||||
| 69 | if $@; | ||||||
| 70 | } | ||||||
| 71 | 0 | 0 | $node->parent($elem); | ||||
| 72 | 0 | 0 | $elem->contents([$node]); | ||||
| 73 | } else { # is text | ||||||
| 74 | 1 | 7 | my $text = XML::Elemental::Characters->new; | ||||
| 75 | 1 | 12 | $text->data($data); | ||||
| 76 | 1 | 12 | $text->parent($elem); | ||||
| 77 | 1 | 31 | $elem->contents([$text]); | ||||
| 78 | } | ||||||
| 79 | 1 | 14 | $content->{__body} = undef; | ||||
| 80 | 1 | 13 | 1; | ||||
| 81 | } else { # get | ||||||
| 82 | 10 | 50 | 46 | unless (defined $content->{__body}) { | |||
| 83 | 10 | 100 | 47 | if ($mode eq 'xml') { | |||
| 100 | |||||||
| 84 | 3 | 33 | my @children = | ||||
| 85 | 3 | 11 | grep { ref($_) eq 'XML::Elemental::Element' } | ||||
| 86 | 3 | 8 | @{$elem->contents}; | ||||
| 87 | 3 | 50 | 8 | if (@children) { | |||
| 88 | 3 | 13 | my ($local) = | ||||
| 89 | $children[0]->name =~ /{.*}(.+)/; # process name | ||||||
| 90 | 3 | 50 | 33 | 56 | @children = @{$children[0]->contents} | ||
| 3 | 9 | ||||||
| 91 | if (@children == 1 && $local eq 'div'); | ||||||
| 92 | |||||||
| 93 | # $content->{__body} = ' '; |
||||||
| 94 | 3 | 46 | my $w = XML::Atom::Syndication::Writer->new; | ||||
| 95 | 3 | 15 | $w->set_prefix('', 'http://www.w3.org/1999/xhtml'); | ||||
| 96 | 3 | 5 | map { $content->{__body} .= $w->as_xml($_) } @children; | ||||
| 5 | 32 | ||||||
| 97 | |||||||
| 98 | # $content->{__body} .= ''; | ||||||
| 99 | } else { | ||||||
| 100 | 0 | 0 | $content->{__body} = $elem->text_content; | ||||
| 101 | } | ||||||
| 102 | 3 | 50 | 15 | if ($] >= 5.008) { | |||
| 103 | 3 | 26 | require Encode; | ||||
| 104 | 3 | 17 | Encode::_utf8_on($content->{__body}); | ||||
| 105 | 3 | 12 | $content->{__body} =~ s/(\w{4});/chr(hex($1))/eg; | ||||
| 0 | 0 | ||||||
| 106 | 3 | 13 | Encode::_utf8_off($content->{__body}); | ||||
| 107 | } | ||||||
| 108 | } elsif ($mode eq 'base64') { | ||||||
| 109 | 2 | 9 | $content->{__body} = decode_base64($elem->text_content); | ||||
| 110 | } else { # escaped | ||||||
| 111 | 5 | 27 | $content->{__body} = $elem->text_content; | ||||
| 112 | } | ||||||
| 113 | } | ||||||
| 114 | 10 | 355 | $content->{__body}; | ||||
| 115 | } | ||||||
| 116 | } | ||||||
| 117 | |||||||
| 118 | 1; | ||||||
| 119 | |||||||
| 120 | __END__ |