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 E<lt>xaicron {at} cpan.orgE<gt>

=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

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.