File Coverage

blib/lib/WWW/Hashbang/Pastebin/Client.pm

Criterion	Covered	Total	%
statement	19	45	42.2
branch	3	20	15.0
condition	0	3	0.0
subroutine	5	9	55.5
pod	5	5	100.0
total	32	82	39.0

package WWW::Hashbang::Pastebin::Client;
use strict;
use warnings;
# ABSTRACT: a client library for WWW::Hashbang::Pastebin websites
our $VERSION = '0.003'; # VERSION

use HTTP::Tiny;
use Carp;


sub new {
    my $class = shift;
    my %args = @_;
    croak 'No pastebin URL provided' unless $args{url};
    croak 'Pastebin must be an absolute URL' unless $args{url} =~ m{^http};

    my $self = { url => $args{url} };
    $self->{ua} = HTTP::Tiny->new(
        agent => __PACKAGE__ . '/'
            . (__PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev')
            . ' (+https://metacpan.org/module/' . __PACKAGE__ . ')'
    );

    return bless $self, $class;
}


sub paste {
    my $self = shift;
    my %args = @_;

    if ($args{file}) {
        $args{paste} = do {
            local $/;
            open my $in, '<', $args{file}
                or die "Can't open $args{file} for reading: $!";
            <$in>
        };
    }
    croak 'No paste content given' unless $args{paste};

    my $post_response = $self->{ua}->post_form(
        $self->{url}, { p => $args{paste} }
    );

    return $post_response->{headers}->{'X-Pastebin-URL'} || $post_response->{content}
        if $post_response->{success};

    die $post_response->{status}, ' ' , $post_response->{reason}, ' ', $post_response->{content};
}


sub put {
    my $self = shift;
    $self->paste(@_);
}


sub get {
    my $self = shift;
    my $id   = shift;
    croak 'No paste ID given' unless $id;

    $id =~ s{^\Q$self->{url}\E}{} if ($id =~ m/\Q$self->{url}\E/);
    $id =~ s{^/}{};
    $id =~ s{\+$}{};
    chomp $id;

    my $URI = "$self->{url}/$id";
    my $get_response = $self->{ua}->get($URI);

    return $get_response->{content} if $get_response->{success};

    die $get_response->{status}, ' ' , $get_response->{reason}, ' ', $get_response->{content};
}


sub retrieve {
    my $self = shift;
    $self->get(@_);
}

1;

__END__