File Coverage

blib/lib/WWW/Pastebin/Sprunge/Retrieve.pm

Criterion	Covered	Total	%
statement	33	71	46.4
branch	1	18	5.5
condition	2	8	25.0
subroutine	9	15	60.0
pod	2	2	100.0
total	47	114	41.2

package WWW::Pastebin::Sprunge::Retrieve;
use strict;
use warnings;
# ABSTRACT: retrieves pastes from the sprunge.us pastebin
our $VERSION = '0.009'; # VERSION
use URI;
use Carp;
use LWP::UserAgent;
use Encode;
use base 'Class::Data::Accessor';
__PACKAGE__->mk_classaccessors(qw(
    ua
    uri
    id
    content
    error
    results
));

use overload q|""| => sub { shift->content };



sub new {
    my $class = shift;
    croak 'new() takes an even number of arguments' if @_ & 1;

    my %args = @_;
    $args{ +lc } = delete $args{ $_ } for keys %args;

    $args{timeout} ||= 30;
    $args{ua} ||= LWP::UserAgent->new(
        timeout => $args{timeout},
        agent   => 'WWW::Pastebin::Sprunge (+http://p3rl.org/WWW::Pastebin::Sprunge)',
    );

    my $self = bless {}, $class;
    $self->ua( $args{ua} );

    return $self;
}


sub retrieve {
    my $self = shift;
    my $id   = shift;

    $self->$_(undef) for qw( error uri id results );

    return $self->_set_error('Missing or empty paste ID/URL')
        unless $id;

    (my $uri, $id) = $self->_make_uri_and_id($id, @_) or return;

    $self->uri($uri);
    $self->id($id);

    my $ua = $self->ua;
    my $response = $ua->get($uri);
    if ($response->is_success) {
        return $self->_get_was_successful($response->content);
    }
    else {
        return $self->_set_error('Network error: ' . $response->status_line);
    }
}

sub _get_was_successful {
    my $self    = shift;
    my $content = shift;

    return $self->results( $self->_parse($content) );
}

sub _set_error {
    my $self         = shift;
    my $err_or_res   = shift;
    my $is_net_error = shift;

    if (defined $is_net_error) {
        $self->error('Network error: ' . $err_or_res->status_line);
    }
    else {
        $self->error($err_or_res);
    }
    return;
}

sub _make_uri_and_id {
    my $self = shift;
    my $in   = shift;

    my $id;
    if ( $in =~ m{ (?:http://)? (?:www\.)? sprunge.us/ (\S+?) (?:\?\w+)? $}ix ) {
        $id = $1;
    }
    $id = $in unless defined $id;

    return ( URI->new("http://sprunge.us/$id"), $id );
}

sub _parse {
    my $self    = shift;
    my $content = shift;
    my $id      = $self->id;

    if (!defined($content) or !length($content)) {
        return $self->_set_error('Nothing to parse (empty document retrieved)');
    }
    elsif ($content eq "$id not found") {
        return $self->_set_error('No such paste');
    }
    else {
        $self->results(decode_utf8($content));
        return $self->content(decode_utf8($content));
    }
}



sub content {
    my $self = shift;

    return $self->results;
}

1;

__END__