File Coverage

blib/lib/EPublisher/Source/Plugin/PerltutsCom.pm

Criterion	Covered	Total	%
statement	34	46	73.9
branch	3	6	50.0
condition	3	6	50.0
subroutine	9	9	100.0
pod	2	2	100.0
total	51	69	73.9

package EPublisher::Source::Plugin::PerltutsCom;


# ABSTRACT: Get POD from tutorials published on perltuts.com

use strict;
use warnings;

use Encode;
use File::Basename;
use HTTP::Tiny;

use parent qw( EPublisher::Source::Base );


our $VERSION = '0.6_01';
our $UA;

# implementing the interface to EPublisher::Source::Base
sub load_source{
    my ($self, $name) = @_;

    $self->publisher->debug( '100: start ' . __PACKAGE__ );

    my $options = $self->_config;

    $name //= $options->{name};
    if ( !$name ) {
        $self->publisher->debug( '400: No tutorial name given' );
        return;
    }

    # fetching the requested tutorial from metacpan
    $self->publisher->debug( "103: fetch tutorial $name" );

    return $self->_get_pod( $name );
}

sub _get_pod {
    my ($self,$name) = @_;

    my $response = $self->ua->get(
        'http://perltuts.com/tutorials/' . $name . '?format=pod'
    );

    if ( $response !~ m{\A2} ) {
        $self->publisher->debug(
            "103: tutorial $name does not exist"
        );

        return;
    };

    my $pod = $response->{content};

    # perltuts.com always provides utf-8 encoded data, so we have
    # to decode it otherwise the target plugins may produce garbage
    eval{ $pod = decode( 'utf-8', $pod ); };

    my $title    = $name;
    my $info = { pod => $pod, filename => $name, title => $title };
    my @pod = $info;

    # make some nice debug output for what is in $info
    my $pod_short;
    if ($pod =~ m/(.{50})/s) {
        $pod_short = $1 . '[...]';
    }
    else {
        $pod_short = $pod;
    }

    $self->publisher->debug(
        "103: passed info: "
        . "filename => $name, "
        . "title => $title, "
        . 'pod => ' . substr($pod, 0, 30) . '<<<
    );

    return @pod;
}

sub ua {
    $UA //= HTTP::Tiny->new;
    $UA;
}

1;

__END__