view release on metacpan or  search on metacpan

lib/XML/FeedWriter/Base.pm  view on Meta::CPAN

package XML::FeedWriter::Base;

use strict;
use warnings;
use Carp;
use base qw( Class::Accessor::Fast Class::Data::Inheritable );
use Encode;
use DateTimeX::Web;
use XML::Writer;

__PACKAGE__->mk_accessors(qw(
  xml dtx
  _closed _output _encoding _use_cdata
));

__PACKAGE__->mk_classdata( _alias => {} );
__PACKAGE__->mk_classdata( _requires => {} );
__PACKAGE__->mk_classdata( _sort_order => {} );

sub new {
  my ($class, %options) = @_;

  delete $options{version};  # this is for XML::FeedWriter only.

  my $encoding = delete $options{encoding} || 'utf-8';

  my $output;
  my $self = bless {
    xml => XML::Writer->new( OUTPUT => \$output ),
    dtx => DateTimeX::Web->new,
    _output    => \$output,
    _encoding  => $encoding,
    _closed    => 0,
  }, $class;

  $self->_extra_options( \%options );

  my $modules = delete $options{modules} || {};
  my %channel = $self->_canonize( \%options );

  $self->_validate( channel => \%channel );

  $self->xml->xmlDecl( $self->_encoding );

  $self->_root_element( $modules );

  $self->xml->setDataMode(1);
  $self->xml->setDataIndent(2);

  $self->_channel( \%channel );

  return $self;
}

sub _extra_options {}
sub _root_element {}
sub _channel {}

sub add_items {}

sub close {}

sub save {
  my ($self, $file) = @_;

  $self->close unless $self->_closed;

  open my $fh, '>', $file;
  binmode $fh;
  print $fh encode( $self->_encoding, $self->as_string );
  CORE::close $fh;
}

sub as_string { ${ shift->_output } }

sub _data_element {
  my ($self, $key, $data) = @_;

  if ( ref $data eq 'ARRAY' ) {
    $self->xml->dataElement( $key => @{ $data } );
  }
  elsif ( ref $data eq 'HASH' ) {
    my %attr = %{ $data };
    my $value = delete $attr{value};
    $self->xml->dataElement( $key => $value, %attr );
  }
  else {
    $self->xml->dataElement( $key => $data );
  }
}

sub _cdata_element {
  my ($self, $key, $data) = @_;

  if ( $self->_use_cdata ) {
    $self->xml->cdataElement( $key => $data );
  }
  else {
    $self->_data_element( $key => $data );
  }
}

sub _datetime_element {
  my ($self, $key, $data) = @_;

  my $datetime;
  if ( ref $data eq 'ARRAY' ) {
    $datetime = $self->dtx->for_rss20( @{ $data } );
  }
  if ( ref $data eq 'HASH' ) {
    $datetime = $self->dtx->for_rss20( %{ $data } );
  }
  elsif ( ref $data ) {
    $datetime = $self->dtx->for_rss20( $data );
  }
  elsif ( $data && $data =~ /^\d+$/ ) {
    $datetime = $self->dtx->for_rss20( epoch => $data );
  }
  else {
    $datetime = $self->dtx->for_rss20;
  }

  $self->_data_element( $key => $datetime );
}

sub _empty_element {
  my ($self, $key, $hashref) = @_;

  $self->_validate( $key => $hashref );
  $self->xml->emptyTag( $key => %{ $hashref } );
}

sub _element_with_children {
  my ($self, $key, $children) = @_;

  $self->_validate( $key => $children );

  $self->xml->startTag($key);
  foreach my $subkey ( $self->_sort_keys( $children ) ) {
    $self->_data_element( $subkey => $children->{$subkey} );
  }
  $self->xml->endTag($key);
}

sub _duplicable_elements {
  my ($self, $key, $data) = @_;

  if ( ref $data eq 'ARRAY' ) {
    foreach my $item ( @{ $data } ) {
      $self->_data_element( $key => $item );
    }
  }
  else {
    $self->_data_element( $key => $data );
  }
}