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.6
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   3437 use strict;
  6         15  
  6         199  
4 6     6   37 use warnings;
  6         16  
  6         180  
5              
6 6     6   32 use Moose::Role;
  6         13  
  6         65  
7 6     6   35121 use namespace::autoclean;
  6         18  
  6         58  
8              
9 6     6   483 use Carp qw( carp );
  6         61  
  6         402  
10 6     6   37 use POSIX qw(setlocale LC_ALL);
  6         14  
  6         59  
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;