File Coverage

blib/lib/Catmandu/AAT/API.pm
Criterion Covered Total %
statement 48 51 94.1
branch 3 6 50.0
condition n/a
subroutine 11 11 100.0
pod 0 6 0.0
total 62 74 83.7


line stmt bran cond sub pod time code
1             package Catmandu::AAT::API;
2              
3 4     4   9361 use strict;
  4         11  
  4         87  
4 4     4   10 use warnings;
  4         4  
  4         67  
5              
6 4     4   13 use Moo;
  4         4  
  4         15  
7 4     4   838 use Catmandu::Sane;
  4         7  
  4         22  
8              
9 4     4   1970 use Catmandu::AAT::SPARQL;
  4         8  
  4         1932  
10              
11             has term => (is => 'ro', required => 1);
12             has language => (is => 'ro', default => 'nl');
13              
14             ##
15             # Search for a term
16             sub search {
17 2     2 0 2147 my $self = shift;
18 2         4 my $search_query = '?Subject luc:term "%s" .';
19 2         12 my $query = $self->build_query(sprintf($search_query, $self->term));
20 2         4 return $self->request($query);
21             }
22              
23             ##
24             # Exactly match a term
25             sub match {
26 2     2 0 2244 my $self = shift;
27 2         3 my $match_query = '?Subject skos:prefLabel "%s"@%s .';
28 2         18 my $query = $self->build_query(sprintf($match_query, $self->term, $self->language));
29 2         5 my $result = $self->request($query);
30 2 50       7 if (scalar @{$result} >= 1) {
  2         7  
31 2         50 return $result->[0];
32             } else {
33 0         0 return {};
34             }
35             }
36              
37             ##
38             # By ID
39             sub id {
40 2     2 0 4 my $self = shift;
41 2         4 my $id_query = '?Subject dc:identifier "%s" .';
42 2         14 my $query = $self->build_query(sprintf($id_query, $self->term));
43 2         6 my $result = $self->request($query);
44 2 50       10 if (scalar @{$result} >= 1) {
  2         8  
45 2         61 return $result->[0];
46             } else {
47 0         0 return {};
48             }
49             }
50              
51             sub request {
52 6     6 0 11 my ($self, $query) = @_;
53 6         75 my $sparql = Catmandu::AAT::SPARQL->new(query => $query, lang => $self->language);
54 6 50       2848 if (defined ($sparql->results)) {
55 6         247 return $self->parse($sparql->results);
56             } else {
57 0         0 return [];
58             }
59             }
60              
61              
62             sub parse {
63 6     6 0 56 my ($self, $raw_results) = @_;
64 6         11 my $results = [];
65              
66 6         11 foreach my $raw_result (@{$raw_results->{'results'}->{'bindings'}}) {
  6         23  
67             my $result = {
68             'prefLabel' => $raw_result->{'prefLabel'}->{'value'},
69             'id' => $raw_result->{'id'}->{'value'},
70 65         107 'uri' => $raw_result->{'Subject'}->{'value'}
71             };
72 65         42 push @{$results}, $result;
  65         72  
73             }
74 6         201 return $results;
75             }
76              
77             sub build_query {
78 6     6 0 11 my ($self, $match_query) = @_;
79 6         7 my $query = q(select ?prefLabel ?id ?Subject ?scheme { ?Subject xl:prefLabel [xl:literalForm ?prefLabel; dct:language gvp_lang:%s] . ?Subject dc:identifier ?id . ?Subject skos:inScheme <http://vocab.getty.edu/aat/> . ?Subject skos:inScheme ?scheme . %s });
80 6         29 return sprintf($query, $self->language, $match_query);
81             }
82              
83             1.
84             __END__