File Coverage

blib/lib/Labyrinth/RSS.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Labyrinth::RSS;
2              
3 2     2   4791 use warnings;
  2         10  
  2         77  
4 2     2   7 use strict;
  2         2  
  2         49  
5              
6 2     2   6 use vars qw($VERSION);
  2         2  
  2         92  
7             $VERSION = '5.30';
8              
9             =head1 NAME
10              
11             Labyrinth::RSS - RSS Handler for Labyrinth
12              
13             =head1 DESCRIPTION
14              
15             Contains all the RSS/Atom feeds used by Labyrinth
16              
17             =cut
18              
19             # -------------------------------------
20             # Library Modules
21              
22 2     2   350 use XML::RSS;
  0            
  0            
23             use XML::Atom;
24             use XML::Atom::Feed;
25             use XML::Atom::Entry;
26              
27             use Labyrinth::DTUtils;
28             use Labyrinth::Variables;
29             use Labyrinth::Writer;
30              
31             # -------------------------------------
32             # Variables
33              
34             my $RSSFEED = 10;
35             my $GENERATOR = 'Labyrinth v' . $VERSION;
36              
37             # -------------------------------------
38             # The Subs
39              
40             =head1 PUBLIC INTERFACE METHODS
41              
42             =head2 Constructor
43              
44             =over
45              
46             =item new
47              
48             =back
49              
50             =cut
51              
52             sub new {
53             my $class = shift;
54             my %hash = @_;
55              
56             # verify we have the necessary settings
57             for(qw(rssmail rssname)) {
58             die "Missing configuration setting: '$_'\n" unless($settings{$_});
59             }
60              
61             my $rssuser = "$settings{rssmail} ($settings{rssname})";
62             $settings{rsseditor} ||= $rssuser;
63             $settings{rssmaster} ||= $rssuser;
64              
65             my $atts = {
66             type => ($hash{type} || 'rss'),
67             version => ($hash{version} || '2.0'),
68             perma => ($hash{perma} || $settings{perma}),
69             id => ($hash{id} || 'articleid'),
70             block => ($hash{block} || 'articles/arts-block.html'),
71             };
72              
73             bless $atts, $class;
74             return $atts;
75             }
76              
77             =head2 Public Methods
78              
79             =over
80              
81             =item feed
82              
83             For the given list of entries, reformats into the requested feed type.
84              
85             =back
86              
87             =cut
88              
89             sub feed {
90             my $self = shift;
91              
92             return unless(@_);
93              
94             return $self->RSS_0_9(@_) if($self->{type} eq 'rss' && $self->{version} eq '0.9');
95             return $self->RSS_1_0(@_) if($self->{type} eq 'rss' && $self->{version} eq '1.0');
96             return $self->RSS_2_0(@_) if($self->{type} eq 'rss' && $self->{version} eq '2.0');
97             return $self->Atom_0_3(@_) if($self->{type} eq 'atom' && $self->{version} eq '0.3');
98             return $self->Atom_1_0(@_) if($self->{type} eq 'atom' && $self->{version} eq '1.0');
99              
100             $tvars{errcode} = 'ERROR';
101             }
102              
103             =head2 Private Methods
104              
105             =over
106              
107             =item RSS_0_9
108              
109             Reformats article list into RSS 0.9.
110              
111             =item RSS_1_0
112              
113             Reformats article list into RSS 1.0.
114              
115             =item RSS_2_0
116              
117             Reformats article list into RSS 2.0.
118              
119             =item Atom_0_3
120              
121             Reformats article list into Atom 0.3.
122              
123             =item Atom_1_0
124              
125             Reformats article list into Atom 1.0.
126              
127             =item CleanEntities
128              
129             For a given string, reformats basic entities to avoid potential XML
130             irregularities.
131              
132             =back
133              
134             =cut
135              
136             sub RSS_0_9 {
137             my $self = shift;
138              
139             # verify we have the necessary settings
140             for(qw(rsstitle rsslink rssdesc)) {
141             die "Missing configuration setting: '$_'\n" unless($settings{$_});
142             }
143              
144             my $rss = XML::RSS->new(version => '0.9');
145             $rss->channel(
146             title => $settings{rsstitle},
147             link => $settings{rsslink},
148             description => $settings{rssdesc},
149             );
150              
151             for my $item (@_) {
152             my $id = $item->{data}{$self->{id}};
153             my $perma = $item->{data}{permapath} || $self->{perma} . $id;
154              
155             $rss->add_item(
156             title => CleanEntities($item->{data}{title}),
157             link => $settings{rsslink} . $perma
158             );
159             }
160              
161             $tvars{rss} = $rss->as_string;
162             }
163              
164             sub RSS_1_0 {
165             my $self = shift;
166              
167             # verify we have the necessary settings
168             for(qw(rsstitle rsslink rssdesc rsssubject rsscreator rsspublisher copyright)) {
169             die "Missing configuration setting: '$_'\n" unless($settings{$_});
170             }
171              
172             my $rss = XML::RSS->new(version => '1.0');
173             $rss->channel(
174             title => $settings{rsstitle},
175             link => $settings{rsslink},
176             description => $settings{rssdesc},
177              
178             dc => {
179             date => formatDate(16),
180             subject => $settings{rsssubject},
181             creator => $settings{rsscreator},
182             publisher => $settings{rsspublisher},
183             rights => $settings{copyright},
184             language => 'en-gb',
185             },
186             syn => {
187             updatePeriod => "daily",
188             updateFrequency => "1",
189             updateBase => "2000-01-01T00:00:00+00:00",
190             },
191             );
192              
193             for my $item (@_) {
194             my $id = $item->{data}{$self->{id}};
195             my $perma = $item->{data}{permapath} || $self->{perma} . $id;
196              
197             my $block = '';
198             my $body = $item->{data}{body} || $item->{body};
199             if($self->{id} eq 'articleid') {
200             my %vars = ( 'block' => $body );
201             $block = Transform($self->{block},\%vars);
202             } else {
203             $block = $body;
204             }
205              
206             $rss->add_item(
207             # date => formatDate(16,$item->{data}{createdate}),
208             title => CleanEntities($item->{data}{title}),
209             description => CleanEntities($block),
210             link => $settings{rsslink} . $perma
211             );
212             }
213              
214             $tvars{rss} = $rss->as_string;
215             }
216              
217             sub RSS_2_0 {
218             my $self = shift;
219              
220             # verify we have the necessary settings
221             for(qw(rsstitle rsslink rssdesc copyright rsseditor rssmaster)) {
222             die "Missing configuration setting: '$_'\n" unless($settings{$_});
223             }
224              
225             my $rss = XML::RSS->new(version => '2.0');
226             $rss->channel(
227             title => $settings{rsstitle},
228             link => $settings{rsslink},
229             description => $settings{rssdesc},
230             language => 'en',
231             copyrights => $settings{copyright},
232             pubDate => formatDate(16),
233             managingEditor => $settings{rsseditor},
234             webMaster => $settings{rssmaster},
235             generator => $GENERATOR,
236             );
237              
238             for my $item (@_) {
239             my $id = $item->{data}{$self->{id}};
240             my $perma = $item->{data}{permapath} || $self->{perma} . $id;
241              
242             my $block = '';
243             my $body = $item->{data}{body} || $item->{body};
244             if($self->{id} eq 'articleid') {
245             my %vars = ( 'block' => $body );
246             $block = Transform($self->{block},\%vars);
247             } else {
248             $block = $body;
249             }
250              
251             $rss->add_item(
252             pubDate => formatDate(16,$item->{data}{createdate}),
253             title => CleanEntities($item->{data}{title}),
254             description => CleanEntities($block),
255             link => $settings{rsslink} . $perma,
256             guid => $settings{rsslink} . $perma,
257             comments => $settings{rsslink} . $perma . '#comments'
258             );
259             }
260              
261             $tvars{rss} = $rss->as_string;
262             }
263              
264             sub Atom_0_3 {
265             my $self = shift;
266              
267             # verify we have the necessary settings
268             for(qw(rsstitle rsslink)) {
269             die "Missing configuration setting: '$_'\n" unless($settings{$_});
270             }
271              
272             my ($tag) = $settings{rsslink} =~ m!http://([^/]+)/!;
273              
274             my $feed = XML::Atom::Feed->new;
275             $feed->title($settings{rsstitle});
276             $feed->id("tag:$tag,".formatDate(1).':atom03');
277              
278             for my $item (@_) {
279             my $id = $item->{data}{$self->{id}};
280             my $perma = $item->{data}{permapath} || $self->{perma} . $id;
281              
282             my $block = '';
283             my $body = $item->{data}{body} || $item->{body};
284             if($self->{id} eq 'articleid') {
285             my %vars = ( 'block' => $body );
286             $block = Transform($self->{block},\%vars);
287             } else {
288             $block = $body;
289             }
290              
291             my $entry = XML::Atom::Entry->new;
292             $entry->title(CleanEntities($item->{data}{title}));
293             $entry->id("tag:$tag,".formatDate(1) . ':' . $id);
294             $entry->link($settings{rsslink} . $perma);
295             $entry->content(CleanEntities($block));
296             $feed->add_entry($entry);
297             }
298              
299             $tvars{rss} = $feed->as_xml;
300             }
301              
302             sub Atom_1_0 {
303             my $self = shift;
304              
305             # verify we have the necessary settings
306             for(qw(rsstitle rsslink rssname rssmail)) {
307             die "Missing configuration setting: '$_'\n" unless($settings{$_});
308             }
309              
310             $XML::Atom::DefaultVersion = "1.0";
311             my ($tag) = $settings{rsslink} =~ m!http://([^/]+)/?!;
312              
313             my $feed = XML::Atom::Feed->new;
314             $feed->title($settings{rsstitle});
315             $feed->id("tag:$tag,".formatDate(1).':atom10');
316             $feed->updated(formatDate(12,$_[0]->{data}{creatdate}));
317              
318             my $author = XML::Atom::Person->new;
319             $author->name($settings{rssname});
320             $author->email($settings{rssmail});
321              
322             for my $item (@_) {
323             my $id = $item->{data}{$self->{id}};
324             my $perma = $item->{data}{permapath} || $self->{perma} . $id;
325              
326             my $block = '';
327             my $body = $item->{data}{body} || $item->{body};
328             if($self->{id} eq 'articleid') {
329             my %vars = ( 'block' => $body );
330             $block = Transform($self->{block},\%vars);
331             } else {
332             $block = $body;
333             }
334              
335             my $entry = XML::Atom::Entry->new;
336             $entry->title(CleanEntities($item->{data}{title}));
337             $entry->id("tag:$tag,".formatDate(1) . ':' . $id);
338             $entry->content(CleanEntities($block));
339             $entry->author($author);
340             $entry->updated(formatDate(12,$item->{data}{createdate}));
341              
342             my $link = XML::Atom::Link->new;
343             $link->type('text/html');
344             $link->rel('alternate');
345             $link->href($settings{rsslink} . $perma);
346             $entry->add_link($link);
347              
348             $feed->add_entry($entry);
349             }
350              
351             $tvars{rss} = $feed->as_xml;
352              
353             }
354              
355             sub CleanEntities {
356             my $text = shift;
357             return '' unless($text);
358              
359             $text =~ s/–/-/gs; # ndash causes XML problems!
360             $text =~ s/&/&/gs;
361             $text =~ s/'/'/gs;
362             $text =~ s!(src|href)=(["'])/!$1=$2$settings{rssweb}/!igs;
363             return $text;
364             }
365              
366             1;
367              
368             __END__