line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id$ |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package XML::Atom::Content; |
4
|
3
|
|
|
3
|
|
69128
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
122
|
|
5
|
3
|
|
|
3
|
|
16
|
use base qw( XML::Atom::Base ); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1269
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
__PACKAGE__->mk_attr_accessors(qw( type mode )); |
8
|
|
|
|
|
|
|
__PACKAGE__->mk_xml_attr_accessors(qw( lang base )); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use Encode; |
11
|
|
|
|
|
|
|
use XML::Atom; |
12
|
|
|
|
|
|
|
use MIME::Base64 qw( encode_base64 decode_base64 ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub element_name { 'content' } |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub init { |
17
|
|
|
|
|
|
|
my $content = shift; |
18
|
|
|
|
|
|
|
my %param = @_ == 1 ? (Body => $_[0]) : @_; |
19
|
|
|
|
|
|
|
$content->SUPER::init(%param); |
20
|
|
|
|
|
|
|
if ($param{Body}) { |
21
|
|
|
|
|
|
|
$content->body($param{Body}); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
if ($param{Type}) { |
24
|
|
|
|
|
|
|
$content->type($param{Type}); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
return $content; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub body { |
30
|
|
|
|
|
|
|
my $content = shift; |
31
|
|
|
|
|
|
|
my $elem = $content->elem; |
32
|
|
|
|
|
|
|
if (@_) { |
33
|
|
|
|
|
|
|
my $data = shift; |
34
|
|
|
|
|
|
|
if (LIBXML) { |
35
|
|
|
|
|
|
|
$elem->removeChildNodes; |
36
|
|
|
|
|
|
|
} else { |
37
|
|
|
|
|
|
|
$elem->removeChild($_) for $elem->getChildNodes; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
if (!_is_printable($data)) { |
40
|
|
|
|
|
|
|
Encode::_utf8_off($data); |
41
|
|
|
|
|
|
|
if (LIBXML) { |
42
|
|
|
|
|
|
|
$elem->appendChild(XML::LibXML::Text->new(encode_base64($data, ''))); |
43
|
|
|
|
|
|
|
} else { |
44
|
|
|
|
|
|
|
$elem->appendChild(XML::XPath::Node::Text->new(encode_base64($data, ''))); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
if ($content->version == 0.3) { |
48
|
|
|
|
|
|
|
$content->mode('base64'); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} else { |
51
|
|
|
|
|
|
|
my $copy = ' ' . |
52
|
|
|
|
|
|
|
$data . |
53
|
|
|
|
|
|
|
''; |
54
|
|
|
|
|
|
|
my $node; |
55
|
|
|
|
|
|
|
eval { |
56
|
|
|
|
|
|
|
if (LIBXML) { |
57
|
|
|
|
|
|
|
my $parser = XML::Atom->libxml_parser; |
58
|
|
|
|
|
|
|
my $tree = $parser->parse_string($copy); |
59
|
|
|
|
|
|
|
$node = $tree->getDocumentElement; |
60
|
|
|
|
|
|
|
} else { |
61
|
|
|
|
|
|
|
my $parser = XML::Atom->expat_parser; |
62
|
|
|
|
|
|
|
my $xp = XML::XPath->new(xml => $copy, parser => $parser); |
63
|
|
|
|
|
|
|
$node = (($xp->find('/')->get_nodelist)[0]->getChildNodes)[0] |
64
|
|
|
|
|
|
|
if $xp; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
}; |
67
|
|
|
|
|
|
|
if (!$@ && $node) { |
68
|
|
|
|
|
|
|
$elem->appendChild($node); |
69
|
|
|
|
|
|
|
if ($content->version == 0.3) { |
70
|
|
|
|
|
|
|
$content->mode('xml'); |
71
|
|
|
|
|
|
|
} else { |
72
|
|
|
|
|
|
|
$content->type('xhtml'); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} else { |
75
|
|
|
|
|
|
|
if (LIBXML) { |
76
|
|
|
|
|
|
|
$elem->appendChild(XML::LibXML::Text->new($data)); |
77
|
|
|
|
|
|
|
} else { |
78
|
|
|
|
|
|
|
$elem->appendChild(XML::XPath::Node::Text->new($data)); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
if ($content->version == 0.3) { |
82
|
|
|
|
|
|
|
$content->mode('escaped'); |
83
|
|
|
|
|
|
|
} else { |
84
|
|
|
|
|
|
|
$content->type($data =~ /^\s* ? 'html' : 'text'); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} else { |
89
|
|
|
|
|
|
|
unless (exists $content->{__body}) { |
90
|
|
|
|
|
|
|
my $mode; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
if ($content->version == 0.3) { |
93
|
|
|
|
|
|
|
$mode = $content->mode || 'xml'; |
94
|
|
|
|
|
|
|
} else { |
95
|
|
|
|
|
|
|
$mode = |
96
|
|
|
|
|
|
|
$content->type eq 'xhtml' ? 'xml' |
97
|
|
|
|
|
|
|
: $content->type =~ m![/\+]xml$! ? 'xml' |
98
|
|
|
|
|
|
|
: $content->type eq 'html' ? 'escaped' |
99
|
|
|
|
|
|
|
: $content->type eq 'text' ? 'escaped' |
100
|
|
|
|
|
|
|
: $content->type =~ m!^text/! ? 'escaped' |
101
|
|
|
|
|
|
|
: 'base64'; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
if ($mode eq 'xml') { |
105
|
|
|
|
|
|
|
my @children = grep ref($_) =~ /Element/, |
106
|
|
|
|
|
|
|
LIBXML ? $elem->childNodes : $elem->getChildNodes; |
107
|
|
|
|
|
|
|
if (@children) { |
108
|
|
|
|
|
|
|
if (@children == 1 && $children[0]->getLocalName eq 'div') { |
109
|
|
|
|
|
|
|
@children = |
110
|
|
|
|
|
|
|
LIBXML ? $children[0]->childNodes : |
111
|
|
|
|
|
|
|
$children[0]->getChildNodes |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
$content->{__body} = ''; |
114
|
|
|
|
|
|
|
for my $n (@children) { |
115
|
|
|
|
|
|
|
$content->{__body} .= $n->toString(LIBXML ? 1 : 0); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} else { |
118
|
|
|
|
|
|
|
$content->{__body} = LIBXML ? $elem->textContent : $elem->string_value; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
if ($] >= 5.008) { |
121
|
|
|
|
|
|
|
Encode::_utf8_off($content->{__body}) unless $XML::Atom::ForceUnicode; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
} elsif ($mode eq 'base64') { |
124
|
|
|
|
|
|
|
my $raw = decode_base64(LIBXML ? $elem->textContent : $elem->string_value); |
125
|
|
|
|
|
|
|
if ($content->type && $content->type =~ m!^text/!) { |
126
|
|
|
|
|
|
|
$content->{__body} = eval { Encode::decode("utf-8", $raw) } || $raw; |
127
|
|
|
|
|
|
|
Encode::_utf8_off($content->{__body}) unless $XML::Atom::ForceUnicode; |
128
|
|
|
|
|
|
|
} else { |
129
|
|
|
|
|
|
|
$content->{__body} = $raw; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} elsif ($mode eq 'escaped') { |
132
|
|
|
|
|
|
|
$content->{__body} = LIBXML ? $elem->textContent : $elem->string_value; |
133
|
|
|
|
|
|
|
} else { |
134
|
|
|
|
|
|
|
$content->{__body} = undef; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
$content->{__body}; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub _is_printable { |
142
|
|
|
|
|
|
|
my $data = shift; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
local $@; |
145
|
|
|
|
|
|
|
# try decoding this $data with UTF-8 |
146
|
|
|
|
|
|
|
my $decoded = |
147
|
|
|
|
|
|
|
( Encode::is_utf8($data) |
148
|
|
|
|
|
|
|
? $data |
149
|
|
|
|
|
|
|
: eval { Encode::decode("utf-8", $data, Encode::FB_CROAK) } ); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
return ! $@ && $decoded =~ /^[\p{IsPrint}\s]*$/; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
1; |