File Coverage

blib/lib/Perlanet/Trait/OPML.pm
Criterion Covered Total %
statement 18 37 48.6
branch 0 4 0.0
condition n/a
subroutine 6 9 66.7
pod 2 2 100.0
total 26 52 50.0


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