File Coverage

blib/lib/WebService/JugemKey/Auth.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package WebService::JugemKey::Auth;

use strict;
use warnings;
our $VERSION = '0.04';

use base qw (Class::Accessor::Fast Class::ErrorHandler);

use URI;
use LWP::UserAgent;
use Digest::HMAC;
use Digest::SHA1;
use DateTime;
use DateTime::Format::W3CDTF;
use Carp;
use XML::Atom::Entry;

__PACKAGE__->mk_accessors(qw(api_key secret perms));

my $jugemkey_url = 'https://secure.jugemkey.jp';
my $auth_api_url = 'http://api.jugemkey.jp/api/auth';

sub uri_to_login {
    my $self = shift;
    my %params = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
    my $uri = URI->new($jugemkey_url);

    my $callback_url = URI->new($params{callback_url});
    delete($params{callback_url});
    $callback_url->query_form( %params );

    my $request = {
        api_key      => $self->api_key,
        perms        => $self->perms,
        callback_url => $callback_url->as_string,
    };

    $uri->query_form(
        api_sig => $self->api_sig($request),
        mode    => 'auth_issue_frob',
        %$request,
    );
    return $uri;
}

sub api_sig {
    my ($self, $args) = @_;

    my $hmac = Digest::HMAC->new($self->secret, 'Digest::SHA1');
    for my $key (sort {$a cmp $b} keys %{$args}) {
        my $value = $args->{$key} ? $args->{$key} : '';
        $hmac->add($value);
    }
    return $hmac->hexdigest;
}

sub get_token {
    my $self = shift;
    my $frob = shift or croak "Invalid argumet (no frob)";

    my $created = DateTime::Format::W3CDTF->new->format_datetime(DateTime->now);
    my $sig = $self->api_sig({
        api_key => $self->api_key,
        created => $created,
        frob    => $frob,
    });

    my $req = HTTP::Request->new(GET => "$auth_api_url/token");
    $req->header('X-JUGEMKEY-API-KEY',     $self->api_key);
    $req->header('X-JUGEMKEY-API-FROB',    $frob);
    $req->header('X-JUGEMKEY-API-CREATED', $created);
    $req->header('X-JUGEMKEY-API-SIG',     $sig);

    my $res = $self->ua->request($req);
    return $self->error("Error on GET token: " . $self->_extract_error($res->content))
        unless $res->code == 200;

    my $entry = XML::Atom::Entry->new(Stream => \$res->content);

    my $pp = XML::Atom::Namespace->new( auth => 'http://paperboy.co.jp/atom/auth#' );
    return WebService::JugemKey::Auth::User->new({
        name  => $entry->title,
        token => $entry->get($pp, 'token'),
    });
}

sub get_user {
    my $self = shift;
    my $token = shift or croak "Invalid argument (no token)";

    my $created = DateTime::Format::W3CDTF->new->format_datetime(DateTime->now);
    my $sig = $self->api_sig({
        api_key => $self->api_key,
        created => $created,
        token   => $token,
    });

    my $req = HTTP::Request->new(GET => "$auth_api_url/user");
    $req->header('X-JUGEMKEY-API-KEY',     $self->api_key);
    $req->header('X-JUGEMKEY-API-TOKEN',   $token);
    $req->header('X-JUGEMKEY-API-CREATED', $created);
    $req->header('X-JUGEMKEY-API-SIG',     $sig);

    my $res = $self->ua->request($req);
    return $self->error("Error on GET user: " . $self->_extract_error($res->content))
        unless $res->code == 200;
    my $entry = XML::Atom::Entry->new(Stream => \$res->content);

    return WebService::JugemKey::Auth::User->new({
        name  => $entry->title,
    });
}

sub ua {
    my $self = shift;
    if (@_) {
        $self->{_ua} = shift;
    } else {
        $self->{_ua} and return $self->{_ua};
        $self->{_ua} = LWP::UserAgent->new;
        $self->{_ua}->agent(join '/', __PACKAGE__, __PACKAGE__->VERSION);
    }
    $self->{_ua};
}

sub _extract_error {
    my ($self, $error) = @_;

    while ($error =~ /([^<]*)<\/error>/g) {
        return $1;
    }
}

package WebService::JugemKey::Auth::User;
use base qw(Class::Accessor::Fast);

__PACKAGE__->mk_accessors(qw(name token));


1;
__END__