File Coverage

blib/lib/WWW/Live/Auth/ConsentToken.pm
Criterion Covered Total %
statement 12 68 17.6
branch 0 16 0.0
condition 0 24 0.0
subroutine 4 14 28.5
pod 0 9 0.0
total 16 131 12.2


line stmt bran cond sub pod time code
1             package WWW::Live::Auth::ConsentToken;
2              
3 1     1   6 use strict;
  1         3  
  1         96  
4 1     1   7 use warnings;
  1         2  
  1         47  
5              
6 1     1   7 use WWW::Live::Auth::Utils;
  1         2  
  1         105  
7 1     1   7 use Carp;
  1         2  
  1         1199  
8              
9             require WWW::Live::Auth::SecretKey;
10             require WWW::Live::Auth::Offer;
11             require Math::BigInt;
12              
13             sub new {
14 0     0 0   my ( $proto, %args ) = @_;
15 0   0       my $class = ref $proto || $proto;
16            
17             my $self = bless {
18 0           'string' => $args{'consent_token'},
19             }, $class;
20            
21 0           $self->_process( $args{'secret_key'} );
22            
23 0           return $self;
24             }
25              
26             sub as_string {
27 0     0 0   my $self = shift;
28 0           return $self->{'string'};
29             }
30              
31             sub delegation_token {
32 0     0 0   my $self = shift;
33 0           return $self->{'delegation_token'};
34             }
35              
36             sub refresh_token {
37 0     0 0   my $self = shift;
38 0           return $self->{'refresh_token'};
39             }
40              
41             sub session_key {
42 0     0 0   my $self = shift;
43 0           return $self->{'session_key'};
44             }
45              
46             sub location_id {
47 0     0 0   my $self = shift;
48 0           return $self->{'location_id'};
49             }
50              
51             sub int_location_id {
52 0     0 0   my $self = shift;
53 0           my $num = Math::BigInt->new('0x'.$self->{'location_id'});
54 0           my ($base2) = $num->as_bin() =~ /^0b(\d+)/;
55 0           warn "BASE2: $base2";
56            
57 0 0 0       if ( length($base2) == 64 && substr($base2, 0, 1) eq '1' ) {
58 0           $base2 =~ tr/01/10/;
59 0           my @chars = split //, $base2;
60 0           for (my $i=63; $i>0; $i--) {
61 0           $chars[$i] =~ tr/01/10/;
62 0 0         if ($chars[$i] eq '1') {
63 0           last;
64             }
65             }
66 0           $base2 = join '', @chars;
67 0           return '-' . Math::BigInt->new("0b$base2")->bstr;
68             } else {
69 0           return $num->bstr;
70             }
71             }
72              
73             sub offers {
74 0     0 0   my $self = shift;
75 0 0         return wantarray ? @{ $self->{'offers'} || [] } : $self->{'offers'};
  0 0          
76             }
77              
78             sub expires {
79 0     0 0   my $self = shift;
80 0           return $self->{'expires'};
81             }
82              
83             sub _process {
84 0     0     my ( $self, $secret_key ) = @_;
85            
86 0 0         $secret_key || croak('Secret key is required');
87 0   0       my $consent_token = $self->{'string'} || croak('Consent token is required');
88            
89 0 0         if ( !ref $secret_key ) {
90 0           $secret_key = WWW::Live::Auth::SecretKey->new( $secret_key );
91             }
92            
93 0           $consent_token = _unescape( $consent_token );
94 0           $consent_token = _split( $consent_token );
95            
96 0 0         if ( $consent_token->{'eact'} ) {
97 0           $consent_token = _unescape( $consent_token->{'eact'} );
98 0           $consent_token = _decode ( $consent_token );
99 0           $consent_token = _decrypt ( $consent_token, $secret_key->encryption_key );
100 0           $consent_token = _validate( $consent_token, $secret_key->signature_key );
101 0           $consent_token = _split ( $consent_token );
102             }
103            
104             my @offers = map {
105 0           WWW::Live::Auth::Offer->new( 'offer' => $_ )
106 0           } split /;/, $consent_token->{'offer'};
107            
108 0 0         scalar @offers || croak('Consent token contains no offers');
109            
110 0   0       $self->{'delegation_token'} = $consent_token->{'delt'} || croak('Consent token contains no delegation token');
111 0   0       $self->{'refresh_token'} = $consent_token->{'reft'} || croak('Consent token contains no refresh token');
112 0   0       $self->{'session_key'} = $consent_token->{'skey'} || croak('Consent token contains no session key');
113 0   0       $self->{'expires'} = $consent_token->{'exp'} || croak('Consent token contains no expiry time');
114 0   0       $self->{'location_id'} = $consent_token->{'lid'} || croak('Consent token contains no location ID');
115 0           $self->{'offers'} = \@offers;
116             }
117              
118             1;
119             __END__