File Coverage

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

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package WWW::Pastebin::Many::Retrieve;

use warnings;
use strict;

our $VERSION = '0.002';
use Carp;
use WWW::Pastebin::NoMorePastingCom::Retrieve;
use WWW::Pastebin::PastebinCa::Retrieve;
use WWW::Pastebin::PastebinCom::Retrieve;
use WWW::Pastebin::PastieCabooSe::Retrieve;
use WWW::Pastebin::PhpfiCom::Retrieve;
use WWW::Pastebin::RafbNet::Retrieve;
use WWW::Pastebin::UbuntuNlOrg::Retrieve;
use base 'Class::Data::Accessor';
__PACKAGE__->mk_classaccessors qw(
    _res
    _objs
    content
    response
    error
);

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

sub new {
    my $self = bless {}, shift;
    croak "Must have even number of arguments to new()"
        if @_ & 1;

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

    my %objs = (
        no_more_pasting => WWW::Pastebin::NoMorePastingCom::Retrieve->new(
            timeout => $args{timeout},
        ),
        pastebin_ca     => WWW::Pastebin::PastebinCa::Retrieve->new(
            timeout => $args{timeout},
        ),
        pastebin_com    => WWW::Pastebin::PastebinCom::Retrieve->new(
            timeout => $args{timeout},
        ),
        pastie_caboo_se => WWW::Pastebin::PastieCabooSe::Retrieve->new(
            timeout => $args{timeout},
        ),
        phpfi_com       => WWW::Pastebin::PhpfiCom::Retrieve->new(
            timeout => $args{timeout},
        ),
        rafb_net        => WWW::Pastebin::RafbNet::Retrieve->new(
            timeout => $args{timeout},
        ),
        ubuntu_nl_org   => WWW::Pastebin::UbuntuNlOrg::Retrieve->new(
            timeout => $args{timeout},
        ),
    );

    my %res = (
        no_more_pasting => qr{^
            (?:http://)?
            (?:www\.)?
            \Qnomorepasting.com/getpaste.php?\E
        }xi,
        pastebin_ca     => qr{(?:http://)? (?:www\.)? \S*? pastebin\.ca/}xi,
        pastebin_com    => qr{(?:http://)? (?:www\.)?\S*? pastebin\.com/}xi,
        pastie_caboo_se => qr{
            (?:http://)? (?:www\.)?
            \Qpastie.caboo.se/\E
            (\d+)
            /?
        }xi,
        phpfi_com       => qr{(?:http://)? (?:www\.)? phpfi\.com/(?=\d+)}xi,
        rafb_net        => qr{
            (?:http://)? (?:www\.)? rafb.net/p/ (\S+?) \.html
        }ix,
        ubuntu_nl_org   => qr{
            (?:http://)? (?:www\.)? paste\.ubuntu-nl\.org/ (\d+) /?
        }xi,
    );

    $self->_objs( \%objs );
    $self->_res( \%res  );

    return $self;
}

sub retrieve {
    my ( $self, $uri ) = @_;
    my $res_ref  = $self->_res;
    my $objs_ref = $self->_objs;

    $self->$_(undef) for qw(error content response);

    keys %$res_ref;
    while ( my ( $pastebin, $re ) = each %$res_ref ) {
        if ( $uri =~ $re ) {
            my $obj = $objs_ref->{$pastebin};
            my $response_ref = $obj->retrieve( $uri )
                or return $self->_set_error( $obj->error );

            $self->content( $obj->content );
            return $self->response( $response_ref );
        }
    }
    return $self->_set_error(
        'Your URI did not match any pastebin I can handle'
    );
}

sub _set_error {
    my ( $self, $error ) = @_;
    $self->error( $error );
    return;
}

1;
__END__