File Coverage

blib/lib/WebService/UrbanAirship/APNS.pm

Criterion	Covered	Total	%
statement	50	203	24.6
branch	2	90	2.2
condition	1	28	3.5
subroutine	15	25	60.0
pod	8	9	88.8
total	76	355	21.4

package WebService::UrbanAirship::APNS;

use 5.006;

use strict;
use warnings FATAL => qw(all);

use WebService::UrbanAirship;

use JSON::XS ();
use HTTP::Request ();
use HTTP::Response ();
use HTTP::Headers ();
use LWP::UserAgent ();
use LWP::Protocol::https ();


#---------------------------------------------------------------------
# globals
#---------------------------------------------------------------------

our $DEBUG   = 0;

our $VERSION = "0.02";

our @ISA     = qw(WebService::UrbanAirship);


#---------------------------------------------------------------------
# constructor
#---------------------------------------------------------------------
sub new {

  my $class = shift;

  my %args = @_;

  foreach my $key (qw(application_key application_secret application_push_secret)) {
    die "missing argument: $key"
      unless $args{$key};
  }

  my $self = {_push_secret => delete $args{application_push_secret},
              _secret      => delete $args{application_secret},
              _key         => delete $args{application_key},
             };

  bless $self, $class;

  $self->_init(%args);

  return $self;
}


#---------------------------------------------------------------------
# private initialization routine
#---------------------------------------------------------------------
sub _init {

  shift->ua;
}


#---------------------------------------------------------------------
# set up the ua object
#---------------------------------------------------------------------
sub ua {

  my $self = shift;

  my %args = @_;

  my $ua = $self->{_ua} ||
           LWP::UserAgent->new(agent             => $self->_agent(),
                               protocols_allowed => [ qw(https) ],
                               timeout           => $self->_timeout(),
                              );

  # set (or reset) the headers
  my $headers = HTTP::Headers->new();

  # all data needs to be JSON
  $headers->content_type('application/json');

  # set the authentication headers here
  $headers->authorization_basic($self->{_key}, $self->{_push_secret});

  $ua->default_headers($headers);

  $self->{_ua} = $ua;

  return $ua;
}



#---------------------------------------------------------------------
# default user-agent string
#---------------------------------------------------------------------
sub _agent {

  return join '/', __PACKAGE__, $VERSION;
}

#---------------------------------------------------------------------
# default timeout
#---------------------------------------------------------------------
sub _timeout {

  return 60;
}


#---------------------------------------------------------------------
# main api...
#---------------------------------------------------------------------

#---------------------------------------------------------------------
# device registration
#---------------------------------------------------------------------

sub register_device {

  my $self  = shift;

  my %args  = @_;

  my $token = delete $args{device_token};

  return unless $token;

  # as a shortcut, tidy the id per urban airship specs...

  $token = uc $token;
  $token =~ s/[-\s<>]//g;

  my $json;

  if (scalar keys %args) {

    delete $args{alias} unless $args{alias};
    delete $args{tags} unless $args{tags} && ref $args{tags};

    $json = JSON::XS::encode_json(\%args);

  }

  my $ua = $self->ua;

  my $headers = $ua->default_headers;

  # this API requires the secret key, not the push secret key
  $headers->authorization_basic($self->{_key}, $self->{_secret});

  my $uri = $self->_api_uri;

  $uri->path(join '/', '/api/device_tokens', $token);

  my $request = HTTP::Request->new('PUT',
                                   $uri,
                                   $headers,
                                   $json);

  return $self->_request($request);
}


sub ping_device {

  my $self  = shift;

  my %args  = @_;

  my $token = delete $args{device_token};

  return unless $token;

  # as a shortcut, tidy the id per urban airship specs...

  $token = uc $token;
  $token =~ s/[-\s<>]//g;

  my $ua = $self->ua;

  my $headers = $ua->default_headers;

  # this API requires the secret key, not the push secret key
  $headers->authorization_basic($self->{_key}, $self->{_secret});

  my $uri = $self->_api_uri;

  $uri->path(join '/', '/api/device_tokens', $token);

  my $request = HTTP::Request->new('GET',
                                   $uri,
                                   $headers);

  return $self->_request($request, 1);
}


sub push {

  my $self  = shift;

  my %args  = @_;

  my ($perl, $body) = $self->_craft_single_push(\%args);

  return unless $perl;

  my $json = JSON::XS::encode_json($perl);

  my $uri = $self->_api_uri;

  $uri->path('/api/push/');

  my $request = HTTP::Request->new('POST',
                                   $uri);

  $request->content($json);

  return $self->_request($request, $body);
}

