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

package Labyrinth::Plugin::CPAN::Content;

use strict;
use warnings;

our $VERSION = '3.56';

=head1 NAME

Labyrinth::Plugin::CPAN::Content - Additional content for CPAN.

=head1 DESCRIPTION

The functions contain herein are for CPAN and CPAN Testers related page content.

=cut

#----------------------------------------------------------------------------
# Libraries

use base qw(Labyrinth::Plugin::Base);

use Labyrinth::Support;
use Labyrinth::Variables;

use JSON;
use WWW::Mechanize;

#----------------------------------------------------------------------------
# Variables

# this should be a config option
# $settings{iheart_random} = 'http://iheart.cpantesters.org/home/random';

#----------------------------------------------------------
# Content Management Subroutines

=head1 CONTENT MANAGEMENT FUNCTIONS

=over 4

=item GetSponsor

Gets a random sponsor from the I <3 CPAN Testers website.

=back

=cut

sub GetSponsor {
    my $mech = WWW::Mechanize->new();
    $mech->agent_alias( 'Linux Mozilla' );
    eval { $mech->get( $settings{iheart_random} ) };
    return if($@ || !$mech->success() || !$mech->content());

    my $json = $mech->content();
    my $data = decode_json($json);

    return unless($data);

    $tvars{sponsor} = {
        title => $data->[0]->{links}[0]{title},
        image => $data->[0]->{links}[0]{image},
        body  => $data->[0]->{links}[0]{body},
        href  => $data->[0]->{links}[0]{href},
        url   => $data->[0]->{links}[0]{href}
    };

    $tvars{sponsor}{url} =~ s!^https?://(?:www\.)?([^/]+).*!$1!  if($tvars{sponsor}{url});
}

1;

__END__