| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Web::MarketReceipt::Verifier::AppStore; | 
| 2 | 2 |  |  | 2 |  | 112895 | use 5.010; | 
|  | 2 |  |  |  |  | 10 |  | 
| 3 | 2 |  |  | 2 |  | 551 | use Mouse; | 
|  | 2 |  |  |  |  | 32506 |  | 
|  | 2 |  |  |  |  | 13 |  | 
| 4 |  |  |  |  |  |  | extends 'Web::MarketReceipt::Verifier'; | 
| 5 | 2 |  |  | 2 |  | 1836 | use utf8; | 
|  | 2 |  |  |  |  | 20 |  | 
|  | 2 |  |  |  |  | 12 |  | 
| 6 | 2 |  |  | 2 |  | 59 | use Carp; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 160 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 2 |  |  | 2 |  | 14 | no Mouse; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 10 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 2 |  |  | 2 |  | 766 | use Web::MarketReceipt; | 
|  | 2 |  |  |  |  | 6 |  | 
|  | 2 |  |  |  |  | 132 |  | 
| 11 | 2 |  |  | 2 |  | 1184 | use Furl; | 
|  | 2 |  |  |  |  | 51027 |  | 
|  | 2 |  |  |  |  | 70 |  | 
| 12 | 2 |  |  | 2 |  | 1543 | use JSON::XS; | 
|  | 2 |  |  |  |  | 8314 |  | 
|  | 2 |  |  |  |  | 118 |  | 
| 13 | 2 |  |  | 2 |  | 499 | use Try::Tiny; | 
|  | 2 |  |  |  |  | 2054 |  | 
|  | 2 |  |  |  |  | 120 |  | 
| 14 | 2 |  |  | 2 |  | 917 | use MIME::Base64; | 
|  | 2 |  |  |  |  | 3247 |  | 
|  | 2 |  |  |  |  | 1216 |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | sub verify { | 
| 17 | 2 |  |  | 2 | 0 | 6670 | my ($self, %args) = @_; | 
| 18 |  |  |  |  |  |  |  | 
| 19 | 2 |  |  |  |  | 5 | my $environment = 'Production'; | 
| 20 | 2 |  |  |  |  | 4 | my $receipt = $args{receipt}; | 
| 21 | 2 |  |  |  |  | 5 | my $password = $args{password}; | 
| 22 | 2 |  |  |  |  | 3 | my $exclude_old_transactions = $args{exclude_old_transactions}; | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 2 |  |  |  |  | 7 | my $hash = { | 
| 25 |  |  |  |  |  |  | 'receipt-data' => $receipt, | 
| 26 |  |  |  |  |  |  | }; | 
| 27 | 2 | 50 |  |  |  | 6 | if ($password) { | 
| 28 | 0 |  |  |  |  | 0 | $hash->{password} = $password; | 
| 29 |  |  |  |  |  |  | } | 
| 30 | 2 | 50 |  |  |  | 6 | if ($exclude_old_transactions) { | 
| 31 | 0 |  |  |  |  | 0 | $hash->{'exclude-old-transactions'} = \1; | 
| 32 |  |  |  |  |  |  | } | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | # try production environment first. cf. | 
| 35 |  |  |  |  |  |  | #   https://developer.apple.com/library/ios/technotes/tn2259/_index.html FAQ16 | 
| 36 |  |  |  |  |  |  | #   http://nantekottai.com/2012/08/27/verifying-receipts/ | 
| 37 |  |  |  |  |  |  | my $res_json = $self->_send_request( | 
| 38 |  |  |  |  |  |  | environment => $environment, | 
| 39 |  |  |  |  |  |  | hash        => $hash, | 
| 40 |  |  |  |  |  |  | opts        => $args{opts}, | 
| 41 | 2 |  |  |  |  | 9 | ); | 
| 42 |  |  |  |  |  |  |  | 
| 43 | 2 | 50 |  |  |  | 53 | if ($res_json->{status} == 21007) { | 
| 44 | 0 |  |  |  |  | 0 | $environment = 'Sandbox'; | 
| 45 | 0 |  |  |  |  | 0 | $res_json = $self->_send_request( | 
| 46 |  |  |  |  |  |  | environment => $environment, | 
| 47 |  |  |  |  |  |  | hash        => $hash, | 
| 48 |  |  |  |  |  |  | ); | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 | 2 |  |  |  |  | 6 | my $raw_json = $res_json->{receipt}; | 
| 52 |  |  |  |  |  |  | Web::MarketReceipt->new( | 
| 53 |  |  |  |  |  |  | is_success => $res_json->{status} == 0 ? 1 : 0, | 
| 54 |  |  |  |  |  |  | store      => 'AppStore', | 
| 55 |  |  |  |  |  |  | raw        => $raw_json, | 
| 56 |  |  |  |  |  |  | $res_json->{status} == 0 ? ( | 
| 57 |  |  |  |  |  |  | exists $raw_json->{in_app} ? ( | 
| 58 | 2 | 50 |  |  |  | 13 | orders => [ map {$self->_order2hash($_, $environment)} @{ $raw_json->{in_app}}], | 
|  | 2 | 100 |  |  |  | 6 |  | 
|  | 1 | 50 |  |  |  | 3 |  | 
| 59 |  |  |  |  |  |  | ) : ( | 
| 60 |  |  |  |  |  |  | orders => [$self->_order2hash($raw_json, $environment)], | 
| 61 |  |  |  |  |  |  | ), | 
| 62 |  |  |  |  |  |  | ) : (), | 
| 63 |  |  |  |  |  |  | ); | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub _order2hash { | 
| 67 | 3 |  |  | 3 |  | 8 | my ($self, $raw_json, $environment) = @_; | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | return { | 
| 70 |  |  |  |  |  |  | product_identifier => $raw_json->{product_id}, | 
| 71 |  |  |  |  |  |  | unique_identifier  => 'AppStore:' . $raw_json->{original_transaction_id}, | 
| 72 |  |  |  |  |  |  | purchased_epoch    => $raw_json->{original_purchase_date_ms}, | 
| 73 |  |  |  |  |  |  | quantity    => $raw_json->{quantity}, | 
| 74 | 3 |  |  |  |  | 52 | environment => $environment, | 
| 75 |  |  |  |  |  |  | state       => 'purchased', | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub _send_request { | 
| 80 | 0 |  |  | 0 |  |  | my ($self, %args) = @_; | 
| 81 |  |  |  |  |  |  |  | 
| 82 | 0 |  |  |  |  |  | my $environment = $args{environment}; | 
| 83 |  |  |  |  |  |  | my $url = { | 
| 84 |  |  |  |  |  |  | Production => 'https://buy.itunes.apple.com/verifyReceipt', | 
| 85 |  |  |  |  |  |  | Sandbox    => 'https://sandbox.itunes.apple.com/verifyReceipt', | 
| 86 | 0 |  |  |  |  |  | }->{$environment}; | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 0 |  |  |  |  |  | state $json_driver = JSON::XS->new->utf8; | 
| 89 | 0 |  |  |  |  |  | my $json_str = $json_driver->encode($args{hash}); | 
| 90 |  |  |  |  |  |  |  | 
| 91 | 0 |  |  |  |  |  | state $furl = Furl->new(%{ $args{opts} }); | 
|  | 0 |  |  |  |  |  |  | 
| 92 | 0 |  |  |  |  |  | my $res = $furl->post($url, [], $json_str); | 
| 93 |  |  |  |  |  |  |  | 
| 94 | 0 | 0 |  |  |  |  | if ($res->status != 200) { | 
| 95 | 0 |  |  |  |  |  | Web::MarketReceipt::Verifier::AppStore::Exception->throw( | 
| 96 |  |  |  |  |  |  | message     => sprintf('HTTP Status Error(%s):%s %s', $environment, $res->status, $res->message), | 
| 97 |  |  |  |  |  |  | response    => $res, | 
| 98 |  |  |  |  |  |  | environment => $environment, | 
| 99 |  |  |  |  |  |  | ); | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  |  | 
| 102 | 0 | 0 |  |  |  |  | my $res_json = eval { $json_driver->decode($res->body) } or Web::MarketReceipt::Verifier::AppStore::Exception->throw( | 
|  | 0 |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | message     => sprintf('body is not json(%s)', $environment), | 
| 104 |  |  |  |  |  |  | response    => $res, | 
| 105 |  |  |  |  |  |  | environment => $environment, | 
| 106 |  |  |  |  |  |  | ); | 
| 107 | 0 |  |  |  |  |  | $res_json; | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | package Web::MarketReceipt::Verifier::AppStore::Exception; | 
| 111 | 2 |  |  | 2 |  | 17 | use strict; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 53 |  | 
| 112 | 2 |  |  | 2 |  | 12 | use warnings; | 
|  | 2 |  |  |  |  | 15 |  | 
|  | 2 |  |  |  |  | 83 |  | 
| 113 | 2 |  |  | 2 |  | 14 | use utf8; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 18 |  | 
| 114 |  |  |  |  |  |  |  | 
| 115 | 2 |  |  | 2 |  | 515 | use parent 'Exception::Tiny'; | 
|  | 2 |  |  |  |  | 324 |  | 
|  | 2 |  |  |  |  | 23 |  | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | use Class::Accessor::Lite ( | 
| 118 | 2 |  |  |  |  | 13 | ro  => [qw/response environment/] | 
| 119 | 2 |  |  | 2 |  | 17731 | ); | 
|  | 2 |  |  |  |  | 4 |  | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | sub throw { | 
| 122 | 0 |  |  | 0 |  |  | my ($class, %args) = @_; | 
| 123 |  |  |  |  |  |  |  | 
| 124 | 0 |  |  |  |  |  | ($args{package}, $args{file}, $args{line}) = caller(2); | 
| 125 | 0 |  |  |  |  |  | $args{subroutine} = (caller(3))[3]; | 
| 126 |  |  |  |  |  |  |  | 
| 127 | 0 |  |  |  |  |  | die $class->new(%args); | 
| 128 |  |  |  |  |  |  | } | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | 1; |