File Coverage

blib/lib/PlugAuth/Client/Tiny.pm
Criterion Covered Total %
statement 42 48 87.5
branch 12 14 85.7
condition 4 5 80.0
subroutine 9 10 90.0
pod 5 5 100.0
total 72 82 87.8


line stmt bran cond sub pod time code
1             package PlugAuth::Client::Tiny;
2              
3 10     10   94253 use strict;
  10         24  
  10         277  
4 10     10   52 use warnings;
  10         18  
  10         285  
5 10     10   259 use 5.006;
  10         34  
6 10     10   5632 use HTTP::Tiny;
  10         284402  
  10         2362  
7              
8             # ABSTRACT: Minimal PlugAuth client
9             our $VERSION = '0.02'; # VERSION
10              
11              
12             sub new
13             {
14 8     8 1 178 my $class = shift;
15 8 100       49 my %args = ref $_[0] ? %{$_[0]} : @_;
  1         6  
16 8   100     54 my $url = (delete $args{url}) || 'http://localhost:3000/';
17 8         45 $url =~ s{/?$}{/};
18 8         69 return bless {
19             url => $url,
20             http => HTTP::Tiny->new(%args),
21             }, $class;
22             }
23              
24              
25 3     3 1 1787 sub url { shift->{url} }
26              
27              
28             sub auth
29             {
30 3     3 1 22 my($self, $user, $password) = @_;
31            
32             my $response = $self->{http}->get($self->{url} . 'auth', {
33             headers => {
34             ## TODO option for setting the realm
35             # WWW-Authenticate: Basic realm="..."
36 3         14 Authorization => 'Basic ' . do {
37             ## TODO maybe use MIME::Base64 if available?
38             ## it is XS, but may be faster.
39 10     10   7866 use integer;
  10         103  
  10         54  
40 3         8 my $a = join(':', $user,$password);
41 3         22 my $r = pack('u', $a);
42 3         13 $r =~ s/^.//mg;
43 3         9 $r =~ s/\n//g;
44 3         10 $r =~ tr|` -_|AA-Za-z0-9+/|;
45 3         7 my $p = (3-length($a)%3)%3;
46 3 100       22 $r =~ s/.{$p}$/'=' x $p/e if $p;
  1         4  
47 3         22 $r;
48             },
49             }
50             });
51            
52 3 100       101 return 1 if $response->{status} == 200;
53             return 0 if $response->{status} == 403
54 2 100 66     16 || $response->{status} == 401;
55            
56 1         10 die $response->{content};
57             }
58              
59              
60             sub authz
61             {
62 4     4 1 31 my($self, $user, $action, $resource) = @_;
63            
64 4         17 $resource =~ s{^/?}{};
65 4         23 my $url = $self->{url} . join('/', 'authz', 'user', $user, $action, $resource);
66 4         17 my $response = $self->{http}->get($url);
67            
68 4 100       52 return 1 if $response->{status} == 200;
69 2 100       17 return 0 if $response->{status} == 403;
70 1         10 die $response->{content};
71             }
72              
73              
74             sub version
75             {
76 0     0 1   my($self) = @_;
77            
78 0           my $url = $self->{url} . 'version';
79 0           my $response = $self->{http}->get($url);
80            
81 0 0         return unless $response->{status} == 200;
82            
83             # JSON::PP is in core as of 5.14
84 0           require JSON::PP;
85 0           JSON::PP::decode_json($response->{content})->[0];
86             }
87              
88             1;
89              
90             __END__