File Coverage

blib/lib/Authen/OATH/KeyURI.pm
Criterion Covered Total %
statement 45 46 97.8
branch 13 14 92.8
condition 6 6 100.0
subroutine 11 11 100.0
pod 1 3 33.3
total 76 80 95.0


line stmt bran cond sub pod time code
1             package Authen::OATH::KeyURI;
2 2     2   1550 use 5.008001;
  2         7  
  2         77  
3 2     2   11 use strict;
  2         4  
  2         68  
4 2     2   22 use warnings;
  2         4  
  2         96  
5              
6             our $VERSION = "0.01";
7              
8 2     2   9 use base 'Class::Accessor::Fast';
  2         5  
  2         1911  
9 2     2   9658 use Params::Validate qw(SCALAR);
  2         22591  
  2         159  
10 2     2   1870 use URI;
  2         14174  
  2         78  
11 2     2   1856 use Convert::Base32 qw(encode_base32);
  2         3789  
  2         1150  
12              
13             __PACKAGE__->mk_accessors(qw(
14             scheme
15             type
16             accountname
17             secret
18             issuer
19             algorithm
20             digits
21             counter
22             period
23             uri
24             ));
25              
26             sub new {
27 6     6 1 7873 my $class = shift;
28 6 50       37 my @args = @_ == 1 ? %{$_[0]} : @_;
  0         0  
29 6         429 my %params = Params::Validate::validate_with(
30             params => \@args,
31             spec => {
32             scheme => {
33             type => SCALAR,
34             default => q{otpauth},
35             optional => 1,
36             },
37             type => {
38             type => SCALAR,
39             default => q{totp},
40             optional => 1,
41             },
42             accountname => {
43             type => SCALAR,
44             },
45             secret => {
46             type => SCALAR,
47             },
48             issuer => {
49             type => SCALAR,
50             optional => 1,
51             },
52             algorithm => {
53             type => SCALAR,
54             optional => 1,
55             },
56             digits => {
57             type => SCALAR,
58             optional => 1,
59             },
60             counter => {
61             type => SCALAR,
62             optional => 1,
63             },
64             period => {
65             type => SCALAR,
66             optional => 1,
67             },
68             },
69             allow_extra => 0,
70             );
71              
72 6         77 my $self = bless \%params, $class;
73              
74             # TODO: more varidation
75            
76 6         26 return $self;
77             }
78              
79             sub as_string {
80 20     20 0 6482 my $self = shift;
81 20         47 $self->_generate_uri();
82 20         172 return $self->uri->as_string;
83             }
84              
85             sub as_uri {
86 4     4 0 1720 my $self = shift;
87 4         13 $self->_generate_uri();
88 4         32 return $self->uri;
89             }
90              
91             sub _generate_uri {
92 24     24   34 my $self = shift;
93              
94             # 1. Scheme
95 24         101 my $uri = URI->new;
96 24         6177 $uri->scheme($self->scheme);
97              
98             # 2. Type and Label
99 24 100       22589 my $label =
100             ($self->issuer) ?
101             $self->issuer . q{:} . $self->accountname :
102             $self->accountname;
103 24         279 $uri->path(q{//} . $self->type . q{/} . $label);
104              
105             # 3. Parameters
106 24         847 my $params = {
107             secret => encode_base32($self->secret),
108             };
109 24 100       1976 $params->{issuer} = $self->issuer if $self->issuer;
110 24 100       173 $params->{algorithm } = $self->algorithm if $self->algorithm ;
111 24 100       223 $params->{digits} = $self->digits if $self->digits;
112              
113             # hotp only
114 24 100 100     196 $params->{counter} = $self->counter
115             if ($self->counter && $self->type eq q{hotp});
116             # totp only
117 24 100 100     245 $params->{period} = $self->period
118             if ($self->period && $self->type eq q{totp});
119              
120 24         261 $uri->query_form($params);
121              
122 24         1906 $self->uri($uri);
123             }
124              
125             1;
126             __END__