File Coverage

blib/lib/XML/Loy/Atom.pm

Criterion	Covered	Total	%
statement	183	192	95.3
branch	84	104	80.7
condition	20	30	66.6
subroutine	34	34	100.0
pod	19	19	100.0
total	340	379	89.7

package XML::Loy::Atom;
use Carp qw/carp/;
use strict;
use warnings;
use Mojo::ByteStream 'b';
use XML::Loy::Date::RFC3339;

# Todo:
#  - see http://search.cpan.org/dist/XML-Atom-SimpleFeed

our @CARP_NOT;

# Make it an XML::Loy base class
use XML::Loy with => (
  mime      => 'application/atom+xml',
  prefix    => 'atom',
  namespace => 'http://www.w3.org/2005/Atom'
);


# Namespace declaration
state $XHTML_NS = 'http://www.w3.org/1999/xhtml';


# New person construct
sub new_person {
  my $self = shift;
  my $person = ref($self)->SUPER::new('person');

  my %hash = @_;
  $person->set($_ => $hash{$_}) foreach keys %hash;
  return $person;
};


# New text construct
sub new_text {
  my $self = shift;

  return unless $_[0];

  my $class = ref($self);

  # Expect empty html
  unless (defined $_[1]) {
    return $class->SUPER::new(
      text => {
	type  => 'text',
	-type => 'raw'
      } => shift );
  };

  my ($type, $content, %hash);

  # Only textual content
  if (!defined $_[2] && $_[0] =~ m/(?:text|x?html)/) {
    $type = shift;
    $content = shift;
  }

  # Hash definition
  elsif ((@_ % 2) == 0) {
    %hash = @_;

    $type = delete $hash{type} || 'text';

    if (exists $hash{src}) {
      return $class->SUPER::new(
	text => { type => $type, %hash }
      );
    };

    $content = delete $hash{content} or return;
  };

  # Content node
  my $c_node;

  # xhtml
  if ($type eq 'xhtml') {

    # Create new by hash
    $c_node = $class->SUPER::new(
      text => {
	type => $type,
	%hash
      });

    # XHTML content - allowed to be pretty printed
   $c_node->add(
      -div => {
	xmlns => $XHTML_NS
      })->append_content($content);
  }

  # html or text
  elsif ($type eq 'html' || $type =~ /^text/i) {

    # Content is raw and thus nonindented
    $c_node = $class->new(
      text => {
	'type'  => $type,
	'-type' => 'raw',
	'xml:space' => 'preserve',
	%hash
      } => $content . ''
    );
  }

  # xml media type
  elsif ($type =~ /[\/\+]xml(;.+)?$/i) {
    $c_node = $class->new(
      text => {
	type  => $type,
	-type => 'raw',
	%hash
      } => $content);
  }

  # all other media types
  else {
    $c_node = $class->new(
      text => {
	type => $type,
	-type => 'armour',
	%hash
      },
      $content);
  };

  return $c_node;
};


# Add author information
sub author {
  my $self = shift;

  # Add author
  return $self->_add_person(author => @_) if $_[0];

  # Get author information
  return $self->_get_information_array('author');
};


# Add category information
sub category {
  my $self = shift;

  # Set category
  if ($_[0]) {
    if (!defined $_[1]) {
      return $self->add(category => { term => shift });
    };

    return $self->add(category => { @_ } );
  };

  # Get category
  my $coll = $self->_get_information_array('category')
    or return;

  if ($coll->[0]) {
    $coll->map(sub { $_ = $_->{term} });
  };

  return $coll;
};


# Add contributor information
sub contributor {
  my $self = shift;

  # Add contributor
  return $self->_add_person(contributor => @_) if $_[0];

  # Get contributor information
  return $self->_get_information_array('contributor');
};


# Add content information
sub content {
  my $self = shift;

  # Set content
  return $self->_addset_text(set => content => @_) if $_[0];

  # Return content
  return $self->_get_information_single('content');
};


# Set or get entry
sub entry {
  my $self = shift;

  # Is object
  if (ref $_[0]) {
    return $self->add(@_);
  }

  # Get entry
  elsif ($_[0] && !$_[1]) {

    my $id = shift;

    # Get based on xml:id
    my $entry = $self->at(qq{entry[xml\\:id="$id"]});
    return $entry if $entry;

    # Get based on id
    my $idc = $self->find('entry > id')->grep(sub { $_->text eq $id });

    return unless $idc && $idc->[0];

    return $idc->[0]->parent;
  };

  my %hash = @_;
  my $entry;

  # Set id additionally as xml:id
  if (exists $hash{id}) {
    $entry = $self->add(
      entry => {'xml:id' => $hash{id}}
    );
  }

  # No id given
  else {
    $entry = $self->add('entry');
  };

  # Add information
  foreach (keys %hash) {
    $entry->add($_, $hash{$_});
  };

  return $entry;
};


# Set or get generator information
sub generator {
  shift->_simple_feed_info(generator =>  @_);
};


# Set or get icon information
sub icon {
  shift->_simple_feed_info(icon =>  @_);
};


# Add id
sub id {
  my $self = shift;

  # Get id
  unless ($_[0]) {
    my $id_obj = $self->_get_information_single('id');
    return $id_obj->text if $id_obj;
    return;
  };

  my $id = shift;
  my $element = $self->set(id => $id);
  return unless $element;

  # Add xml:id also
  $element->parent->attr('xml:id' => $id);
  return $self;
};


