File Coverage

blib/lib/WWW/ORCID/MemberAPI.pm
Criterion Covered Total %
statement 15 54 27.7
branch 0 16 0.0
condition 0 6 0.0
subroutine 5 9 55.5
pod 0 3 0.0
total 20 88 22.7


line stmt bran cond sub pod time code
1             package WWW::ORCID::MemberAPI;
2              
3 2     2   77689 use strict;
  2         13  
  2         63  
4 2     2   11 use warnings;
  2         3  
  2         82  
5              
6             our $VERSION = 0.0402;
7              
8 2     2   465 use Moo::Role;
  2         16731  
  2         10  
9 2     2   1946 use JSON qw(decode_json encode_json);
  2         22608  
  2         11  
10 2     2   823 use namespace::clean;
  2         10760  
  2         14  
11              
12             with 'WWW::ORCID::API';
13              
14             has read_limited_token => (is => 'lazy');
15              
16             sub _build_read_limited_token {
17 0     0     $_[0]->access_token(
18             grant_type => 'client_credentials',
19             scope => '/read-limited'
20             );
21             }
22              
23             sub add {
24 0     0 0   my $self = shift;
25 0           $self->_clear_last_error;
26 0           my $path = shift;
27 0           my $data = shift;
28 0 0         my $opts = ref $_[0] ? $_[0] : {@_};
29 0           my $body = encode_json($data);
30 0           my $url = _url($self->api_url, $path, $opts);
31 0           my $res = $self->_t->post($url, $body, _headers($opts, 0, 1));
32 0 0         if ($res->[0] eq '201') {
33 0           my $loc = $res->[1]->{location};
34 0           my ($put_code) = $loc =~ m|([^/]+)$|;
35 0           return $put_code;
36             }
37 0           $self->_set_last_error($res);
38 0           return;
39             }
40              
41             sub update {
42 0     0 0   my $self = shift;
43 0           $self->_clear_last_error;
44 0           my $path = shift;
45 0           my $data = shift;
46 0 0         my $opts = ref $_[0] ? $_[0] : {@_};
47              
48             # put code needs to be in both path and body
49 0 0 0       $data->{'put-code'} ||= $opts->{put_code} if $opts->{put_code};
50 0 0 0       $opts->{put_code} ||= $data->{'put-code'} if $data->{'put-code'};
51 0           my $body = encode_json($data);
52 0           my $url = _url($self->api_url, $path, $opts);
53 0           my $res = $self->_t->put($url, $body, _headers($opts, 1, 1));
54 0 0         if ($res->[0] eq '200') {
55 0           return decode_json($res->[2]);
56             }
57 0           $self->_set_last_error($res);
58 0           return;
59             }
60              
61             sub delete {
62 0     0 0   my $self = shift;
63 0           $self->_clear_last_error;
64 0           my $path = shift;
65 0 0         my $opts = ref $_[0] ? $_[0] : {@_};
66 0           my $url = _url($self->api_url, $path, $opts);
67 0           my $res = $self->_t->delete($url, undef, _headers($opts, 1));
68 0 0         if ($res->[0] eq '204') {
69 0           return 1;
70             }
71 0           $self->_set_last_error($res);
72 0           return;
73             }
74              
75             1;
76