lib/XML/Feed/Entry/Format/Atom.pm

   1 package XML::Feed::Entry::Format::Atom;
   2 use strict;
   3
   4 use base qw( XML::Feed::Entry );
   5 use XML::Atom::Util qw( iso2dt );
   6 use XML::Feed::Content;
   7 use XML::Atom::Entry;
   8 use List::Util qw( first );
   9
  10 sub init_empty {
  11     my $entry = shift;
  12     $entry->{entry} = XML::Atom::Entry->new(Version => 1.0);
  13     1;
  14 }
  15
  16 sub format { 'Atom' }
  17
  18 sub title { shift->{entry}->title(@_) }
  19 sub source { shift->{entry}->source(@_) }
  20 sub updated { shift->{entry}->updated(@_) }
  21 sub base { shift->{entry}->base(@_) }
  22
  23 sub link {
  24     my $entry = shift;
  25     if (@_) {
  26         $entry->{entry}->add_link({ rel => 'alternate', href => $_[0],
  27                                     type => 'text/html', });
  28     } else {
  29         my $l = first { !defined $_->rel || $_->rel eq 'alternate' } $entry->{entry}->link;
  30         $l ? $l->href : undef;
  31     }
  32 }
  33
  34 sub summary {
  35     my $entry = shift;
  36     if (@_) {
  37         my %param;
  38         if (ref($_[0]) eq 'XML::Feed::Content') {
  39             %param = (Body => $_[0]->body);
  40         } else {
  41             %param = (Body => $_[0]);
  42         }
  43         $entry->{entry}->summary(XML::Atom::Content->new(%param, Version => 1.0));
  44     } else {
  45         my $s = $entry->{entry}->summary;
  46         # map Atom types to MIME types
  47         my $type = ($s && ref($s) eq 'XML::Feed::Content') ? $s->type : undef;
  48         if ($type) {
  49             $type = 'text/html'  if $type eq 'xhtml' || $type eq 'html';
  50             $type = 'text/plain' if $type eq 'text';
  51         }
  52         my $body = $s;
  53         if (defined $s && ref($s) eq 'XML::Feed::Content') {
  54             $body = $s->body;
  55         }
  56         XML::Feed::Content->wrap({ type => $type,
  57                                    body => $body });
  58     }
  59 }
  60
  61 my %types = (
  62     'text/xhtml' => 'xhtml',
  63     'text/html'  => 'html',
  64     'text/plain' => 'text',
  65 );
  66
  67 sub content {
  68     my $entry = shift;
  69     if (@_) {
  70         my %param;
  71         my $base;
  72         my $orig_body;
  73         if (ref($_[0]) eq 'XML::Feed::Content') {
  74             $orig_body = $_[0]->body;
  75             if (defined $_[0]->type && defined $types{$_[0]->type}) {
  76                 %param = (Body => $orig_body, Type => $types{$_[0]->type});
  77
  78                 if ($param{'Type'} eq "html") {
  79                     $param{'Body'} = HTML::Entities::encode_entities($param{'Body'});
  80                 }
  81             } else {
  82             }
  83             $base = $_[0]->base if defined $_[0]->base;
  84         } else {
  85             $orig_body = $_[0];
  86         }
  87         if (!exists($param{Body}))
  88         {
  89             $param{Body} = $orig_body;
  90         }
  91         $entry->{entry}->content(XML::Atom::Content->new(%param, Version => 1.0));
  92         # Assigning again so the type will be normalized. This seems to be
  93         # an XML-Atom do-what-I-don't-meannery.
  94         $entry->{entry}->content->body($orig_body);
  95         $entry->{entry}->content->base($base) if defined $base;
  96     } else {
  97         my $c = $entry->{entry}->content;
  98
  99         # map Atom types to MIME types
 100         my $type = $c ? $c->type : undef;
 101         if ($type) {
 102             $type = 'text/html'  if $type eq 'xhtml' || $type eq 'html';
 103             $type = 'text/plain' if $type eq 'text';
 104         }
 105
 106         XML::Feed::Content->wrap({ type => $type,
 107                                    base => $c ? $c->base : undef,
 108                                    body => $c ? $c->body : undef });
 109     }
 110 }
 111
 112 sub category {
 113     my $entry = shift;
 114     my $ns = XML::Atom::Namespace->new(dc => 'http://purl.org/dc/elements/1.1/');
 115     if (@_) {
 116         $entry->{entry}->add_category({ term => $_ }) for @_;
 117         return 1
 118     } else {
 119
 120
 121         my @category = ($entry->{entry}->can('categories')) ? $entry->{entry}->categories : $entry->{entry}->category;
 122         my @return = @category
 123             ? (map { $_->label || $_->term } @category)
 124             : $entry->{entry}->getlist($ns, 'subject');
 125
 126         return wantarray? @return : $return[0];
 127     }
 128 }
 129
 130 sub author {
 131     my $entry = shift;
 132     if (@_ && $_[0]) {
 133         my $person = XML::Atom::Person->new(Version => 1.0);
 134         $person->name($_[0]);
 135         $entry->{entry}->author($person);
 136     } else {
 137         $entry->{entry}->author ? $entry->{entry}->author->name : undef;
 138     }
 139 }
 140
 141 sub id { shift->{entry}->id(@_) }
 142
 143 sub issued {
 144     my $entry = shift;
 145     if (@_) {
 146         $entry->{entry}->issued(DateTime::Format::W3CDTF->format_datetime($_[0])) if $_[0];
 147     } else {
 148         return iso2dt($entry->{entry}->issued)
 149             if $entry->{entry}->issued;
 150         return iso2dt($entry->{entry}->published)
 151             if $entry->{entry}->published;
 152         return undef;
 153     }
 154 }
 155
 156 sub modified {
 157     my $entry = shift;
 158     if (@_) {
 159         $entry->{entry}->modified(DateTime::Format::W3CDTF->format_datetime($_[0])) if $_[0];
 160     } else {
 161         return iso2dt($entry->{entry}->modified) if $entry->{entry}->modified;
 162         return iso2dt($entry->{entry}->updated)  if $entry->{entry}->updated;
 163         return undef;
 164     }
 165 }
 166
 167 sub lat {
 168     my $entry = shift;
 169     if (@_) {
 170    $entry->{entry}->lat($_[0]) if $_[0];
 171     } else {
 172    $entry->{entry}->lat;
 173     }
 174 }
 175
 176 sub long {
 177     my $entry = shift;
 178     if (@_) {
 179    $entry->{entry}->long($_[0]) if $_[0];
 180     } else {
 181    $entry->{entry}->long;
 182     }
 183 }
 184
 185
 186 sub enclosure {
 187     my $entry = shift;
 188
 189     if (@_) {
 190         my $enclosure = shift;
 191         my $method    = ($XML::Feed::MULTIPLE_ENCLOSURES)? 'add_link' : 'link';
 192         $entry->{entry}->$method({ rel => 'enclosure', href => $enclosure->{url},
 193                                 length => $enclosure->{length},
 194                                 type   => $enclosure->{type} });
 195         return 1;
 196     } else {
 197         my @links = grep { defined $_->rel && $_->rel eq 'enclosure' } $entry->{entry}->link;
 198         return unless @links;
 199         my @encs = map { XML::Feed::Enclosure->new({ url => $_->href, length => $_->length, type => $_->type }) } @links ;
 200         return ($XML::Feed::MULTIPLE_ENCLOSURES)? @encs : $encs[-1];
 201     }
 202 }
 203
 204
 205 1;
 206