File Coverage

blib/lib/WebService/Pushover.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package WebService::Pushover;
use strict;

use Moo;

binmode STDOUT, ":encoding(UTF-8)";

use Carp;
use DateTime;
use DateTime::Format::Strptime;
use File::Spec;
use WebService::Simple;
use WebService::Simple::Parser::JSON;
use Params::Validate qw( :all );
use Readonly;
use URI;

use version; our $VERSION = qv('1.0.0');

# Module implementation here

# constants
Readonly my $REGEX_FORMAT => '^(?:json|xml)$';
Readonly my $REGEX_TOKEN => '^[A-Za-z0-9]{30}$';
Readonly my $REGEX_DEVICE => '^[A-Za-z0-9_-]{0,25}$';
Readonly my $REGEX_NUMERIC => '^\d+$';
Readonly my $REGEX_SOUNDS => '^(?:pushover|bike|bugle|cashregister|classical|cosmic|falling|gamelan|incoming|intermission|magic|mechanical|pianobar|siren|spacealarm|tugboat|alien|climb|persistent|echo|updown|none)$';

Readonly my $SIZE_TITLE => 50;
Readonly my $SIZE_MESSAGE => 512;
Readonly my $SIZE_URL => 200;
Readonly my $SIZE_RETRY => 30;
Readonly my $SIZE_EXPIRE => 86400;

has debug => (
    is => 'ro',
    default => sub { 0 },
    coerce => sub { $_[0] ? 1 : 0 },
);

# NB: We can't call this 'user', as there's already a method called that.
has user_token => (
    is       => 'ro',
    required => 0,
    isa      => sub { $_[0] =~ /$REGEX_TOKEN/ or die "Invalid user token: $_[0]" },
);

has api_token => (
    is       => 'ro',
    required => 0,
    isa      => sub { $_[0] =~ /$REGEX_TOKEN/ or die "Invalid api token: $_[0]" },
);

has base_url => (
    default => "https://api.pushover.net",
    is      => 'ro',
);

has _urls => (
    is => 'ro',
    default => sub {
        return {
            messages => '/1/messages.json',
            users    => '/1/users/validate.json',
            receipts => '/1/receipts/$receipt$.json',
            sounds   => '/1/sounds.json',
        };
    },
);

has api => (
    is => 'lazy',
);

sub _build_api {
    my ($self) = @_;
    return WebService::Simple->new(
        response_parser => WebService::Simple::Parser::JSON->new,
        base_url        => $self->base_url,
        debug           => $self->debug,
    );
}

has specs => (
    is => 'lazy',
);

