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__ |