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
|
|
|
|
|
|
|
|