File Coverage

blib/lib/POE/Component/MetaCPAN/Recent.pm
Criterion Covered Total %
statement 83 100 83.0
branch 15 32 46.8
condition 2 6 33.3
subroutine 16 18 88.8
pod 3 3 100.0
total 119 159 74.8


line stmt bran cond sub pod time code
1             package POE::Component::MetaCPAN::Recent;
2             $POE::Component::MetaCPAN::Recent::VERSION = '1.02';
3             #ABSTRACT: Obtain uploaded CPAN dists via MetaCPAN.
4              
5 1     1   1096 use strict;
  1         3  
  1         29  
6 1     1   5 use warnings;
  1         2  
  1         22  
7 1     1   6 use Carp;
  1         3  
  1         64  
8 1     1   6 use POE qw[Component::SmokeBox::Recent::HTTP];
  1         2  
  1         8  
9 1     1   134883 use URI;
  1         9  
  1         36  
10 1     1   12 use HTTP::Request;
  1         3  
  1         35  
11 1     1   7 use HTTP::Response;
  1         3  
  1         36  
12 1     1   750 use JSON::PP;
  1         14380  
  1         82  
13 1     1   559 use Time::Piece;
  1         9473  
  1         5  
14              
15             sub spawn {
16 1     1 1 1597 my $package = shift;
17 1         4 my %opts = @_;
18 1         7 $opts{lc $_} = delete $opts{$_} for keys %opts;
19 1 50       5 croak "$package requires an 'event' argument\n" unless $opts{event};
20 1 50       12 $opts{delay} = 180 unless $opts{delay};
21 1         5 my $options = delete $opts{options};
22 1         3 my $self = bless \%opts, $package;
23 1 50       23 $self->{session_id} = POE::Session->create(
24             object_states => [
25             $self => {
26             shutdown => '_shutdown',
27             http_sockerr => '_get_connect_error',
28             http_timeout => '_get_connect_error',
29             http_response => '_handle_recent',
30             },
31             $self => [ qw(_start _get_recent _real_shutdown) ],
32             ],
33             heap => $self,
34             ( ref($options) eq 'HASH' ? ( options => $options ) : () ),
35             )->ID();
36 1         176 return $self;
37             }
38              
39             sub session_id {
40 1     1 1 9609846 return $_[0]->{session_id};
41             }
42              
43             sub shutdown {
44 0     0 1 0 my $self = shift;
45 0         0 $poe_kernel->post( $self->{session_id}, 'shutdown' );
46 0         0 return;
47             }
48              
49             sub _shutdown {
50 1     1   242 my ($kernel,$self) = @_[KERNEL,OBJECT];
51 1         5 $self->{_shutdown} = 1;
52 1 50       7 return if $self->{_http_requests};
53 1         6 $kernel->yield( '_real_shutdown' );
54 1         74 return;
55             }
56              
57             sub _real_shutdown {
58 1     1   150 my ($kernel,$self) = @_[KERNEL,OBJECT];
59 1         7 $kernel->alarm_remove_all();
60 1         129 $kernel->alias_remove( $_ ) for $kernel->alias_list();
61 1         46 $kernel->refcount_decrement( $self->{sender_id}, __PACKAGE__ );
62 1         57 return;
63             }
64              
65             sub _start {
66 1     1   350 my ($kernel,$session,$sender,$self) = @_[KERNEL,SESSION,SENDER,OBJECT];
67 1         7 $self->{session_id} = $session->ID();
68 1 50 33     16 if ( $kernel == $sender and !$self->{session} ) {
69 0         0 croak "Not called from another POE session and 'session' wasn't set\n";
70             }
71 1         3 my $sender_id;
72 1 50       10 if ( $self->{session} ) {
73 0 0       0 if ( my $ref = $kernel->alias_resolve( $self->{session} ) ) {
74 0         0 $sender_id = $ref->ID();
75             }
76             else {
77 0         0 croak "Could not resolve 'session' to a valid POE session\n";
78             }
79             }
80             else {
81 1         4 $sender_id = $sender->ID();
82             }
83 1         14 $kernel->refcount_increment( $sender_id, __PACKAGE__ );
84 1         83 $self->{sender_id} = $sender_id;
85 1         2 $self->{timestamp} = 0;
86             # Start requesting
87 1         12 $kernel->yield('_get_recent');
88 1         163 return;
89             }
90              
91             sub _get_recent {
92 1     1   1716 my ($kernel,$self) = @_[KERNEL,OBJECT];
93 1         4 $kernel->delay('_get_recent');
94 1 50       70 if ( $self->{shutdown} ) {
95 0         0 $kernel->yield('_real_shutdown');
96 0         0 return;
97             }
98             POE::Component::SmokeBox::Recent::HTTP->spawn(
99 1         21 uri => URI->new( 'http://fastapi.metacpan.org/release/recent?type=l&page=1&page_size=100' ),
100             );
101 1         9806 $self->{_http_requests}++;
102 1         4 return;
103             }
104              
105             sub _handle_recent {
106 1     1   181982 my ($kernel,$self,$http_resp) = @_[KERNEL,OBJECT,ARG0];
107 1         4 $self->{_http_requests}--;
108 1 50 33     13 if ( $http_resp and $http_resp->code() == 200 ) {
109 1         31 my $recents = eval { decode_json( $http_resp->content() ) };
  1         5  
110             SWITCH: {
111 1 50       206420 last SWITCH unless $recents;
  1         6  
112 1 50       4 last SWITCH unless $recents->{releases};
113 1 50       5 last SWITCH unless ref $recents->{releases} eq 'ARRAY';
114 1         3 my @uploads;
115 1         3 RELEASES: foreach my $recent ( @{ $recents->{releases} } ) {
  1         6  
116 1         18 my $ts = Time::Piece->strptime($recent->{date},"%Y-%m-%dT%H:%M:%S")->epoch;
117 1 50       209 $self->{timestamp} = $ts unless $self->{timestamp};
118 1 50       14 last RELEASES if $ts <= $self->{timestamp};
119 0         0 $recent->{ts} = $ts;
120 0         0 push @uploads, $recent;
121             }
122 1         93 foreach my $upload ( reverse @uploads ) {
123 0         0 $self->{timestamp} = delete $upload->{ts};
124 0         0 $kernel->post( $self->{sender_id}, $self->{event}, $upload );
125             }
126             }
127             }
128 1 50       7 $kernel->yield('_real_shutdown') if $self->{shutdown};
129 1 50       13 $kernel->delay('_get_recent', $self->{delay}) unless $self->{shutdown};
130 1         182 return;
131             }
132              
133             sub _get_connect_error {
134 0     0     my ($kernel,$self) = @_[KERNEL,OBJECT];
135 0           $self->{_http_requests}--;
136 0           $kernel->delay('_get_recent', $self->{delay});
137 0           return;
138             }
139              
140             "Fooby Dooby Foo Bar";
141              
142             __END__