sub batch {

  my $self  = shift;

  my @args = @_;

  my @array;

  foreach my $key (@args) {

    next unless ref $key eq 'HASH';

    my ($perl) = $self->_craft_single_push($key, 1);

    next unless $perl;

    CORE::push @array, $perl;
  }

  return unless scalar @array;

  my $json = JSON::XS::encode_json(\@array);

  my $uri = $self->_api_uri;

  $uri->path('/api/push/batch/');

  my $request = HTTP::Request->new('POST',
                                   $uri);

  $request->content($json);

  return $self->_request($request);
}

sub broadcast {

  my $self = shift;

  my %args = @_;

  my $payload = $self->_craft_payload(\%args);

  return unless $payload;

  my $perl = {aps => $payload};

  if (my $exclude = delete $args{exclude_tokens}) {
    $perl->{exclude_tokens} = $exclude
      if ref $exclude && ref $exclude eq 'ARRAY';
  }

  my $json = JSON::XS::encode_json($perl);

  my $uri = $self->_api_uri;

  $uri->path('/api/push/broadcast/');

  my $request = HTTP::Request->new('POST',
                                   $uri);

  $request->content($json);

  return $self->_request($request);
}

sub feedback {

  my $self = shift;

  my %args = @_;

  my $date = delete $args{since};

  return unless $date;

  my $uri = $self->_api_uri;

  $uri->path('/api/device_tokens/feedback/');

  $uri->query(join '=', 'since', $date);

  my $request = HTTP::Request->new('GET',
                                   $uri);

  return $self->_request($request, 1);
}

sub stats {

  my $self = shift;

  my %args = @_;

  my $start  = delete $args{start};
  my $end    = delete $args{end};

  my $format = delete $args{format};

  return unless $start && $end;

  my $uri = $self->_api_uri;

  $uri->path('/api/push/stats/');

  my $query = "start=$start&end=$end";

  $query = join '&', $query, "format=$format" if $format;

  $uri->query($query);

  my $request = HTTP::Request->new('GET',
                                   $uri);

  return $self->_request($request, 1);
}


sub _request {

  my $self    = shift;

  my $request = shift;

  my $body    = shift;

  if ($request->method eq 'GET') {
    $request->headers->remove_header('content-type');
  }

  print STDERR "request: ", $request->as_string
    if $DEBUG;

  my $response = $self->ua->request($request);

  print STDERR "response: ", $response->as_string
    if $DEBUG;

  if ($response->is_success) {

    if ($body) {
      return $response->content;
    }
    else {
      return $response->code;
    }
  }

  return;
}


sub _craft_single_push {

  my $self = shift;

  my %args = %{shift || {}};

  my $batch = shift;

  my $payload = $self->_craft_payload(\%args);

  return unless $payload;

  my $tokens  = delete $args{device_tokens} || [];

  if ($tokens) {
    return unless ref $tokens eq 'ARRAY';
  }

  my $aliases = delete $args{aliases} || [];

  if ($aliases) {
    return unless ref $aliases eq 'ARRAY';
  }

  my $tags = [];

  unless ($batch) {
    $tags = delete $args{tags} || [];

    if ($tags) {
      return unless ref $tags eq 'ARRAY';
    }
  }

  return unless (scalar @$aliases || scalar @$tokens || scalar @$tags);

  my $perl = {};

  if (scalar @$aliases) {
    $perl->{aliases} = $aliases;
  }

  if (scalar @$tokens) {
    $perl->{device_tokens} = $tokens;
  }

  if (scalar @$tags) {
    $perl->{tags} = $tags;
  }

  return unless scalar keys %$perl;

  $perl->{aps} = $payload;

  my $body = 0;

  unless ($batch) {
    if (my $schedule = delete $args{schedule_for}) {
      if (ref $schedule && ref $schedule eq 'ARRAY') {
        $perl->{schedule_for} = $schedule ;
        $body = 1;
      }
    }

    if (my $exclude = delete $args{exclude_tokens}) {
      $perl->{exclude_tokens} = $exclude
        if ref $exclude && ref $exclude eq 'ARRAY';
    }
  }

  return ($perl, $body);
}


sub _craft_payload {

  my $self = shift;

  my %args = %{shift || {}};

  my $badge = eval { int delete $args{badge} };
  my $alert = delete $args{alert};
  my $sound = delete $args{sound};

  my $payload = {};

  $payload->{badge} = $badge if defined $badge;
  $payload->{sound} = $sound if $sound;
  $payload->{alert} = $alert if $alert;

  return unless scalar keys %$payload;

  return $payload;
}


__END__