File Coverage

blib/lib/POE/Component/RSSAggregator.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package POE::Component::RSSAggregator;
2 1     1   66043 use warnings;
  1         2  
  1         42  
3 1     1   6 use strict;
  1         2  
  1         37  
4 1     1   2632 use POE;
  1         69020  
  1         8  
5 1     1   118575 use POE::Component::Client::HTTP;
  1         276753  
  1         34  
6 1     1   1643 use HTTP::Request;
  1         1099  
  1         28  
7 1     1   465 use XML::RSS::Feed;
  0            
  0            
8             use Carp qw(croak);
9              
10             use constant DEFAULT_TIMEOUT => 60;
11             use constant REDIRECT_DEPTH => 2;
12              
13             our $VERSION = 1.11;
14              
15             sub new {
16             my $class = shift;
17             croak __PACKAGE__ . '->new() params must be a hash' if @_ % 2;
18             my %params = @_;
19              
20             croak __PACKAGE__
21             . '->new() feeds param has been deprecated, use add_feed'
22             if $params{feeds};
23              
24             my $self = bless \%params, $class;
25             $self->_init();
26              
27             return $self;
28             }
29              
30             sub _start {
31             my ( $self, $kernel ) = @_[ OBJECT, KERNEL ];
32             $self->{alias} = 'rssagg' unless $self->{alias};
33             $kernel->alias_set( $self->{alias} );
34             return;
35             }
36              
37             sub _stop {}
38              
39             sub _init {
40             my ($self) = @_;
41              
42             unless ( $self->{http_alias} ) {
43             $self->{http_alias} = 'ua';
44             $self->{follow_redirects} ||= REDIRECT_DEPTH;
45             POE::Component::Client::HTTP->spawn(
46             Alias => $self->{http_alias},
47             Timeout => DEFAULT_TIMEOUT,
48             FollowRedirects => $self->{follow_redirects},
49             Agent => 'Mozilla/5.0 (X11; U; Linux i686; en-US; '
50             . 'rv:1.1) Gecko/20020913 Debian/1.1-1',
51             );
52             }
53              
54             POE::Session->create(
55             object_states => [
56             $self => [ qw(
57             _start
58             add_feed remove_feed pause_feed resume_feed
59             _fetch _response
60             shutdown
61             _stop
62             ) ],
63             ],
64             );
65              
66             return;
67             }
68              
69             sub _create_feed_object {
70             my ( $self, $feed_hash ) = @_;
71              
72             warn "[$feed_hash->{name}] Creating XML::RSS::Feed object\n"
73             if $self->{debug};
74              
75             $feed_hash->{tmpdir} = $self->{tmpdir}
76             if exists $self->{tmpdir} && -d $self->{tmpdir};
77              
78             $feed_hash->{debug} = $self->{debug}
79             if $self->{debug};
80              
81             if ( my $rssfeed = XML::RSS::Feed->new(%$feed_hash) ) {
82             $self->{feed_objs}{ $rssfeed->name } = $rssfeed;
83             }
84             else {
85             warn "[$feed_hash->{name}] !! Error attempting to "
86             . "create XML::RSS::Feed object\n";
87             }
88              
89             return;
90             }
91              
92             sub feed_list {
93             my ($self) = @_;
94             my @feeds = map { $self->{feed_objs}{$_} } keys %{ $self->{feed_objs} };
95             return wantarray ? @feeds : \@feeds;
96             }
97              
98             sub feeds {
99             my ($self) = @_;
100             return $self->{feed_objs};
101             }
102              
103             sub feed {
104             my ( $self, $name ) = @_;
105             return exists $self->{feed_objs}{$name}
106             ? $self->{feed_objs}{$name}
107             : undef;
108             }
109              
110             sub add_feed {
111             my ( $self, $kernel, $feed_hash ) = @_[ OBJECT, KERNEL, ARG0 ];
112             if ( exists $self->{feed_objs}{ $feed_hash->{name} } ) {
113             warn "[$feed_hash->{name}] !! Add Failed: Feed name already exists\n";
114             return;
115             }
116             warn "[$feed_hash->{name}] Added\n" if $self->{debug};
117             $self->_create_feed_object($feed_hash);
118              
119             # Test to remove it after 10 seconds
120             $kernel->yield( '_fetch', $feed_hash->{name} );
121             return;
122             }
123              
124             sub remove_feed {
125             my ( $self, $kernel, $name ) = @_[ OBJECT, KERNEL, ARG0 ];
126             unless ( exists $self->{feed_objs}{$name} ) {
127             warn "[$name] remove_feed: Remove Failed: Unknown feed\n";
128             return;
129             }
130             $kernel->call( $self->{alias}, 'pause_feed', $name );
131             delete $self->{feed_objs}{$name};
132             warn "[$name] remove_feed: Removed RSS Feed\n" if $self->{debug};
133             return;
134             }
135              
136             sub pause_feed {
137             my ( $self, $kernel, $name ) = @_[ OBJECT, KERNEL, ARG0 ];
138             unless ( exists $self->{feed_objs}{$name} ) {
139             warn "[$name] pause_feed: Pause Failed: Unknown feed\n";
140             return;
141             }
142             unless ( exists $self->{alarm_ids}{$name} ) {
143             warn "[$name] pause_feed: Pause Failed: Feed currently on pause\n";
144             return;
145             }
146             if ( $kernel->alarm_remove( $self->{alarm_ids}{$name} ) ) {
147             delete $self->{alarm_ids}{$name};
148             warn "[$name] pause_feed: Paused RSS Feed\n" if $self->{debug};
149             }
150             else {
151             warn "[$name] pause_feed: Failed to Pause RSS Feed\n"
152             if $self->{debug};
153             }
154             return;
155             }
156              
157             sub resume_feed {
158             my ( $self, $kernel, $name ) = @_[ OBJECT, KERNEL, ARG0 ];
159             unless ( exists $self->{feed_objs}{$name} ) {
160             warn "[$name] resume_feed: Resume Failed: Unknown feed\n";
161             return;
162             }
163             if ( exists $self->{alarm_ids}{$name} ) {
164             warn "[$name] resume_feed: Resume Failed: Feed currently active\n";
165             return;
166             }
167             warn "[$name] resume_feed: Resumed RSS Feed\n" if $self->{debug};
168             $kernel->yield( '_fetch', $name );
169             return;
170             }
171              
172             sub shutdown {
173             my ( $self, $kernel, $session ) = @_[ OBJECT, KERNEL, SESSION ];
174             for my $feed ( $self->feed_list ) {
175             $kernel->call( $session, 'remove_feed', $feed->name );
176             }
177             delete $self->{callback};
178             $kernel->alias_remove( $self->{alias} );
179             warn "shutdown: shutting down rssaggregator\n" if $self->{debug};
180             return;
181             }
182              
183             sub _fetch {
184             my ( $self, $kernel, $feed_name ) = @_[ OBJECT, KERNEL, ARG0 ];
185             unless ( exists $self->{feed_objs}{$feed_name} ) {
186             warn "[$feed_name] Unknown Feed\n";
187             return;
188             }
189              
190             my $rssfeed = $self->{feed_objs}{$feed_name};
191             my $req = HTTP::Request->new( GET => $rssfeed->url );
192             warn '[' . $rssfeed->name . '] Attempting to fetch' . "\n" if $self->{debug};
193             $kernel->post( $self->{http_alias}, 'request', '_response', $req,
194             $rssfeed->name );
195             $self->{alarm_ids}{ $rssfeed->name }
196             = $kernel->delay_set( '_fetch', $rssfeed->delay, $rssfeed->name );
197             return;
198             }
199              
200             sub _response {
201             my ( $self, $kernel, $request_packet, $response_packet )
202             = @_[ OBJECT, KERNEL, ARG0, ARG1 ];
203              
204             my ( $req, $feed_name ) = @$request_packet;
205              
206             unless ( exists $self->{feed_objs}{$feed_name} ) {
207             warn "[$feed_name] Unknown Feed\n";
208             return;
209             }
210              
211             my $rssfeed = $self->{feed_objs}{$feed_name};
212             my $res = $response_packet->[0];
213             if ( $res->is_success ) {
214             warn '[' . $rssfeed->name . '] Fetched ' . $rssfeed->url . "\n"
215             if $self->{debug};
216             $self->{callback}->($rssfeed) if $rssfeed->parse( $res->content );
217             }
218             else {
219             warn '[!!] Failed to fetch ' . $req->uri . "\n";
220             }
221             return;
222             }
223              
224             1;
225              
226             __END__