File Coverage

blib/lib/Microsoft/Azure/AccessToken.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Microsoft::Azure::AccessToken;
2              
3 1     1   34962 use 5.006;
  1         4  
  1         69  
4 1     1   7 use strict;
  1         2  
  1         51  
5 1     1   6 use warnings FATAL => 'all';
  1         7  
  1         63  
6              
7 1     1   1219 use LWP::UserAgent;
  1         55484  
  1         40  
8 1     1   580 use URL::Encode 'url_encode';
  0            
  0            
9             use Data::Dumper;
10             use JSON;
11              
12             =head1 NAME
13              
14             Microsoft::Azure::AccessToken - Microsoft Azure Access Token implementation
15              
16             =head1 VERSION
17              
18             Version 0.01
19              
20             =cut
21              
22             our $VERSION = '0.01';
23              
24             use constant TOKENAUTH_URL => 'https://datamarket.accesscontrol.windows.net/v2/OAuth2-13';
25              
26              
27             =head1 SYNOPSIS
28              
29             Require AccessToken from Microsoft Azure Marketplace to use MS API.
30             L
31              
32             use Microsoft::Azure::AccessToken;
33              
34             my $maa = Microsoft::Azure::AccessToken->new("client_id", "client_secret", scope => "http://somemsscope.com");
35             my $token = $foo->get_token();
36              
37             =head1 SUBROUTINES/METHODS
38              
39             =head2 token
40              
41             =cut
42              
43             sub new {
44             my ($pkg, $client_id, $client_secret, %options) = @_;
45              
46              
47             return bless {
48             client_id => url_encode($client_id),
49             client_secret => url_encode($client_secret),
50             scope => $options{scope},
51             token => undef,
52             expires => 0
53             }, $pkg;
54             }
55              
56             sub token {
57             my $self = shift;
58              
59             if ( $self->{expires} > time and defined $self->{token} ) {
60             return $self->{token};
61             }
62              
63             my $ua = LWP::UserAgent->new;
64              
65             my $content = join( '&',
66             'grant_type=client_credentials',
67             'client_id=' . $self->{client_id},
68             'client_secret=' . $self->{client_secret},
69             'scope=' . $self->{scope}
70             );
71              
72             my $response = $ua->post(TOKENAUTH_URL, "Content-Type" => "application/x-www-form-urlencoded", Content => $content);
73              
74             if ( $response->is_success ) {
75             my $resturn = undef;
76              
77             my $content = $response->decoded_content;
78             my $js = eval { decode_json( $content ) };
79              
80             if ( $@ ) {
81             print STDERR "Unable to parse response\n";
82             return undef;
83             }
84              
85             my $expires = $js->{expires_in};
86             my $token = $js->{access_token};
87              
88             $self->{expires} = time() + $expires;
89             $self->{token} = $token;
90             return $token;
91             } else {
92             print STDERR $response->status_line;
93             return undef;
94             }
95             }
96              
97             =head1 AUTHOR
98              
99             Dalibor Horinek, C<< >>
100              
101             =head1 BUGS
102              
103             Please report any bugs or feature requests to C, or through
104             the web interface at L. I will be notified, and then you'll
105             automatically be notified of progress on your bug as I make changes.
106              
107              
108              
109              
110             =head1 SUPPORT
111              
112             You can find documentation for this module with the perldoc command.
113              
114             perldoc Microsoft::Azure::AccessToken
115              
116              
117             You can also look for information at:
118              
119             =over 4
120              
121             =item * RT: CPAN's request tracker (report bugs here)
122              
123             L
124              
125             =item * AnnoCPAN: Annotated CPAN documentation
126              
127             L
128              
129             =item * CPAN Ratings
130              
131             L
132              
133             =item * Search CPAN
134              
135             L
136              
137             =back
138              
139              
140             =head1 ACKNOWLEDGEMENTS
141              
142              
143             =head1 LICENSE AND COPYRIGHT
144              
145             Copyright 2013 Dalibor Horinek.
146              
147             This program is free software; you can redistribute it and/or modify it
148             under the terms of the the Artistic License (2.0). You may obtain a
149             copy of the full license at:
150              
151             L
152              
153             Any use, modification, and distribution of the Standard or Modified
154             Versions is governed by this Artistic License. By using, modifying or
155             distributing the Package, you accept this license. Do not use, modify,
156             or distribute the Package, if you do not accept this license.
157              
158             If your Modified Version has been derived from a Modified Version made
159             by someone other than you, you are nevertheless required to ensure that
160             your Modified Version complies with the requirements of this license.
161              
162             This license does not grant you the right to use any trademark, service
163             mark, tradename, or logo of the Copyright Holder.
164              
165             This license includes the non-exclusive, worldwide, free-of-charge
166             patent license to make, have made, use, offer to sell, sell, import and
167             otherwise transfer the Package with respect to any patent claims
168             licensable by the Copyright Holder that are necessarily infringed by the
169             Package. If you institute patent litigation (including a cross-claim or
170             counterclaim) against any party alleging that the Package constitutes
171             direct or contributory patent infringement, then this Artistic License
172             to you shall terminate on the date that such litigation is filed.
173              
174             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
175             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
176             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
177             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
178             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
179             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
180             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
181             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
182              
183              
184             =cut
185              
186             1; # End of Microsoft::Azure::AccessToken