line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/env perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Vitacilina - ¡Ah, qué buena medicina! |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 DESCRIPTION |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
A simple feeds engine exporter that uses YAML to get list of feeds and |
10
|
|
|
|
|
|
|
TT as templating system. Some people would call it an aggregator. It was |
11
|
|
|
|
|
|
|
intended to be a reliable Planet (L) |
12
|
|
|
|
|
|
|
alternative, then some development ideas evolved into rFeed (http://github.com/damog/rfeed). |
13
|
|
|
|
|
|
|
Vitacilina runs on production services on a couple of systems. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use Vitacilina; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $v = Vitacilina->new( |
20
|
|
|
|
|
|
|
config => 'config.yaml', |
21
|
|
|
|
|
|
|
template => 'template.tt', |
22
|
|
|
|
|
|
|
output => 'output.html', |
23
|
|
|
|
|
|
|
limit => '20', |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
$v->render; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 FILES |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head2 config |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
The C parameter specifies the path to a YAML file specifying a list |
33
|
|
|
|
|
|
|
of feeds. Use this format: |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
http://myserver.com/myfeed: |
36
|
|
|
|
|
|
|
name: Some Cool Feed |
37
|
|
|
|
|
|
|
http://feeds.feedburner.com/InfinitePigTheorem: |
38
|
|
|
|
|
|
|
name: InfinitePigTheorem |
39
|
|
|
|
|
|
|
... |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head2 template |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
A C file which will be taken as the template for |
44
|
|
|
|
|
|
|
output. Format: |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
[% FOREACH p IN data %] |
47
|
|
|
|
|
|
|
[% p.title %] |
48
|
|
|
|
|
|
|
by [% p.author %] |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
[% END %] |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
The C is an ordered array with a bunch of hashes with the |
53
|
|
|
|
|
|
|
simple data such as C, C, C, C, |
54
|
|
|
|
|
|
|
etc. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head2 output |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
File path where the output will be written. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head1 EXAMPLES |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Take a look at the C directory for fully working example. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head1 SEE ALSO |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Git repository is located at L. |
67
|
|
|
|
|
|
|
Also take a look at the Stereonaut! blog where similar |
68
|
|
|
|
|
|
|
developments from the author are announced and sampled, |
69
|
|
|
|
|
|
|
L. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head1 AUTHOR |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
David Moreno, david@axiombox.com. Alexandr Ciornii contributed with |
74
|
|
|
|
|
|
|
patches. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 COPYRIGHT |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Copyright (C) 2009 by David Moreno. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
81
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
package Vitacilina; |
86
|
|
|
|
|
|
|
|
87
|
1
|
|
|
1
|
|
26952
|
use 5.006; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
88
|
|
|
|
|
|
|
|
89
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
90
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
39
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
1
|
|
|
1
|
|
876
|
use URI; |
|
1
|
|
|
|
|
7183
|
|
|
1
|
|
|
|
|
25
|
|
94
|
1
|
|
|
1
|
|
1963
|
use Template; |
|
1
|
|
|
|
|
26460
|
|
|
1
|
|
|
|
|
42
|
|
95
|
1
|
|
|
1
|
|
687
|
use XML::Feed; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
use YAML::Syck; |
97
|
|
|
|
|
|
|
use Data::Dumper; |
98
|
|
|
|
|
|
|
use LWP::UserAgent; |
99
|
|
|
|
|
|
|
use DateTime; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
use Carp; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
use Vitacilina::Config qw/$FORMAT $OUTPUT $TITLE $LIMIT/; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# Constant: VERSION |
106
|
|
|
|
|
|
|
# |
107
|
|
|
|
|
|
|
# Vitacilina version |
108
|
|
|
|
|
|
|
our $VERSION = '0.2'; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
my $params = { |
111
|
|
|
|
|
|
|
required => [qw{config template}], |
112
|
|
|
|
|
|
|
optional => [qw/title format/], |
113
|
|
|
|
|
|
|
}; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# Function: new |
116
|
|
|
|
|
|
|
# |
117
|
|
|
|
|
|
|
# Vitacilina constructor |
118
|
|
|
|
|
|
|
# |
119
|
|
|
|
|
|
|
# Parameters: |
120
|
|
|
|
|
|
|
# |
121
|
|
|
|
|
|
|
# config => [ path_to_file ] - YAML configuration file path for the feeds |
122
|
|
|
|
|
|
|
# template => [ path_to_file ] - TT file path |
123
|
|
|
|
|
|
|
# output => [ path_to_file ] - HTML file path where the output will be written |
124
|
|
|
|
|
|
|
# limit => [ n ] - Number of items to display |
125
|
|
|
|
|
|
|
# tt_absolute => [0|1] - TT absolute paths |
126
|
|
|
|
|
|
|
# tt_relative => [0|1] - TT relative paths, overrides |
127
|
|
|
|
|
|
|
sub new { |
128
|
|
|
|
|
|
|
my($self, %opts) = @_; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
my $o = \%opts; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
my $filter = { |
133
|
|
|
|
|
|
|
title => $opts{filter}->{title} || '', |
134
|
|
|
|
|
|
|
content => $opts{filter}->{content} || '', |
135
|
|
|
|
|
|
|
}; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new( |
138
|
|
|
|
|
|
|
agent => qq{Vitacilina $VERSION}, |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# welcome to retarded; please someone fix this |
142
|
|
|
|
|
|
|
my($rel, $abs); |
143
|
|
|
|
|
|
|
$opts{tt_absolute} ? $rel = 0 : $rel = 1; |
144
|
|
|
|
|
|
|
$opts{tt_relative} ? $abs = 0 : $abs = 1; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
return bless { |
147
|
|
|
|
|
|
|
ua => $ua, |
148
|
|
|
|
|
|
|
format => $opts{format} || $FORMAT, |
149
|
|
|
|
|
|
|
output => $opts{output} || $OUTPUT, |
150
|
|
|
|
|
|
|
config => $opts{config} || '', |
151
|
|
|
|
|
|
|
limit => $opts{limit} || $LIMIT, |
152
|
|
|
|
|
|
|
filter => { |
153
|
|
|
|
|
|
|
title => qr/$filter->{title}/i, |
154
|
|
|
|
|
|
|
content => qr/$filter->{content}/i, |
155
|
|
|
|
|
|
|
}, |
156
|
|
|
|
|
|
|
title => $opts{title} || $TITLE, |
157
|
|
|
|
|
|
|
template => $opts{template} || '', |
158
|
|
|
|
|
|
|
tt_relative => $rel, |
159
|
|
|
|
|
|
|
tt_absolute => $abs, |
160
|
|
|
|
|
|
|
}, $self; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# Function: render |
164
|
|
|
|
|
|
|
# |
165
|
|
|
|
|
|
|
# Vitacilina launcher |
166
|
|
|
|
|
|
|
sub render { |
167
|
|
|
|
|
|
|
my($self) = shift; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
my $tt = Template->new( |
170
|
|
|
|
|
|
|
RELATIVE => $self->tt_relative, |
171
|
|
|
|
|
|
|
ABSOLUTE => $self->tt_absolute, |
172
|
|
|
|
|
|
|
); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Carp::croak("No YAML config file was defined!") |
175
|
|
|
|
|
|
|
unless $self->{config}; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
Carp::croak("No TT file was defined!") |
178
|
|
|
|
|
|
|
unless $self->{template}; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
$self->{feedsData} = $self->_feedsData; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
$tt->process( |
183
|
|
|
|
|
|
|
$self->template, |
184
|
|
|
|
|
|
|
{ |
185
|
|
|
|
|
|
|
feeds => $self->_feeds, |
186
|
|
|
|
|
|
|
data => $self->_data, |
187
|
|
|
|
|
|
|
title => $self->title, |
188
|
|
|
|
|
|
|
}, |
189
|
|
|
|
|
|
|
$self->output, |
190
|
|
|
|
|
|
|
binmode => ':utf8', |
191
|
|
|
|
|
|
|
) or die $tt->error; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# Class variables accesors |
196
|
|
|
|
|
|
|
sub config { |
197
|
|
|
|
|
|
|
my($self, $config) = @_; |
198
|
|
|
|
|
|
|
$self->{config} = $config if $config; |
199
|
|
|
|
|
|
|
$self->{config}; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub tt_relative { |
203
|
|
|
|
|
|
|
my($self, $tt) = @_; |
204
|
|
|
|
|
|
|
$self->{tt_relative} = $tt if $tt; |
205
|
|
|
|
|
|
|
$self->{tt_relative}; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub tt_absolute { |
209
|
|
|
|
|
|
|
my($self, $tt) = @_; |
210
|
|
|
|
|
|
|
$self->{tt_absolute} = $tt if $tt; |
211
|
|
|
|
|
|
|
$self->{tt_absolute}; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
sub title { |
215
|
|
|
|
|
|
|
my($self, $title) = @_; |
216
|
|
|
|
|
|
|
$self->{title} = $title if $title; |
217
|
|
|
|
|
|
|
$self->{title}; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub template { |
221
|
|
|
|
|
|
|
my($self, $t) = @_; |
222
|
|
|
|
|
|
|
$self->{template} = $t if $t; |
223
|
|
|
|
|
|
|
$self->{template}; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub limit { |
227
|
|
|
|
|
|
|
my($self, $l) = @_; |
228
|
|
|
|
|
|
|
$self->{limit} = $l if $l; |
229
|
|
|
|
|
|
|
$self->{limit}; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub format { |
233
|
|
|
|
|
|
|
my($self, $f) = @_; |
234
|
|
|
|
|
|
|
$self->{format} = $f if $f; |
235
|
|
|
|
|
|
|
$self->{format}; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub output { |
239
|
|
|
|
|
|
|
my($self, $o) = shift; |
240
|
|
|
|
|
|
|
$self->{output} = $o if $o; |
241
|
|
|
|
|
|
|
$self->{output}; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# Internal method to get the feed information |
245
|
|
|
|
|
|
|
sub _feeds { |
246
|
|
|
|
|
|
|
my($self) = shift; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my @feeds; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
foreach my $f(@{$self->{feedsData}}) { |
251
|
|
|
|
|
|
|
push @feeds, { |
252
|
|
|
|
|
|
|
blogUrl => $f->{feed}->link, |
253
|
|
|
|
|
|
|
feedUrl => $f->{url}, |
254
|
|
|
|
|
|
|
author => $f->{info}->{name}, |
255
|
|
|
|
|
|
|
}; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
@feeds = sort { $a->{author} cmp $b->{author} } @feeds; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
return \@feeds; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# Internal method to get all posts and entries by the feeds |
265
|
|
|
|
|
|
|
sub _feedsData { |
266
|
|
|
|
|
|
|
my($self) = shift; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
my $c = LoadFile($self->{config}); |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
my @feeds; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
while(my($k, $v) = each %{$c}) { |
273
|
|
|
|
|
|
|
next if $k eq 'Planet' or $k eq 'DEFAULT'; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
my $res = $self->{ua}->get($k); |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
unless($res->is_success) { |
278
|
|
|
|
|
|
|
print STDERR qq{ERROR: $k: $res->status_line\n}; |
279
|
|
|
|
|
|
|
next; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $feed = XML::Feed->parse(\$res->decoded_content); |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
unless($feed) { |
285
|
|
|
|
|
|
|
print STDERR |
286
|
|
|
|
|
|
|
'ERROR: ', |
287
|
|
|
|
|
|
|
XML::Feed->errstr, |
288
|
|
|
|
|
|
|
': ', |
289
|
|
|
|
|
|
|
$k, "\n"; |
290
|
|
|
|
|
|
|
next; |
291
|
|
|
|
|
|
|
}; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
push @feeds, { feed => $feed, info => $v, url => $k }; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
return \@feeds; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Internal method to get posts. |
299
|
|
|
|
|
|
|
sub _data { |
300
|
|
|
|
|
|
|
my($self) = shift; |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
foreach (@{$params->{required}}) { |
303
|
|
|
|
|
|
|
croak "No $_ was defined" unless $self->{$_}; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
my $c = LoadFile($self->{config}); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my @entries; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
FeedsData: foreach my $f(@{$self->{feedsData}}) { |
311
|
|
|
|
|
|
|
for($f->{feed}->entries) { |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
my $content = $_->content->body || q{}; |
314
|
|
|
|
|
|
|
my $title = $_->title || q{}; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
if($content =~ $self->{filter}->{content} and $title =~ $self->{filter}->{title}) { |
317
|
|
|
|
|
|
|
push @entries, { |
318
|
|
|
|
|
|
|
author => $f->{info}->{name} || '', |
319
|
|
|
|
|
|
|
face => $f->{info}->{face} || '', |
320
|
|
|
|
|
|
|
content => $content, |
321
|
|
|
|
|
|
|
title => $title, |
322
|
|
|
|
|
|
|
date => $_->issued || '', |
323
|
|
|
|
|
|
|
permalink => $_->link || '', |
324
|
|
|
|
|
|
|
channelUrl => $f->{feed}->link || '', |
325
|
|
|
|
|
|
|
date_modified => $_->modified || '', |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my $zero = DateTime->from_epoch(epoch => 0); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
@entries = sort { |
334
|
|
|
|
|
|
|
($b->{date} || $b->{date_modified} || $zero) |
335
|
|
|
|
|
|
|
<=> |
336
|
|
|
|
|
|
|
($a->{date} || $b->{date_modified} || $zero) |
337
|
|
|
|
|
|
|
} @entries; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
delete @entries[$self->limit .. $#entries]; |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
return \@entries; |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
1; |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# Eso es to-, eso es to-, eso es todo amigos. |