File Coverage

blib/lib/Net/Azure/Authorization/SAS.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	6	6	100.0
condition	1	3	33.3
subroutine	13	13	100.0
pod	2	2	100.0
total	73	75	97.3

package Net::Azure::Authorization::SAS;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.03";
our $DEFAULT_TOKEN_EXPIRE = 3600;

use Carp;
use URI;
use URI::Escape 'uri_escape';
use Digest::SHA 'hmac_sha256';
use MIME::Base64 'encode_base64';
use String::CamelCase 'decamelize';
use Class::Accessor::Lite (
    new => 0,
    ro  => [qw[
        connection_string
        endpoint
        shared_access_key_name
        shared_access_key
        entity_path
        expire
    ]],
);

sub new {
    my ($class, %param) = @_;
    $param{expire}  ||= $DEFAULT_TOKEN_EXPIRE;
    if (defined($param{connection_string})) {
        %param = (%param, $class->_parse_connection_string($param{connection_string}));
    }
    for my $key (qw(endpoint shared_access_key_name shared_access_key)) {
        if (!defined($param{$key})) {
            croak "$key was not specified. Please specify $key or connection_string.";
        }
    }
    bless {%param}, $class;
}

sub _parse_connection_string {
    my ($class, $string) = @_;
    my %parsed = (map {split '=', $_, 2} split(';', $string));
    ( map {(decamelize($_) => $parsed{$_})} keys %parsed );
}

sub token {
    my ($self, $url) = @_;
    croak 'An url for token is required' if !defined $url;
    my $uri         = URI->new($url);
    my $target_uri  = lc(uri_escape(lc(sprintf("%s://%s%s", $uri->scheme, $uri->host, $uri->path))));
    my $expire_time = time + $self->expire;
    my $to_sign     = "$target_uri\n$expire_time";
    my $signature   = encode_base64(hmac_sha256($to_sign, $self->shared_access_key));
    chomp $signature;
    sprintf 'SharedAccessSignature sr=%s&sig=%s&se=%s&skn=%s', $target_uri, uri_escape($signature), $expire_time, $self->shared_access_key_name;
}

1;
__END__