sub _build_specs {
    my $self = shift();
    my $SPECS = {
        token => {
            type  => SCALAR,
            regex => qr/$REGEX_TOKEN/,
        },
        user => {
            type  => SCALAR,
            regex => qr/$REGEX_TOKEN/,
        },
        device => {
            optional => 1,
            type     => SCALAR,
            regex    => qr/$REGEX_DEVICE/,
        },
        receipt => {
            type  => SCALAR,
            regex => qr/$REGEX_TOKEN/, # yes, receipts are formatted like tokens
        },
        callback => {
            optional => 1,
            type  => SCALAR,
            callbacks => {
                "valid URL" => sub {
                    my $url = shift;
                    my $uri = URI->new( $url );
                    defined( $uri->as_string() );
                },
            },
        },
        title => {
            optional  => 1,
            type      => SCALAR,
            callbacks => {
                "$SIZE_TITLE characters or fewer" => sub { length( shift() ) <= $SIZE_TITLE },
            },
        },
        message => {
            type      => SCALAR,
            callbacks => {
                "$SIZE_MESSAGE characters or fewer" => sub { length( shift() ) <= $SIZE_MESSAGE },
            },
        },
        timestamp => {
            optional  => 1,
            type      => SCALAR,
            callbacks => {
                "Unix epoch timestamp" => sub {
                    my $timestamp = shift;
                    my $strp = DateTime::Format::Strptime->new(
                        pattern   => '%s',
                        time_zone => "floating",
                        on_error  => "undef",
                    );
                    defined( $strp->parse_datetime( $timestamp ) );
                },
            },
        },
        priority => {
            optional  => 1,
            type      => SCALAR,
            callbacks => {
                "valid or undefined" => sub {
                    my $priority = shift;
                    my( %priorities ) = (
                        0  => 'valid',
                        1  => 'valid',
                        -1 => 'valid',
                        2  => 'valid',
                    );
                    ( ! defined( $priority ) )
                        or exists $priorities{$priority};
                },
            },
        },
        url => {
            optional  => 1,
            type      => SCALAR,
            callbacks => {
                "valid URL" => sub {
                    my $url = shift;
                    my $uri = URI->new( $url );
                    defined( $uri->as_string() );
                },
            },
        },
        url_title => {
            optional  => 1,
            type      => SCALAR,
            callbacks => {
                "$SIZE_TITLE characters or fewer" => sub { length( shift() ) <= $SIZE_TITLE },
            },
        },
        sound => {
            optional => 1,
            type     => SCALAR,
            regex    => qr/$REGEX_SOUNDS/,
        },
        retry => {
            optional => 1,
            type     => SCALAR,
            callbacks => {
                "numeric" => sub { shift() =~ /$REGEX_NUMERIC/ },
                "$SIZE_RETRY seconds or more" => sub { shift() >= $SIZE_RETRY },
            }
        },
        expire => {
            optional => 1,
            type     => SCALAR,
            callbacks => {
                "numeric" => sub { shift() =~ /$REGEX_NUMERIC/ },
                "$SIZE_EXPIRE seconds or fewer" => sub { shift() <= $SIZE_EXPIRE },
            }
        },
    };

    my %messages_spec = (
        token     => $SPECS->{token},
        user      => $SPECS->{user},
        device    => $SPECS->{device},
        title     => $SPECS->{title},
        message   => $SPECS->{message},
        timestamp => $SPECS->{timestamp},
        priority  => $SPECS->{priority},
        callback  => $SPECS->{callback},
        sound     => $SPECS->{sound},
        retry     => $SPECS->{retry},
        expire    => $SPECS->{expire},
        url       => $SPECS->{url},
        url_title => $SPECS->{url_title},
    );

    my %users_spec = (
        token  => $SPECS->{token},
        user   => $SPECS->{user},
        device => $SPECS->{device},
    );

    my %receipts_spec = (
        token   => $SPECS->{token},
        receipt => $SPECS->{receipt},
    );

    my %sounds_spec = (
        token  => $SPECS->{token},
    );

    return {
        messages => \%messages_spec,
        users    => \%users_spec,
        receipts => \%receipts_spec,
        sounds   => \%sounds_spec,
    };
}

sub _apicall {
    my ($self, $method, $call, @rest) = @_;

    my $spec = $self->specs->{$call}
        or croak( "'$call' is not a supported API call." );
    my $url    = $self->_urls->{$call}
         or croak( "'$call' is not a supported API call." );
    my $params = validate( @rest, $spec );

    while ($url =~ /\$(\S+?)\$/) {
        my $arg = $1;
        my $val = delete($params->{$arg}) || "";
        $url =~ s/\$$arg\$/$val/g;
    }

    return $self->api->$method($url, $params)->parse_response;
}

sub message {
    my ($self, %opts) = @_;

    return $self->_apicall(post => 'messages',
        user  => $self->user_token,
        token => $self->api_token,
        %opts,
    );
}

sub user {
    my ($self, %opts) = @_;

    return $self->_apicall(post => 'users',
        user  => $self->user_token,
        token => $self->api_token,
        %opts,
    );
}

sub receipt {
    my ($self, %opts) = @_;

    return $self->_apicall(get => 'receipts',
        token => $self->api_token,
        %opts,
    );
}

sub sounds {
    my ($self, %opts) = @_;

    return $self->_apicall(get => 'sounds',
        token => $self->api_token,
        %opts,
    );
}

# ok, add some backwards compatibility
before 'push' => sub {
    carp( "The 'push' method is deprecated in WebService::Pushover v0.1.0, and will be removed in a future release.  Please use the 'message' method instead." );
};

sub push {
    my $self = shift;
    $self->message( @_ );
}

before 'tokens' => sub {
    carp( "The 'tokens' method is deprecated in WebService::Pushover v0.1.0, and will be removed in a future release.  Please use the 'user' method instead." );
};

sub tokens {
    my $self = shift;
    $self->user( @_ );
}

1; # Magic true value required at end of module
__END__