File Coverage

blib/lib/Perlanet/Trait/OPML.pm
Criterion Covered Total %
statement 20 39 51.2
branch 0 4 0.0
condition n/a
subroutine 7 10 70.0
pod 2 2 100.0
total 29 55 52.7


line stmt bran cond sub pod time code
1             package Perlanet::Trait::OPML;
2              
3 6     6   2237 use strict;
  6         8  
  6         144  
4 6     6   19 use warnings;
  6         6  
  6         115  
5              
6 6     6   45 use 5.6.0;
  6         17  
7             our $VERSION = '0.58';
8              
9 6     6   90 use Moose::Role;
  6         7  
  6         29  
10 6     6   18389 use namespace::autoclean;
  6         8  
  6         32  
11              
12 6     6   301 use Carp qw( carp );
  6         6  
  6         342  
13 6     6   23 use POSIX qw(setlocale LC_ALL);
  6         4  
  6         46  
14              
15             =head1 NAME
16              
17             Perlanet::Trait::OPML - generate an OPML file
18              
19             =head1 SYNOPSIS
20              
21             my $perlanet = Perlanet->new_with_traits(
22             traits => [ 'Perlanet::Trait::OPML' ]
23             );
24              
25             $perlanet->run;
26              
27             =head1 DESCRIPTION
28              
29             Generates an OPML file of all feeds that are being aggregated by the planet.
30              
31             =head1 ATTRIBUTES
32              
33             =head2 opml_generator
34              
35             An L<XML::OPML::SimpleGen> object to generate the XML for the OPML file
36              
37             =cut
38              
39             has 'opml_generator' => (
40             is => 'rw',
41             isa => 'Maybe[XML::OPML::SimpleGen]',
42             lazy_build => 1,
43             predicate => 'has_opml'
44             );
45              
46             sub _build_opml_generator {
47 0     0     my $self = shift;
48              
49 0           eval { require XML::OPML::SimpleGen; };
  0            
50              
51 0 0         if ($@) {
52 0           carp 'You need to install XML::OPML::SimpleGen to enable OPML ' .
53             'support';
54 0           $self->opml(undef);
55 0           return;
56             }
57              
58 0           my $loc = setlocale(LC_ALL, 'C');
59 0           my $opml = XML::OPML::SimpleGen->new;
60 0           setlocale(LC_ALL, $loc);
61 0           $opml->head(
62             title => $self->title,
63             );
64              
65 0           return $opml;
66             }
67              
68              
69             =head2 opml_file
70              
71             Where to save the OPML feed when it has been created
72              
73             =cut
74              
75             has 'opml' => (
76             isa => 'Maybe[Str]',
77             is => 'rw',
78             );
79              
80             =head1 METHODS
81              
82             =head2 update_opml
83              
84             Updates the OPML file of all contributers to this planet. If the L<opml>
85             attribute does not have a value, this method does nothing, otherwise it inserts
86             each author into the OPML file and saves it to disk.
87              
88             =cut
89              
90             sub update_opml {
91 0     0 1   my ($self, @feeds) = @_;
92              
93 0 0         return unless $self->has_opml;
94              
95 0           foreach my $f (@feeds) {
96 0           $self->opml_generator->insert_outline(
97             title => $f->title,
98             text => $f->title,
99             xmlUrl => $f->url,
100             htmlUrl => $f->url,
101             );
102             }
103              
104 0           $self->save_opml;
105             }
106              
107             =head2 save_opml
108              
109             Save the OPML file, by default to disk.
110              
111             =cut
112              
113             sub save_opml {
114 0     0 1   my $self = shift;
115 0           $self->opml_generator->save($self->opml);
116             }
117              
118             around 'fetch_feeds' => sub {
119             my $orig = shift;
120             my ($self, @feeds) = @_;
121             @feeds = $self->$orig(@feeds);
122             $self->update_opml(@feeds) if $self->has_opml;
123             return @feeds;
124             };
125              
126             =head1 AUTHOR
127              
128             Dave Cross, <dave@mag-sol.com>
129              
130             =head1 COPYRIGHT AND LICENSE
131              
132             Copyright (c) 2010 by Magnum Solutions Ltd.
133              
134             This library is free software; you can redistribute it and/or modify
135             it under the same terms as Perl itself, either Perl version 5.10.0 or,
136             at your option, any later version of Perl 5 you may have available.
137              
138             =cut
139              
140             1;