package Net::APNs::Extended; use strict; use warnings; use 5.008_001; our $VERSION = '0.03'; use parent qw(Exporter Net::APNs::Extended::Base); use Carp qw(croak); our @EXPORT_OK; use Exporter::Constants ( \@EXPORT_OK => { NO_ERRORS => 0, PROCESSING_ERROR => 1, MISSING_DEVICE_TOKEN => 2, MISSING_TOPIC => 3, MISSING_PAYLOAD => 4, INVALID_TOKEN_SIZE => 5, INVALID_TOPIC_SIZE => 6, INVALID_PAYLOAD_SIZE => 7, INVALID_TOKEN => 8, UNKNOWN_ERROR => 255, }, ); our %EXPORT_TAGS = (constants => \@EXPORT_OK); __PACKAGE__->mk_accessors(qw[ max_payload_size command ]); my %default = ( host_production => 'gateway.push.apple.com', host_sandbox => 'gateway.sandbox.push.apple.com', is_sandbox => 0, port => 2195, max_payload_size => 256, command => 1, ); sub new { my ($class, %args) = @_; $class->SUPER::new(%default, %args); } sub send { my ($self, $device_token, $payload, $extra) = @_; croak 'Usage: $apns->send($device_token, \%payload [, \%extra ])' unless defined $device_token && ref $payload eq 'HASH'; $extra ||= {}; $extra->{identifier} ||= 0; $extra->{expiry} ||= 0; my $data = $self->_create_send_data($device_token, $payload, $extra) || return 0; return $self->_send($data) ? 1 : 0; } sub send_multi { my ($self, $datum) = @_; croak 'Usage: $apns->send_multi(\@datum)' unless ref $datum eq 'ARRAY'; my $data; my $i = 0; for my $stuff (@$datum) { croak 'Net::APNs::Extended: send data must be ARRAYREF' unless ref $stuff eq 'ARRAY'; my ($device_token, $payload, $extra) = @$stuff; croak 'Net::APNs::Extended: send data require $device_token and \%payload' unless defined $device_token && ref $payload eq 'HASH'; $extra ||= {}; $extra->{identifier} ||= $i++; $extra->{expiry} ||= 0; $data .= $self->_create_send_data($device_token, $payload, $extra); } return $self->_send($data) ? 1 : 0; } sub retrive_error { my $self = shift; my $data = $self->_read || return; my ($command, $status, $identifier) = unpack 'C C L', $data; my $error = { command => $command, status => $status, identifier => $identifier, }; $self->disconnect; return $error; } sub _create_send_data { my ($self, $device_token, $payload, $extra) = @_; my $chunk; croak 'aps parameter must be HASHREF' unless ref $payload->{aps} eq 'HASH'; # numify $payload->{aps}{badge} += 0 if exists $payload->{aps}{badge}; # trim alert body my $json = $self->json->encode($payload); while (bytes::length($json) > $self->{max_payload_size}) { if (ref $payload->{aps}{alert} eq 'HASH' && exists $payload->{aps}{alert}{body}) { $payload->{aps}{alert}{body} = $self->_trim_alert_body($payload->{aps}{alert}{body}, $payload); } elsif (exists $payload->{aps}{alert}) { $payload->{aps}{alert} = $self->_trim_alert_body($payload->{aps}{alert}, $payload); } else { $self->_trim_alert_body(undef, $payload); } $json = $self->json->encode($payload); } my $command = $self->command; if ($command == 0) { $chunk = CORE::pack('C n/a* n/a*', $command, $device_token, $json); } elsif ($command == 1) { $chunk = CORE::pack('C L N n/a* n/a*', $command, $extra->{identifier}, $extra->{expiry}, $device_token, $json, ); } else { croak "command($command) not support. shuled be 0 or 1"; } return $chunk; } sub _trim_alert_body { my ($self, $body, $payload) = @_; if (!defined $body || length $body == 0) { my $json = $self->json->encode($payload); croak sprintf "over the payload size (current:%d > max:%d) : %s", bytes::length($json), $self->{max_payload_size}, $json; } substr($body, -1, 1) = ''; return $body; } 1; __END__ =encoding utf-8 =for stopwords =head1 NAME Net::APNs::Extended - Client library for APNs that support the extended format. =head1 SYNOPSIS use Net::APNs::Extended; my $apns = Net::APNs::Extended->new( is_sandbox => 1, cert_file => 'apns.pem', ); # send notification to APNs $apns->send($device_token, { aps => { alert => "Hello, APNs!", badge => 1, sound => "default", }, foo => [qw/bar baz/], }); # if you want to handle the error if (my $error = $apns->retrive_error) { die Dumper $error; } =head1 DESCRIPTION Net::APNs::Extended is client library for APNs. The client is support the extended format. =head1 METHODS =head2 new(%args) Create a new instance of C<< Net::APNs::Extended >>. Supported arguments are: =over =item is_sandbox : Bool Default: 1 =item cert_file : Str =item cert : Str Required. Sets certificate. You can not specify both C<< cert >> and C<< cert_file >>. =item key_file : Str =item key : Str Sets private key. You can not specify both C<< key >> and C<< key_file >>. =item password : Str Sets private key password. =item read_timeout : Num Sets read timeout. =back =head2 $apns->send($device_token, $payload [, $extra ]) Send notification for APNs. $apns->send($device_token, { apns => { alert => "Hello, APNs!", badge => 1, sound => "default", }, foo => [qw/bar baz/], }); =head2 $apns->send_multi([ [ $device_token, $payload [, $extra ] ], [ ... ] ... ]) Send notification for each data. The data chunk is same as C<< send() >> arguments. =head2 $apns->retrive_error() Gets error data from APNs. If there is no error will not return anything. if (my $error = $apns->retrive_error) { die Dumper $error; } =head1 AUTHOR xaicron Exaicron {at} cpan.orgE =head1 COPYRIGHT Copyright 2012 - xaicron =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO =cut