view release on metacpan or  search on metacpan

lib/AnyEvent/APNS.pm  view on Meta::CPAN

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',
);

lib/AnyEvent/APNS.pm  view on Meta::CPAN

        }

        $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__

=for stopwords
apns SDK TODO iPhone multi-byte utf8

=head1 NAME

AnyEvent::APNS - Simple wrapper for Apple Push Notifications Service (APNS) provider

=head1 SYNOPSIS

    use AnyEvent::APNS;

    my $cv = AnyEvent->condvar;

    my $apns; $apns = AnyEvent::APNS->new(
        certificate => 'your apns certificate file',
        private_key => 'your apns private key file',
        sandbox     => 1,
        on_error    => sub { # something went wrong },
        on_connect  => sub {
            my $identifier = $apns->send( $device_token => {
                aps => {
                    alert => 'Message received from Bob',
                },
            });
        },
        on_error_response => sub {
            my ($identifier, $status) = @_;
            # something wrong
        },
    );
    $apns->connect;

    # disconnect and exit program as soon as possible after sending a message
    # otherwise $apns makes persistent connection with apns server
    $apns->handler->on_drain(sub {
        undef $_[0];
        $cv->send;
    });

    $cv->recv;

=head1 DESCRIPTION

This module helps you to create Apple Push Notifications Service (APNS) Provider.

=head1 NOTE FOR 0.01x USERS

From 0.02, this module does not connect in constructor.
You should call connect method explicitly to connect server.

=head1 METHODS

=head2 new

Create APNS object.

    my $apns = AnyEvent::APNS->new(
        certificate => 'your apns certificate file',
        private_key => 'your apns private key file',
        sandbox     => 1,
        on_error    => sub { # something went wrong },
    );

Supported arguments are:

=over 4

=item certificate => 'Str | ScalarRef'

    certificate => '/path/to/certificate_file',
    # or
    certificate => \$certificate,

Required. Either file path for certificate or scalar-ref of certificate data.

=item private_key => 'Str | ScalarRef'

    private_key => '/path/to/private_key',
    # or
    private_key => \$private_key,

Required. Either file path for private_key or scalar-ref of private-key data.

=item sandbox => 0|1

This is a flag indicate target service is provisioning (sandbox => 1) or distribution (sandbox => 0)

Optional (Default: 0)

=item on_error => $cb->($handle, $fatal, $message)

Callback to be called when something error occurs.
This is wrapper for L<AnyEvent::Handle>'s on_error callbacks. Look at the document for more detail.

Optional (Default: just warn error)

=item on_eof => $cb->($handle)

Callback to be called when an end-of-file condition is detected.

Optional. (Default: use on_error instead. read L<AnyEvent::Handle> for more detail)

=item on_connect => $cb->()

Callback to be called when connection established to apns server.

Optional (Default: empty coderef)

=item on_error_response => $cb->($identifier, $status)

Callback to be called when APNs detects notification malformed or otherwise unintelligible.

C<$status> codes are documented here: L<http://developer.apple.com/library/ios/#DOCUMENTATION/NetworkingInternet/Conceptual/RemoteNotificationsPG/CommunicatingWIthAPS/CommunicatingWIthAPS.html>

C<$identifier> is the return value of C<send>.

Optional (Default: ignore)

=back

=head2 $apns->connect;

Connect to apns server.

=head2 $apns->send( $device_token, \%payload )

Send apns messages with C<\%payload> to device specified C<$device_token>.

    my $identifier = $apns->send( $device_token => {
        aps => {
            alert => 'Message received from Bob',
        },
    });

C<$device_token> should be a binary 32bytes device token provided by iPhone SDK (3.0 or above)

C<\%payload> should be a hashref suitable to apple document: L<http://developer.apple.com/iPhone/library/documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/ApplePushService/ApplePushService.html>

Note: If you involve multi-byte strings in C<\%payload>, it should be utf8 decoded strings not utf8 bytes.

Store C<$identifier> with your C<$device_token> to react to C<on_error_response>.