local-lib5/lib/perl5/XML/Atom/Content.pm

   1 # $Id$
   2
   3 package XML::Atom::Content;
   4 use strict;
   5 use base qw( XML::Atom::Base );
   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 = '<div xmlns="http://www.w3.org/1999/xhtml">' .
  52                        $data .
  53                        '</div>';
  54             my $node;
  55             eval {
  56                 if (LIBXML) {
  57                     my $parser = XML::LibXML->new;
  58                     my $tree = $parser->parse_string($copy);
  59                     $node = $tree->getDocumentElement;
  60                 } else {
  61                     my $xp = XML::XPath->new(xml => $copy);
  62                     $node = (($xp->find('/')->get_nodelist)[0]->getChildNodes)[0]
  63                         if $xp;
  64                 }
  65             };
  66             if (!$@ && $node) {
  67                 $elem->appendChild($node);
  68                 if ($content->version == 0.3) {
  69                     $content->mode('xml');
  70                 } else {
  71                     $content->type('xhtml');
  72                 }
  73             } else {
  74                 if (LIBXML) {
  75                     $elem->appendChild(XML::LibXML::Text->new($data));
  76                 } else {
  77                     $elem->appendChild(XML::XPath::Node::Text->new($data));
  78                 }
  79
  80                 if ($content->version == 0.3) {
  81                     $content->mode('escaped');
  82                 } else {
  83                     $content->type($data =~ /^\s*</ ? 'html' : 'text');
  84                 }
  85             }
  86         }
  87     } else {
  88         unless (exists $content->{__body}) {
  89             my $mode;
  90
  91             if ($content->version == 0.3) {
  92                 $mode = $content->mode || 'xml';
  93             } else {
  94                 $mode =
  95                     $content->type eq 'xhtml'         ? 'xml'
  96                   : $content->type =~ m![/\+]xml$!    ? 'xml'
  97                   : $content->type eq 'html'          ? 'escaped'
  98                   : $content->type eq 'text'          ? 'escaped'
  99                   : $content->type =~ m!^text/!       ? 'escaped'
 100                   :                                     'base64';
 101             }
 102
 103             if ($mode eq 'xml') {
 104                 my @children = grep ref($_) =~ /Element/,
 105                     LIBXML ? $elem->childNodes : $elem->getChildNodes;
 106                 if (@children) {
 107                     if (@children == 1 && $children[0]->getLocalName eq 'div') {
 108                         @children =
 109                             LIBXML ? $children[0]->childNodes :
 110                                      $children[0]->getChildNodes
 111                     }
 112                     $content->{__body} = '';
 113                     for my $n (@children) {
 114                         $content->{__body} .= $n->toString(LIBXML ? 1 : 0);
 115                     }
 116                 } else {
 117                     $content->{__body} = LIBXML ? $elem->textContent : $elem->string_value;
 118                 }
 119                 if ($] >= 5.008) {
 120                     Encode::_utf8_off($content->{__body}) unless $XML::Atom::ForceUnicode;
 121                 }
 122             } elsif ($mode eq 'base64') {
 123                 my $raw = decode_base64(LIBXML ? $elem->textContent : $elem->string_value);
 124                 if ($content->type && $content->type =~ m!^text/!) {
 125                     $content->{__body} = eval { Encode::decode("utf-8", $raw) } || $raw;
 126                     Encode::_utf8_off($content->{__body}) unless $XML::Atom::ForceUnicode;
 127                 } else {
 128                     $content->{__body} = $raw;
 129                 }
 130             } elsif ($mode eq 'escaped') {
 131                 $content->{__body} = LIBXML ? $elem->textContent : $elem->string_value;
 132             } else {
 133                 $content->{__body} = undef;
 134             }
 135         }
 136     }
 137     $content->{__body};
 138 }
 139
 140 sub _is_printable {
 141     my $data = shift;
 142
 143     local $@;
 144     # try decoding this $data with UTF-8
 145     my $decoded =
 146         ( Encode::is_utf8($data)
 147           ? $data
 148           : eval { Encode::decode("utf-8", $data, Encode::FB_CROAK) } );
 149
 150     return ! $@ && $decoded =~ /^\p{IsPrint}*$/;
 151 }
 152
 153 1;