lib/XML/Feed/Format/Atom.pm

   1 # $Id$
   2
   3 package XML::Feed::Format::Atom;
   4 use strict;
   5
   6 use base qw( XML::Feed );
   7 use XML::Atom::Feed;
   8 use XML::Atom::Util qw( iso2dt );
   9 use List::Util qw( first );
  10 use DateTime::Format::W3CDTF;
  11
  12 use XML::Atom::Entry;
  13 XML::Atom::Entry->mk_elem_accessors(qw( lat long ), ['http://www.w3.org/2003/01/geo/wgs84_pos#']);
  14
  15 use XML::Atom::Content;
  16
  17 sub identify {
  18     my $class   = shift;
  19     my $xml     = shift;
  20     my $tag     = $class->_get_first_tag($xml);
  21     return ($tag eq 'feed');
  22 }
  23
  24
  25 sub init_empty {
  26     my ($feed, %args) = @_;
  27     $args{'Version'} ||= '1.0';
  28
  29     $feed->{atom} = XML::Atom::Feed->new(%args);
  30     $feed;
  31 }
  32
  33 sub init_string {
  34     my $feed = shift;
  35     my($str) = @_;
  36     if ($str) {
  37         $feed->{atom} = XML::Atom::Feed->new(Stream => $str)
  38             or return $feed->error(XML::Atom::Feed->errstr);
  39     }
  40     $feed;
  41 }
  42
  43 sub format { 'Atom' }
  44
  45 sub title { shift->{atom}->title(@_) }
  46 sub link {
  47     my $feed = shift;
  48     if (@_) {
  49         $feed->{atom}->add_link({ rel => 'alternate', href => $_[0],
  50                                   type => 'text/html', });
  51     } else {
  52         my $l = first { !defined $_->rel || $_->rel eq 'alternate' } $feed->{atom}->link;
  53         $l ? $l->href : undef;
  54     }
  55 }
  56
  57 sub self_link {
  58     my $feed = shift;
  59     if (@_) {
  60         my $uri = shift;
  61         $feed->{atom}->add_link({type => "application/atom+xml", rel => "self", href => $uri});
  62         return $uri;
  63     }
  64     else
  65     {
  66         my $l =
  67             first
  68             { !defined $_->rel || $_->rel eq 'self' }
  69             $feed->{atom}->link;
  70             ;
  71
  72         return $l ? $l->href : undef;
  73     }
  74 }
  75
  76 sub description { shift->{atom}->tagline(@_) }
  77 sub copyright   { shift->{atom}->copyright(@_) }
  78 sub language    { shift->{atom}->language(@_) }
  79 sub generator   { shift->{atom}->generator(@_) }
  80 sub id          { shift->{atom}->id(@_) }
  81 sub updated     { shift->{atom}->updated(@_) }
  82 sub add_link    { shift->{atom}->add_link(@_) }
  83 sub base        { shift->{atom}->base(@_) }
  84
  85 sub author {
  86     my $feed = shift;
  87     if (@_ && $_[0]) {
  88         my $person = XML::Atom::Person->new(Version => 1.0);
  89         $person->name($_[0]);
  90         $feed->{atom}->author($person);
  91     } else {
  92         $feed->{atom}->author ? $feed->{atom}->author->name : undef;
  93     }
  94 }
  95
  96
  97
  98
  99 sub modified {
 100     my $feed = shift;
 101     if (@_) {
 102         $feed->{atom}->modified(DateTime::Format::W3CDTF->format_datetime($_[0]));
 103     } else {
 104         return iso2dt($feed->{atom}->modified) if $feed->{atom}->modified;
 105         return iso2dt($feed->{atom}->updated)  if $feed->{atom}->updated;
 106         return undef;
 107     }
 108 }
 109
 110 sub entries {
 111     my @entries;
 112     for my $entry ($_[0]->{atom}->entries) {
 113         push @entries, XML::Feed::Entry::Format::Atom->wrap($entry);
 114     }
 115
 116     @entries;
 117 }
 118
 119 sub add_entry {
 120     my $feed  = shift;
 121     my $entry = shift || return;
 122     $entry    = $feed->_convert_entry($entry);
 123     $feed->{atom}->add_entry($entry->unwrap);
 124 }
 125
 126 sub as_xml { $_[0]->{atom}->as_xml }
 127
 128 package XML::Feed::Entry::Format::Atom;
 129 use strict;
 130
 131 use base qw( XML::Feed::Entry );
 132 use XML::Atom::Util qw( iso2dt );
 133 use XML::Feed::Content;
 134 use XML::Atom::Entry;
 135 use List::Util qw( first );
 136
 137 use constant ACTIVITY_NAMESPACE_URI => "http://activitystrea.ms/spec/1.0/";
 138 use constant ACTIVITY_NAMESPACE => XML::Atom::Namespace->new(
 139     'activity' => ACTIVITY_NAMESPACE_URI,
 140 );
 141
 142 sub init_empty {
 143     my $entry = shift;
 144     $entry->{entry} = XML::Atom::Entry->new(Version => 1.0);
 145     1;
 146 }
 147
 148 sub format { 'Atom' }
 149
 150 sub title { shift->{entry}->title(@_) }
 151 sub source { shift->{entry}->source(@_) }
 152 sub updated { shift->{entry}->updated(@_) }
 153 sub base { shift->{entry}->base(@_) }
 154
 155 sub link {
 156     my $entry = shift;
 157     if (@_) {
 158         $entry->{entry}->add_link({ rel => 'alternate', href => $_[0],
 159                                     type => 'text/html', });
 160     } else {
 161         my $l = first { !defined $_->rel || $_->rel eq 'alternate' } $entry->{entry}->link;
 162         $l ? $l->href : undef;
 163     }
 164 }
 165
 166 sub summary {
 167     my $entry = shift;
 168     if (@_) {
 169                 my %param;
 170                 if (ref($_[0]) eq 'XML::Feed::Content') {
 171                         %param = (Body => $_[0]->body);
 172                 } else {
 173                          %param = (Body => $_[0]);
 174                 }
 175                 $entry->{entry}->summary(XML::Atom::Content->new(%param, Version => 1.0));
 176     } else {
 177                 my $s = $entry->{entry}->summary;
 178         # map Atom types to MIME types
 179         my $type = ($s && ref($s) eq 'XML::Feed::Content') ? $s->type : undef;
 180         if ($type) {
 181             $type = 'text/html'  if $type eq 'xhtml' || $type eq 'html';
 182             $type = 'text/plain' if $type eq 'text';
 183         }
 184                 my $body = $s;
 185                 if (defined $s && ref($s) eq 'XML::Feed::Content') {
 186                         $body = $s->body;
 187                 }
 188         XML::Feed::Content->wrap({ type => $type,
 189                                    body => $body });
 190     }
 191 }
 192
 193 my %types = (
 194         'text/xhtml' => 'xhtml',
 195         'text/html'  => 'html',
 196         'text/plain' => 'text',
 197 );
 198
 199 sub content {
 200     my $entry = shift;
 201     if (@_) {
 202         my %param;
 203         my $base;
 204         if (ref($_[0]) eq 'XML::Feed::Content') {
 205                         if (defined $_[0]->type && defined $types{$_[0]->type}) {
 206                     %param = (Body => $_[0]->body, Type => $types{$_[0]->type});
 207                         } else {
 208                     %param = (Body => $_[0]->body);
 209                         }
 210             $base = $_[0]->base if defined $_[0]->base;
 211         } else {
 212             %param = (Body => $_[0]);
 213         }
 214         $entry->{entry}->content(XML::Atom::Content->new(%param, Version => 1.0));
 215         $entry->{entry}->content->base($base) if defined $base;
 216     } else {
 217         my $c = $entry->{entry}->content;
 218
 219         # map Atom types to MIME types
 220         my $type = $c ? $c->type : undef;
 221         if ($type) {
 222             $type = 'text/html'  if $type eq 'xhtml' || $type eq 'html';
 223             $type = 'text/plain' if $type eq 'text';
 224         }
 225
 226         XML::Feed::Content->wrap({ type => $type,
 227                                    base => $c ? $c->base : undef,
 228                                    body => $c ? $c->body : undef });
 229     }
 230 }
 231
 232 sub category {
 233     my $entry = shift;
 234     my $ns = XML::Atom::Namespace->new(dc => 'http://purl.org/dc/elements/1.1/');
 235     if (@_) {
 236         $entry->{entry}->add_category({ term => $_ }) for @_;
 237         return 1
 238     } else {
 239
 240
 241         my @category = ($entry->{entry}->can('categories')) ? $entry->{entry}->categories : $entry->{entry}->category;
 242         my @return = @category
 243             ? (map { $_->label || $_->term } @category)
 244             : $entry->{entry}->getlist($ns, 'subject');
 245
 246         return wantarray? @return : $return[0];
 247     }
 248 }
 249
 250 sub author {
 251     my $entry = shift;
 252     if (@_ && $_[0]) {
 253         my $person = XML::Atom::Person->new(Version => 1.0);
 254         $person->name($_[0]);
 255         $entry->{entry}->author($person);
 256     } else {
 257         $entry->{entry}->author ? $entry->{entry}->author->name : undef;
 258     }
 259 }
 260
 261 sub id { shift->{entry}->id(@_) }
 262
 263 sub issued {
 264     my $entry = shift;
 265     if (@_) {
 266         $entry->{entry}->issued(DateTime::Format::W3CDTF->format_datetime($_[0])) if $_[0];
 267     } else {
 268         $entry->{entry}->issued ? iso2dt($entry->{entry}->issued) : undef;
 269     }
 270 }
 271
 272 sub modified {
 273     my $entry = shift;
 274     if (@_) {
 275         $entry->{entry}->modified(DateTime::Format::W3CDTF->format_datetime($_[0])) if $_[0];
 276     } else {
 277         return iso2dt($entry->{entry}->modified) if $entry->{entry}->modified;
 278         return iso2dt($entry->{entry}->updated)  if $entry->{entry}->updated;
 279         return undef;
 280     }
 281 }
 282
 283 sub lat {
 284     my $entry = shift;
 285     if (@_) {
 286    $entry->{entry}->lat($_[0]) if $_[0];
 287     } else {
 288    $entry->{entry}->lat;
 289     }
 290 }
 291
 292 sub long {
 293     my $entry = shift;
 294     if (@_) {
 295    $entry->{entry}->long($_[0]) if $_[0];
 296     } else {
 297    $entry->{entry}->long;
 298     }
 299 }
 300
 301 sub activity_verbs {
 302     my $entry = shift;
 303     $entry->_activity('verb', @_);
 304 }
 305 sub activity_object_types {
 306     my $entry = shift;
 307     $entry->_activity('object-type', @_);
 308 }
 309
 310 sub _activity {
 311     my $entry = shift->{entry};
 312     my $name  = shift;
 313
 314     if (@_) {
 315         my @things = @_;
 316
 317         # Remove all of the existing elements.
 318         my @existing = XML::Atom::Util::childlist($entry->elem, ACTIVITY_NAMESPACE_URI(), $name);
 319         foreach my $elem (@existing) {
 320             $entry->elem->removeChild($elem);
 321         }
 322
 323         foreach my $thing (@things) {
 324             $entry->set(ACTIVITY_NAMESPACE(), $name, $thing, undef, 1);
 325         }
 326     }
 327     else {
 328         # FIXME: This currently returns all decendent things, not just
 329         # children. This might get troublesome if, for example,
 330         # there's ever an activity entry with an activity as its
 331         # object, or something crazy like that.
 332         return $entry->getlist(ACTIVITY_NAMESPACE(), $name);
 333     }
 334 }
 335
 336 sub activity_object {
 337     my $entry = shift->{entry};
 338
 339     if (@_) {
 340         # Need to accept any arbitrary XML::Feed::Entry and turn it into
 341         # an XML::Atom::Entry here, then call:
 342         # $entry->set(ACTIVITY_NAMESPACE, 'object', $xml_atom_entry);
 343         die "setting activity_object is not yet implemented";
 344     } else {
 345         my ($object_elem) = XML::Atom::Util::childlist($entry->elem, ACTIVITY_NAMESPACE_URI(), 'object');
 346         if (defined $object_elem) {
 347             my $ret = XML::Atom::Entry->new(Elem => $object_elem);
 348             # If we're holding an activity:object element then our primary
 349             # namespace will be set wrong, so let's put it back.
 350             XML::Atom::Util::set_ns($ret, { Version => "1.0" });
 351             return XML::Feed::Entry::Format::Atom->wrap($ret);
 352         }
 353         else {
 354             return undef;
 355         }
 356     }
 357 }
 358
 359 sub thumbnail_image {
 360     my $entry = shift;
 361     if (@_) {
 362         $entry->{entry}->add_link({ rel => 'alternate', href => $_[0],
 363                                     type => 'text/html', });
 364     } else {
 365         my $l = first { $_->rel eq 'preview' && $_->type =~ m!^image/! } $entry->{entry}->link;
 366
 367         if ($l) {
 368             # FIXME: This method for getting the attributes only works if
 369             # XML::Atom is using LibXML; XML::Atom doesn't provide
 370             # a proper way to get a namespaced attribute.
 371             return {
 372                 url => $l->href,
 373                 type => $l->type,
 374                 width => $l->elem->getAttributeNS("http://purl.org/syndication/atommedia", "width"),
 375                 height => $l->elem->getAttributeNS("http://purl.org/syndication/atommedia", "height"),
 376             };
 377         }
 378         else {
 379             return undef;
 380         }
 381     }
 382 }
 383 1;