| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Web::MarketReceipt::Verifier::Mock::AppStore; | 
| 2 | 1 |  |  | 1 |  | 74417 | use Mouse; | 
|  | 1 |  |  |  |  | 31286 |  | 
|  | 1 |  |  |  |  | 6 |  | 
| 3 | 1 |  |  | 1 |  | 1218 | use utf8; | 
|  | 1 |  |  |  |  | 16 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | extends 'Web::MarketReceipt::Verifier'; | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 1 |  |  | 1 |  | 509 | use Web::MarketReceipt; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 41 |  | 
| 8 | 1 |  |  | 1 |  | 7 | use MIME::Base64 qw/decode_base64/; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 158 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | has verifier => ( | 
| 11 |  |  |  |  |  |  | is      => 'ro', | 
| 12 |  |  |  |  |  |  | isa     => 'CodeRef', | 
| 13 |  |  |  |  |  |  | default => sub { | 
| 14 |  |  |  |  |  |  | my $self = shift; | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | return sub { $self->_default_verifier(@_) }; | 
| 17 |  |  |  |  |  |  | }, | 
| 18 |  |  |  |  |  |  | lazy    => 1, | 
| 19 |  |  |  |  |  |  | ); | 
| 20 |  |  |  |  |  |  |  | 
| 21 | 1 |  |  | 1 |  | 10 | no Mouse; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 6 |  | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | sub _default_verifier { | 
| 24 | 1 |  |  | 1 |  | 5 | my ($self, %args) = @_; | 
| 25 |  |  |  |  |  |  |  | 
| 26 | 1 |  |  |  |  | 3 | my $receipt = $args{receipt}; | 
| 27 |  |  |  |  |  |  |  | 
| 28 | 1 |  |  |  |  | 4 | my $parsed = $self->_parse_receipt($receipt); | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 1 |  |  |  |  | 2 | my $purchase_info = $parsed->{'purchase-info'}; | 
| 31 |  |  |  |  |  |  | my %underscored = ( | 
| 32 |  |  |  |  |  |  | map { | 
| 33 | 1 |  |  |  |  | 14 | my $key = $_; | 
|  | 14 |  |  |  |  | 19 |  | 
| 34 | 14 |  |  |  |  | 35 | $key =~ s/-/_/g; | 
| 35 | 14 |  |  |  |  | 38 | $key => $purchase_info->{$_} | 
| 36 |  |  |  |  |  |  | } keys %$purchase_info | 
| 37 |  |  |  |  |  |  | ); | 
| 38 |  |  |  |  |  |  | my $environment = exists $parsed->{environment} ? | 
| 39 | 1 | 50 |  |  |  | 7 | $parsed->{environment} : 'Production'; | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | my $result = Web::MarketReceipt->new( | 
| 42 |  |  |  |  |  |  | is_success => 1, | 
| 43 |  |  |  |  |  |  | store      => 'AppStore', | 
| 44 |  |  |  |  |  |  | raw        => \%underscored, | 
| 45 |  |  |  |  |  |  | orders     => [ | 
| 46 |  |  |  |  |  |  | { | 
| 47 |  |  |  |  |  |  | product_identifier => $underscored{product_id}, | 
| 48 |  |  |  |  |  |  | unique_identifier  => 'AppStore:' . $underscored{original_transaction_id}, | 
| 49 |  |  |  |  |  |  | purchased_epoch    => $underscored{original_purchase_date_ms}, | 
| 50 |  |  |  |  |  |  | quantity           => $underscored{quantity}, | 
| 51 | 1 |  |  |  |  | 25 | environment        => $environment, | 
| 52 |  |  |  |  |  |  | state              => 'purchased', | 
| 53 |  |  |  |  |  |  | } | 
| 54 |  |  |  |  |  |  | ], | 
| 55 |  |  |  |  |  |  | ); | 
| 56 |  |  |  |  |  |  |  | 
| 57 | 1 |  |  |  |  | 118 | return $result; | 
| 58 |  |  |  |  |  |  | } | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | sub verify { | 
| 61 | 1 |  |  | 1 | 0 | 1287 | my $self = shift; | 
| 62 |  |  |  |  |  |  |  | 
| 63 | 1 |  |  |  |  | 11 | return $self->verifier->(@_); | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub _parse_receipt { | 
| 67 | 1 |  |  | 1 |  | 3 | my ($class, $receipt) = @_; | 
| 68 |  |  |  |  |  |  |  | 
| 69 | 1 |  |  |  |  | 3 | my $data = $class->_parse_oldstlye_plist($receipt); | 
| 70 | 1 |  |  |  |  | 4 | my $purchase_info = $class->_parse_oldstlye_plist($data->{'purchase-info'}); | 
| 71 | 1 |  |  |  |  | 15 | $data->{'purchase-info'} = $purchase_info; | 
| 72 |  |  |  |  |  |  |  | 
| 73 | 1 |  |  |  |  | 4 | return $data; | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | # XXX: This parser is poor but I look work with a receipt from appstore. | 
| 77 |  |  |  |  |  |  | # If that do not parse at your receipt, please report issues or pull requests. | 
| 78 |  |  |  |  |  |  | sub _parse_oldstlye_plist { | 
| 79 | 2 |  |  | 2 |  | 6 | my ($class, $text) = @_; | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 2 |  |  |  |  | 13 | my $data = decode_base64($text); | 
| 82 | 2 |  |  |  |  | 12 | my ($properties_str) = $data =~ /{(.*)}/s; | 
| 83 | 2 |  |  |  |  | 42 | my %kv = $properties_str =~ /\s*"(.*?)"\s*=\s*"(.*?)"\s*;/msg; | 
| 84 |  |  |  |  |  |  |  | 
| 85 | 2 |  |  |  |  | 6 | return \%kv; | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | 1; | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | __END__ |