# Add link information
sub link {
  my $self = shift;

  if ($_[1]) {

    # rel => href
    if (@_ == 2) {
      return $self->add(link => {
	rel  => shift,
	href => shift
      });
    };

    # Parameter
    my %values = @_;
    # href, rel, type, hreflang, title, length
    my $rel = delete $values{rel} || 'related';
    return $self->add(link => {
      rel => $rel,
      %values
    });
  };

  my $rel = shift;

  my $children;
  # Node is root
  unless ($self->parent) {
    $children = $self->at('*')->children('link');
  }

  # Node is under root
  else {
    $children = $self->children('link');
  };

  return $children->grep(sub { $_->attr('rel') eq $rel });
};


# Add logo
sub logo {
  shift->_simple_feed_info(logo =>  @_);
};


# Add publish time information
sub published {
  shift->_date(published => @_);
};


# Add rights information
sub rights {
  my $self = shift;

  # Set rights
  return $self->_addset_text(set => rights => @_) if $_[0];

  # Return rights
  return $self->_get_information_single('rights');
};


# Add source information to entry
sub source {
  my $self = shift;

  # Only valid in entry
  return if !$self->tag || $self->tag ne 'entry';

  # Set source
  return $self->set(source => @_) if $_[0];

  # Return source
  return $self->_get_information_single('source');
};


# Add subtitle
sub subtitle {
  my $self = shift;

  # Only valid in feed or source or something
  return if $self->tag && $self->tag eq 'entry';

  # Set subtitle
  return $self->_addset_text(set => subtitle => @_) if $_[0];

  # Return subtitle
  return $self->_get_information_single('subtitle');
};


# Add summary
sub summary {
  my $self = shift;

  # Only valid in entry
  return if !$self->tag || $self->tag ne 'entry';

  # Set summary
  return $self->_addset_text(set => summary => @_) if $_[0];

  # Return summary
  return $self->_get_information_single('summary');
};


# Add title
sub title {
  my $self = shift;

  # Set title
  return $self->_addset_text(set => title => @_) if $_[0];

  # Return title
  return $self->_get_information_single('title');
};


# Add update time information
sub updated {
  shift->_date(updated => @_);
};


# Add person information
sub _add_person {
  my $self = shift;
  my $type = shift;

  # Person is a defined node
  if (ref($_[0])) {
    my $person = shift;
    $person->root->at('*')->tree->[1] = $type;
    return $self->add($person);
  }

  # Person is a hash
  else {
    my $person = $self->add($type);
    my %data = @_;

    foreach (keys %data) {
      $person->add($_ => $data{$_} ) if $data{$_};
    };
    return $person;
  };
};


# Add date construct
sub _date {
  my $self = shift;
  my $type = shift;

  # Set date
  if ($_[0]) {
    my $date = shift;

    unless (ref($date)) {
      $date = XML::Loy::Date::RFC3339->new($date);
    };

    return $self->set($type, $date->to_string);
  };

  # Get published information
  my $date = $self->_get_information_single($type);

  # Parse date
  return XML::Loy::Date::RFC3339->new($date->text) if $date;

  # No publish information found
  return;
};


# Add text information
sub _addset_text {
  my $self   = shift;
  my $action = shift;

  unless ($action eq 'add' || $action eq 'set') {
    warn 'Action has to be set or add' and return;
  };

  my $type = shift;

  # Text is a defined node
  if (ref $_[0]) {

    my $text = shift;

    # Get root element
    my $root_elem = $text->root->at('*');

    $root_elem->tree->[1] = $type;
    my $root_att = $root_elem->attr;

    # Delete type
    my $c_type = $root_att->{type} || '';
    if ($c_type eq 'text') {
      delete $root_elem->attr->{'type'};
    };

    $text->root->at('*')->tree->[1] = $type;

    my $element = $self->$action($text);

    # Return wrapped div
    return $element->at('div') if $c_type eq 'xhtml';

    # Return node
    return $element;
  };

  my $text;
  # Text is no hash
  unless (defined $_[1]) {
    $text = $self->new_text(
      type => 'text',
      content => shift
    );
  }

  # Text is a hash
  else {
    $text = $self->new_text(@_);
  };

  # Todo: Optimize!
  return $self->_addset_text($action, $type, $text) if ref $text;
  return;
};


# Return information of entries or the feed
sub _get_information_array {
  my $self = shift;
  my $type = shift;

  # Get author objects
  my $children = $self->children($type);

  # Return information of object
  return $children if $children->[0];

  # Return feed information
  return $self->find('feed > ' . $type);
};


# Return information of entries or the feed
sub _get_information_single {
  my $self = shift;
  my $type = shift;

  # Get author objects
  my $children = $self->children($type);

  # Return information of object
  return $children->[0] if $children->[0];

  # Return feed information
  return $self->at('feed > ' . $type);
};


# Get or set simple feed information
# like generator or icon
sub _simple_feed_info {
  my $self = shift;
  my $type = shift;

  my $feed = $self->root->at('feed');
  return unless $feed;

  # Set
  if ($_[0]) {
    return $feed->set($type => @_);
  };

  # Get generator information
  my $gen = $feed->at($type);
  return $gen->all_text if $gen;
  return;
};


1;


__END__