File Coverage

blib/lib/WebService/Prowl.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch	1	2	50.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	26	29	89.6

package WebService::Prowl;

use strict;
use 5.008_001; # for utf8::is_utf8()
our $VERSION = '0.07';

use LWP::UserAgent;
use URI::Escape qw(uri_escape_utf8 uri_escape);
use Carp qw(croak);

my $API_BASE_URL = 'https://api.prowlapp.com/publicapi/';

BEGIN {
    @WebService::Prowl::EXPORT = qw( LIBXML );
    if ( eval { require XML::LibXML::Simple } ) {
        *{WebService::Prowl::LIBXML} = sub() {1};
    }
    else {
        require XML::Simple;
        *{WebService::Prowl::LIBXML} = sub() {0};
    }
}

sub new {
    my $class  = shift;
    my %params = @_;
    my $apikey = $params{'apikey'};
    return bless {
        apikey => $params{'apikey'},
        ua    => LWP::UserAgent->new( agent => __PACKAGE__ . '/' . $VERSION ),
        error => '',
        $params{'providerkey'} ? (providerkey => $params{'providerkey'}) : (),
    }, $class;
}

sub ua { $_[0]->{ua} }

sub error { $_[0]->{error} }

sub _build_url {
    my ( $self, $method, %params ) = @_;
    if ($method eq 'verify') {
        croak("apikey is required") unless $self->{apikey};
        my $url = $API_BASE_URL . 'verify?apikey=' . $self->{apikey};
        $url .= '&providerkey=' . $self->{providerkey} if $self->{providerkey};
        return $url;
    }
    elsif ($method eq 'add') {
        croak("apikey is required") unless $self->{apikey};
        my @params = qw/priority application event description url/;
        my $req_params = +{ map { $_ => delete $params{$_} } @params };

        croak("event name is required")       unless $req_params->{event};
        croak("application name is required") unless $req_params->{application};
        croak("description is required")      unless $req_params->{description};

        $req_params->{priority} ||= 0;

        ##XXX: validate url parameter???

        croak("priority must be an integer value in the range [-2, 2]")
            if ( $req_params->{priority} !~ /^-?\d+$/
            || $req_params->{priority} < -2
            || $req_params->{priority} > 2 );

        my %query = (
            apikey => $self->{apikey},
            $self->{providerkey} ? (providerkey => $self->{providerkey}) : (),
            map { $_  => $req_params->{$_} } @params,
        );
        my @out;
        for my $k (keys %query) {
            push @out, sprintf("%s=%s", _uri_escape($k), _uri_escape($query{$k}));
        }
        my $q = join ('&', @out);
        return $API_BASE_URL . 'add?' . $q;
    }
    elsif ($method eq 'retrieve_token') {
        croak("providerkey is required") unless $self->{providerkey};
        return $API_BASE_URL . 'retrieve/token?providerkey=' . $self->{providerkey};
    }
    elsif ($method eq 'retrieve_apikey') {
        croak("providerkey is required") unless $self->{providerkey};
        my $token = $params{'token'};
        croak("token is required") unless $token;
        my $url =  $API_BASE_URL . 'retrieve/apikey?providerkey=' . $self->{providerkey};
        $url .= '&token=' . $token;
        return $url;
    }
}

sub add {
    my ( $self, %params, $cb ) = @_;
    my $url = $self->_build_url('add', %params);
    $self->_send_request($url, $cb);
}

sub verify {
    my ($self) = @_;
    my $url = $self->_build_url('verify');
    $self->_send_request($url);
}

sub retrieve_token {
    my ( $self, %params, $cb ) = @_;
    my $url = $self->_build_url('retrieve_token', %params);
    $self->_send_request($url, $cb);
}

sub retrieve_apikey {
    my ( $self, %params, $cb ) = @_;
    my $url = $self->_build_url('retrieve_apikey', %params);
    $self->_send_request($url, $cb);
}

sub _send_request {
    my ( $self, $url, $cb ) = @_;
    my $res = $self->{ua}->get($url);
    my $data = $self->_xmlin($res->content);
    if ($res->is_error) {
        $self->{error} =
              $data->{error}
            ? $data->{error}{code} . ': ' . $data->{error}{content}
            : '';
        return;
    }
    return $data;
}

sub _xmlin {
    my ( $self, $xml ) = @_;
    if (LIBXML) {
        return XML::LibXML::Simple->new->XMLin( $xml );
    }
    else {
        return XML::Simple->new->XMLin( $xml );
    }
}

sub _uri_escape {
    utf8::is_utf8($_[0]) ? uri_escape_utf8($_[0]) : uri_escape($_[0]);
}

1;
__END__