File Coverage

blib/lib/Labyrinth/Plugin/CPAN/Content.pm
Criterion Covered Total %
statement 21 31 67.7
branch 0 6 0.0
condition 0 6 0.0
subroutine 7 8 87.5
pod 1 1 100.0
total 29 52 55.7


line stmt bran cond sub pod time code
1             package Labyrinth::Plugin::CPAN::Content;
2              
3 3     3   38048 use strict;
  3         8  
  3         81  
4 3     3   17 use warnings;
  3         6  
  3         158  
5              
6             our $VERSION = '3.55';
7              
8             =head1 NAME
9              
10             Labyrinth::Plugin::CPAN::Content - Additional content for CPAN.
11              
12             =head1 DESCRIPTION
13              
14             The functions contain herein are for CPAN and CPAN Testers related page content.
15              
16             =cut
17              
18             #----------------------------------------------------------------------------
19             # Libraries
20              
21 3     3   16 use base qw(Labyrinth::Plugin::Base);
  3         6  
  3         290  
22              
23 3     3   20 use Labyrinth::Support;
  3         4  
  3         659  
24 3     3   19 use Labyrinth::Variables;
  3         4  
  3         636  
25              
26 3     3   16 use JSON;
  3         6  
  3         26  
27 3     3   350 use WWW::Mechanize;
  3         7  
  3         872  
28              
29             #----------------------------------------------------------------------------
30             # Variables
31              
32             # this should be a config option
33             # $settings{iheart_random} = 'http://iheart.cpantesters.org/home/random';
34              
35             #----------------------------------------------------------
36             # Content Management Subroutines
37              
38             =head1 CONTENT MANAGEMENT FUNCTIONS
39              
40             =over 4
41              
42             =item GetSponsor
43              
44             Gets a random sponsor from the I <3 CPAN Testers website.
45              
46             =back
47              
48             =cut
49              
50             sub GetSponsor {
51 0     0 1   my $mech = WWW::Mechanize->new();
52 0           $mech->agent_alias( 'Linux Mozilla' );
53 0           eval { $mech->get( $settings{iheart_random} ) };
  0            
54 0 0 0       return if($@ || !$mech->success() || !$mech->content());
      0        
55              
56 0           my $json = $mech->content();
57 0           my $data = decode_json($json);
58              
59 0 0         return unless($data);
60              
61             $tvars{sponsor} = {
62             title => $data->[0]->{links}[0]{title},
63             image => $data->[0]->{links}[0]{image},
64             body => $data->[0]->{links}[0]{body},
65             href => $data->[0]->{links}[0]{href},
66             url => $data->[0]->{links}[0]{href}
67 0           };
68              
69 0 0         $tvars{sponsor}{url} =~ s!^https?://(?:www\.)?([^/]+).*!$1! if($tvars{sponsor}{url});
70             }
71              
72             1;
73              
74             __END__