package Perlanet::Trait::OPML; use Moose::Role; use namespace::autoclean; use Carp qw( carp ); use POSIX qw(setlocale LC_ALL); =head1 NAME Perlanet::Trait::OPML - generate an OPML file =head1 SYNOPSIS my $perlanet = Perlanet->new_with_traits( traits => [ 'Perlanet::Trait::OPML' ] ); $perlanet->run; =head1 DESCRIPTION Generates an OPML file of all feeds that are being aggregated by the planet. =head1 ATTRIBUTES =head2 opml_generator An L object to generate the XML for the OPML file =cut has 'opml_generator' => ( is => 'rw', isa => 'Maybe[XML::OPML::SimpleGen]', lazy_build => 1, predicate => 'has_opml' ); sub _build_opml_generator { my $self = shift; eval { require XML::OPML::SimpleGen; }; if ($@) { carp 'You need to install XML::OPML::SimpleGen to enable OPML ' . 'support'; $self->opml(undef); return; } my $loc = setlocale(LC_ALL, 'C'); my $opml = XML::OPML::SimpleGen->new; setlocale(LC_ALL, $loc); $opml->head( title => $self->title, ); return $opml; } =head2 opml_file Where to save the OPML feed when it has been created =cut has 'opml' => ( isa => 'Maybe[Str]', is => 'rw', ); =head1 METHODS =head2 update_opml Updates the OPML file of all contributers to this planet. If the L attribute does not have a value, this method does nothing, otherwise it inserts each author into the OPML file and saves it to disk. =cut sub update_opml { my ($self, @feeds) = @_; return unless $self->has_opml; foreach my $f (@feeds) { $self->opml_generator->insert_outline( title => $f->title, text => $f->title, xmlUrl => $f->url, htmlUrl => $f->url, ); } $self->save_opml; } =head2 save_opml Save the OPML file, by default to disk. =cut sub save_opml { my $self = shift; $self->opml_generator->save($self->opml); } around 'fetch_feeds' => sub { my $orig = shift; my ($self, @feeds) = @_; @feeds = $self->$orig(@feeds); $self->update_opml(@feeds) if $self->has_opml; return @feeds; }; =head1 AUTHOR Dave Cross, =head1 COPYRIGHT AND LICENSE Copyright (c) 2010 by Magnum Solutions Ltd. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available. =cut 1;