File Coverage

blib/lib/AnyEvent/APNS.pm

Criterion	Covered	Total	%
statement	102	119	85.7
branch	22	34	64.7
condition	2	6	33.3
subroutine	16	19	84.2
pod	2	2	100.0
total	144	180	80.0

package AnyEvent::APNS;
use utf8;
use Any::Moose;

use AnyEvent 4.80;
use AnyEvent::Handle;
use AnyEvent::Socket;
use AnyEvent::TLS;

require bytes;
use Carp qw(croak);
use Encode;
use Scalar::Util 'looks_like_number';
use JSON::Any;

our $VERSION = '0.10';

has certificate => (
    is       => 'rw',
    isa      => 'Str | ScalarRef',
    required => 1,
);

has private_key => (
    is       => 'rw',
    isa      => 'Str | ScalarRef',
    required => 1,
);

has sandbox => (
    is      => 'rw',
    isa     => 'Bool',
    default => 0,
);

has handler => (
    is        => 'rw',
    isa       => 'AnyEvent::Handle',
    predicate => 'connected',
    clearer   => 'clear_handler',
);

has json_driver => (
    is      => 'rw',
    isa     => 'Object',
    lazy    => 1,
    default => sub {
        JSON::Any->new( utf8 => 1 );
    },
);

has on_error => (
    is      => 'rw',
    isa     => 'CodeRef',
    default => sub { sub { warn @_ } },
);

has on_eof => (
    is  => 'rw',
    isa => 'CodeRef',
);

has on_connect => (
    is      => 'rw',
    isa     => 'CodeRef',
    default => sub { sub {} },
);

has on_error_response => (
    is  => 'rw',
    isa => 'CodeRef',
);

has debug_port => (
    is        => 'rw',
    isa       => 'Int',
    predicate => 'is_debug',
);

has _con_guard => (
    is  => 'rw',
    isa => 'Object',
);

has last_identifier => (
    is      => 'rw',
    isa     => 'Int',
    default => sub { 0; }
);

no Any::Moose;

sub send {
    my $self = shift;
    my ($token, $payload, $expiry) = @_;

    my $json = encode_utf8( $self->json_driver->encode($payload) );

    # http://developer.apple.com/library/ios/#DOCUMENTATION/NetworkingInternet/Conceptual/RemoteNotificationsPG/CommunicatingWIthAPS/CommunicatingWIthAPS.html
    # Expiry—A fixed UNIX epoch date expressed in seconds (UTC) that identifies when the notification is no longer valid and can be discarded. The expiry value should be in network order (big endian). If the expiry value is positive, APNs tries to deliver the notification at least once. You can specify zero or a value less than zero to request that APNs not store the notification at all.
    # default to 24 hours
    $expiry  = defined $expiry ? $expiry : time() + 3600 * 24;

    # Identifier—An arbitrary value that identifies this notification. This same identifier is returned in a error-response packet if APNs cannot interpret a notification.
    my $next_identifier = $self->_increment_identifier;

    my $h = $self->handler;

    $h->push_write( pack('C', 1) ); # command
    $h->push_write( pack('N', $next_identifier) );
    $h->push_write( pack('N', $expiry) );
    $h->push_write( pack('n', bytes::length($token)) ); # token length
    $h->push_write( $token );                           # device token

    # Apple Push Notification Service refuses string values as badge number
    if ($payload->{aps}{badge} && looks_like_number($payload->{aps}{badge})) {
        $payload->{aps}{badge} += 0;
    }

    # The maximum size allowed for a notification payload is 256 bytes;
    # Apple Push Notification Service refuses any notification that exceeds this limit.
    if ( (my $exceeded = bytes::length($json) - 256) > 0 ) {
        if (ref $payload->{aps}{alert} eq 'HASH') {
            $payload->{aps}{alert}{body} =
                $self->_trim_utf8($payload->{aps}{alert}{body}, $exceeded);
        }
        else {
            $payload->{aps}{alert} = $self->_trim_utf8($payload->{aps}{alert}, $exceeded);
        }

        $json = encode_utf8( $self->json_driver->encode($payload) );
    }

    $h->push_write( pack('n', bytes::length($json)) ); # payload length
    $h->push_write( $json );                           # payload

    return $next_identifier;
}

sub _trim_utf8 {
    my ($self, $string, $trim_length) = @_;

    my $string_bytes = encode_utf8($string);
    my $trimmed = '';

    my $start_length = bytes::length($string_bytes) - $trim_length;
    return $trimmed if $start_length <= 0;

    for my $len ( reverse $start_length - 6 .. $start_length ) {
        local $@;
        eval {
            $trimmed = decode_utf8(substr($string_bytes, 0, $len), Encode::FB_CROAK);
        };
        last if $trimmed;
    }

    return $trimmed;
}

sub connect {
    my $self = shift;

    if ($self->connected && $self->handler) {
        warn 'Already connected!';
        return;
    }

    my $host = $self->sandbox
        ? 'gateway.sandbox.push.apple.com'
        : 'gateway.push.apple.com';
    my $port = 2195;

    if ($self->is_debug) {
        $host = '127.0.0.1';
        $port = $self->debug_port;
    }
    my $g = tcp_connect $host, $port, sub {
        my ($fh) = @_
            or return $self->on_error->(undef, 1, $!);

        my $tls_setting = {};
        if (ref $self->certificate) {
            $tls_setting->{cert}      = ${ $self->certificate };
        }
        else {
            $tls_setting->{cert_file} = $self->certificate;
        }

        if (ref $self->private_key) {
            $tls_setting->{key}       = ${ $self->private_key };
        }
        else {
            $tls_setting->{key_file}  = $self->private_key;
        }

        my $handle = AnyEvent::Handle->new(
            fh       => $fh,
            on_error => sub {
                $self->on_error->(@_);
                $self->clear_handler;
                $_[0]->destroy;
            },
            !$self->is_debug ? (
                tls      => 'connect',
                tls_ctx  => $tls_setting,
            ) : (),
        );
        $self->handler( $handle );

        if ($self->on_eof) {
            $handle->on_eof(sub {
                $self->on_eof->(@_);
                $self->clear_handler;
                $_[0]->destroy;
            });
        }

        if ( $self->on_error_response ) {
            $handle->on_read(
                sub {
                    $self->_on_read_with_error_callback( @_ );
                }
            );
        }
        else {
            $handle->on_read( sub { delete $_[0]->{rbuf} } );
        }

        $self->on_connect->();
    };

    Scalar::Util::weaken($self);
    $self->_con_guard($g);

    $self;
}

sub _on_read_with_error_callback {
    my ($self, $handle) = @_;
    $handle->push_read( chunk => 1,
                        sub {
                            my $command = unpack( 'C', $_[1] );
                            if ( $command != 8 ) {
                                # something is wrong
                                # auto reconnect
                                $self->clear_handler;
                                $self->connect;
                            }
                        });
    $handle->push_read( chunk => 5,
                        sub {
                            my $status     = unpack( 'C', substr( $_[1], 0, 1) );
                            my $identifier = unpack( 'N', substr( $_[1], 1, 4) );
                            $self->on_error_response->( $identifier => $status );
                        });
}

# 0 ... 2**32-1, 0 ... 2**32-1, 0 ...
sub _increment_identifier {
    my ($self) = @_;
    my $next_identifier = $self->last_identifier + 1;
    if ( $next_identifier >= 2 ** 32 ) {
        # identifier is only 4 bytes
        $next_identifier = 0;
    }
    $self->last_identifier( $next_identifier );
}

__PACKAGE__->meta->make_immutable;

__END__