File Coverage

blib/lib/XML/OPML/SimpleGen.pm

Criterion	Covered	Total	%
statement	39	79	49.3
branch	0	6	0.0
condition			n/a
subroutine	9	15	60.0
pod	8	8	100.0
total	56	108	51.8

package XML::OPML::SimpleGen;

use strict;
use warnings;

use base 'Class::Accessor';

use DateTime;

use POSIX qw(setlocale LC_TIME LC_CTYPE);

__PACKAGE__->mk_accessors(qw|groups xml_options outline group xml_head xml_outlines xml|);

# Version set by dist.ini; do not change here.
our $VERSION = '0.07'; # VERSION

sub new {
    my $class = shift;
    my @args = @_;

    my $args = {
	    groups  => {},

	    xml     => {
	        version     => '1.1',
	        @args,
	        },

	    # XML::Simple options
	    xml_options => {
	        RootName    => 'opml',
	        XMLDecl     => '',
	        AttrIndent  => 1,
	    },

	    # default values for nodes
	    outline => {
	        type        => 'rss',
	        version     => 'RSS',
	        text        => '',
	        title       => '',
	        description => '',
	    },

	    group => {
	        isOpen      => 'true',
	    },

	    xml_head        => {},
	    xml_outlines    => [],

	    id              => 1,
    };

    my $self = bless $args, $class;

    # Force locale to 'C' rather than local, then reset after setting times.
    # Fixes RT51000.  Thanks to KAPPA for the patch.
    my $old_loc = POSIX::setlocale(LC_TIME, "C");
    my $ts_ar = [ localtime() ];
    $self->head(
        title => '',
        $self->_date( dateCreated  => $ts_ar ),
        $self->_date( dateModified => $ts_ar ),
    );
    POSIX::setlocale(LC_TIME,$old_loc);

    return $self;
}

sub _date {
  my $self  = shift;
  my $type  = shift; # dateCreated or dateModified.
  my $ts_ar = shift; # e.g [ localtime() ]

  my %arg;
  @arg{qw(second minute hour day month year)} = (
      @{$ts_ar}[0..3],
      $ts_ar->[4]+1,
      $ts_ar->[5]+1900 );
  my $dt = DateTime->new( %arg );
  return ( $type => $dt->strftime('%a, %e %b %Y %H:%M:%S %z') );
}

sub id {
    my $self = shift;

    return $self->{id}++;
}

sub head {
    my $self = shift;
    my $data = {@_};

    #this is necessary, otherwise XML::Simple will just generate attributes
    while (my ($key,$value) = each %{ $data }) {
	    $self->xml_head->{$key} = [ $value ];
    }
}

sub add_group {
    my $self = shift;
    my %defaults = %{$self->group};
    my $data = {
        id => $self->id,
        %defaults,
        @_ };

    die "Need to define 'text' attribute" unless defined $data->{text};

    $data->{outline} = [];

    push @{$self->xml_outlines}, $data;
    $self->groups->{$data->{text}} = $data->{outline};
}

sub insert_outline {
    my $self = shift;
    my %defaults = %{$self->outline};
    my $data = {
        id => $self->id,
        %defaults,
        @_};

    my $parent = $self->xml_outlines;

    if (exists $data->{group}) {
	    if (exists $self->groups->{$data->{group}}) {
	        $parent = $self->groups->{$data->{group}};
	        delete($data->{group});
	    }
        else {
	        $self->add_group('text' => $data->{group});
	        $self->insert_outline(%$data);
	        return;
	    }
    }

    push @{$parent}, $data;
}

sub add_outline {
    my $self = shift;
    $self->insert_outline(@_);
}

sub as_string {
    my $self = shift;

    require  XML::Simple;
    my $xs = XML::Simple->new();

    return $xs->XMLout( $self->_mk_hashref, %{$self->xml_options} );
}

sub _mk_hashref {
    my $self = shift;

    my $hashref =  {
	    %{$self->xml},
	    head => $self->xml_head,
	    body => { outline => $self->xml_outlines },
    };

    return $hashref;
}

sub save {
    my $self = shift;
    my $filename = shift;

    require  XML::Simple;
    my $xs = XML::Simple->new();

    $xs->XMLout( $self->_mk_hashref, %{$self->xml_options}, OutputFile => $filename );
}

1;

# ABSTRACT:  create OPML using XML::Simple

__END__