File Coverage

blib/lib/Net/APNs/Extended.pm
Criterion Covered Total %
statement 68 72 94.4
branch 25 30 83.3
condition 22 27 81.4
subroutine 12 12 100.0
pod 4 4 100.0
total 131 145 90.3


line stmt bran cond sub pod time code
1             package Net::APNs::Extended;
2              
3 7     7   532927 use strict;
  7         50  
  7         204  
4 7     7   36 use warnings;
  7         15  
  7         166  
5 7     7   164 use 5.008_001;
  7         23  
6             our $VERSION = '0.13';
7              
8 7     7   3044 use parent qw(Exporter Net::APNs::Extended::Base);
  7         2054  
  7         45  
9 7     7   377 use Carp qw(croak);
  7         16  
  7         445  
10              
11             use constant {
12 7         7091 NO_ERRORS => 0,
13             PROCESSING_ERROR => 1,
14             MISSING_DEVICE_TOKEN => 2,
15             MISSING_TOPIC => 3,
16             MISSING_PAYLOAD => 4,
17             INVALID_TOKEN_SIZE => 5,
18             INVALID_TOPIC_SIZE => 6,
19             INVALID_PAYLOAD_SIZE => 7,
20             INVALID_TOKEN => 8,
21             SHUTDOWN => 10,
22             UNKNOWN_ERROR => 255,
23 7     7   44 };
  7         14  
24              
25             our @EXPORT_OK = qw{
26             NO_ERRORS
27             PROCESSING_ERROR
28             MISSING_DEVICE_TOKEN
29             MISSING_TOPIC
30             MISSING_PAYLOAD
31             INVALID_TOKEN_SIZE
32             INVALID_TOPIC_SIZE
33             INVALID_PAYLOAD_SIZE
34             INVALID_TOKEN
35             SHUTDOWN
36             UNKNOWN_ERROR
37             };
38             our %EXPORT_TAGS = (constants => \@EXPORT_OK);
39              
40             __PACKAGE__->mk_accessors(qw[
41             max_payload_size
42             command
43             ]);
44              
45             my %default = (
46             host_production => 'gateway.push.apple.com',
47             host_sandbox => 'gateway.sandbox.push.apple.com',
48             is_sandbox => 0,
49             port => 2195,
50             max_payload_size => 256,
51             command => 1,
52             );
53              
54             sub new {
55 5     5 1 1439 my ($class, %args) = @_;
56 5         73 $class->SUPER::new(%default, %args);
57             }
58              
59             sub send {
60 4     4 1 9613 my ($self, $device_token, $payload, $extra) = @_;
61 4 100 100     317 croak 'Usage: $apns->send($device_token, \%payload [, \%extra ])'
62             unless defined $device_token && ref $payload eq 'HASH';
63              
64 2   100     9 $extra ||= {};
65 2   100     9 $extra->{identifier} ||= 0;
66 2   100     7 $extra->{expiry} ||= 0;
67 2   50     6 my $data = $self->_create_send_data($device_token, $payload, $extra) || return 0;
68 2 50       3908 return $self->_send($data) ? 1 : 0;
69             }
70              
71             sub send_multi {
72 5     5 1 14410 my ($self, $datum) = @_;
73 5 100       214 croak 'Usage: $apns->send_multi(\@datum)' unless ref $datum eq 'ARRAY';
74              
75 4         6 my $data;
76 4         8 my $i = 0;
77 4         9 for my $stuff (@$datum) {
78 6 100       183 croak 'Net::APNs::Extended: send data must be ARRAYREF' unless ref $stuff eq 'ARRAY';
79 5         11 my ($device_token, $payload, $extra) = @$stuff;
80 5 100 66     127 croak 'Net::APNs::Extended: send data require $device_token and \%payload'
81             unless defined $device_token && ref $payload eq 'HASH';
82 4   100     15 $extra ||= {};
83 4   100     16 $extra->{identifier} ||= $i++;
84 4   100     14 $extra->{expiry} ||= 0;
85 4         10 $data .= $self->_create_send_data($device_token, $payload, $extra);
86             }
87 2 50       53 return $self->_send($data) ? 1 : 0;
88             }
89              
90             sub retrieve_error {
91 3     3 1 7803 my $self = shift;
92 3         9 my $data = $self->_read;
93 3 100       60 return unless defined $data;
94              
95 2 100       8 if ($data eq '') { # connection closed
96 1         4 $self->disconnect;
97 1         15 return $data;
98             }
99              
100 1         7 my ($command, $status, $identifier) = unpack 'C C L', $data;
101 1         4 my $error = {
102             command => $command,
103             status => $status,
104             identifier => $identifier,
105             };
106              
107 1         13 $self->disconnect;
108 1         20 return $error;
109             }
110             *retrive_error = *retrieve_error;
111              
112             sub _create_send_data {
113 7     7   30633 my ($self, $device_token, $payload, $extra) = @_;
114 7         12 my $chunk;
115              
116 7 100       229 croak 'aps parameter must be HASHREF' unless ref $payload->{aps} eq 'HASH';
117              
118             # numify
119 6 100       25 $payload->{aps}{badge} += 0 if exists $payload->{aps}{badge};
120              
121             # trim alert body
122 6         25 my $json = $self->json->encode($payload);
123 6         126 while (bytes::length($json) > $self->{max_payload_size}) {
124 851 100 66     16380 if (ref $payload->{aps}{alert} eq 'HASH' && exists $payload->{aps}{alert}{body}) {
    50          
125 429         780 $payload->{aps}{alert}{body} = $self->_trim_alert_body($payload->{aps}{alert}{body}, $payload);
126             }
127             elsif (exists $payload->{aps}{alert}) {
128 422         791 $payload->{aps}{alert} = $self->_trim_alert_body($payload->{aps}{alert}, $payload);
129             }
130             else {
131 0         0 $self->_trim_alert_body(undef, $payload);
132             }
133 851         1727 $json = $self->json->encode($payload);
134             }
135              
136 6         969 my $command = $self->command;
137 6 100       37 if ($command == 0) {
    50          
138 1         6 $chunk = CORE::pack('C n/a* n/a*', $command, $device_token, $json);
139             }
140             elsif ($command == 1) {
141             $chunk = CORE::pack('C L N n/a* n/a*',
142 5         48 $command, $extra->{identifier}, $extra->{expiry}, $device_token, $json,
143             );
144             }
145             else {
146 0         0 croak "command($command) not support. shuled be 0 or 1";
147             }
148              
149 6         23 return $chunk;
150             }
151              
152             sub _trim_alert_body {
153 851     851   1659 my ($self, $body, $payload) = @_;
154 851 50 33     4009 if (!defined $body || length $body == 0) {
155 0         0 my $json = $self->json->encode($payload);
156             croak sprintf "over the payload size (current:%d > max:%d) : %s",
157 0         0 bytes::length($json), $self->{max_payload_size}, $json;
158             }
159 851         2232 substr($body, -1, 1) = '';
160 851         1916 return $body;
161             }
162              
163             1;
164             __END__