File Coverage

blib/lib/App/Nopaste/Service.pm

Criterion	Covered	Total	%
statement	42	55	76.3
branch	7	20	35.0
condition	2	6	33.3
subroutine	11	12	91.6
pod	6	9	66.6
total	68	102	66.6

use strict;
use warnings;
package App::Nopaste::Service;
# ABSTRACT: base class for nopaste services

our $VERSION = '1.013';

use WWW::Mechanize;

sub available         { 1 }
sub forbid_in_default { 0 }

# this wrapper is so we can canonicalize arguments, especially "lang"
sub nopaste {
    my $self = shift;
    $self->run(@_);
}

sub run {
    my $self = shift;
    my $mech = WWW::Mechanize->new;

    $self->get($mech => @_);
    $self->fill_form($mech => @_);
    return $self->return($mech => @_);
}

sub uri {
    my $class = ref($_[0]) || $_[0];
    Carp::croak "$class must provide a 'uri' method.";
}

sub get {
    my $self = shift;
    my $mech = shift;

    my $res = $mech->get($self->uri);
    die "Unable to fetch ".$self->uri.": " . $res->status_line
        unless $res->is_success;
    return $res;
}

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

    $mech->form_number(1);
    $args{chan} = $self->canonicalize_chan($mech, $args{chan});

    $mech->submit_form(
        fields        => {
            paste => $args{text},
            do { $args{chan} ? (channel => $args{chan}) : () },
            do { $args{desc} ? (summary => $args{desc}) : () },
            do { $args{nick} ? (nick    => $args{nick}) : () },
            private => (exists $args{private} && $args{private} ? 1 : 0),
        },
    );
}

sub canonicalize_chan {
    my $self = shift;
    my $mech = shift;
    my $chan = shift;

    return $chan if !$chan;

    my @chans = grep { length }
                $mech->current_form->find_input('channel')->possible_values;
    my %is_valid = map { $_ => 1 } @chans;

    return $chan if $is_valid{$chan};

    my $orig = $chan;
    $chan =~ s/^\#//;
    return $chan if $is_valid{$chan};

    $chan = "#$chan";
    return $chan if $is_valid{$chan};

    warn "Invalid channel '$orig'. Valid values are: " . join(', ', @chans);
    return $orig;
}

sub return {
    my $self = shift;
    my $mech = shift;

    my $link = $mech->find_link(url_regex => qr{/?(?:\d+)$});

    return (0, "Could not find paste link.") if !$link;
    return (1, $link->url);
}

1;

__END__