File Coverage

blib/lib/RDF/aREF/Query.pm
Criterion Covered Total %
statement 87 100 87.0
branch 39 52 75.0
condition 15 26 57.6
subroutine 9 10 90.0
pod 1 3 33.3
total 151 191 79.0


line stmt bran cond sub pod time code
1             package RDF::aREF::Query;
2 6     6   28 use strict;
  6         11  
  6         216  
3 6     6   29 use warnings;
  6         9  
  6         272  
4 6     6   60 use v5.10;
  6         17  
  6         327  
5              
6             our $VERSION = '0.25';
7              
8 6     6   2925 use RDF::aREF::Decoder qw(qName languageTag);
  6         14  
  6         596  
9 6     6   52 use Carp qw(croak);
  6         8  
  6         277  
10 6     6   26 use RDF::NS;
  6         8  
  6         6413  
11              
12             sub new {
13 26     26 0 57 my ($class, %options) = @_;
14              
15 26   33     76 my $expression = $options{query} // croak "query required";
16 26   33     178 my $ns = $options{ns} // RDF::NS->new;
17 26   33     383394 my $decoder = $options{decoder} // RDF::aREF::Decoder->new( ns => $ns );
18              
19 26         142 my $self = bless {
20             items => [],
21             decoder => $decoder
22             }, $class;
23              
24 26         205 my @items = split /\s*\|\s*/, $expression;
25 26 100       116 foreach my $expr ( @items ? @items : '' ) {
26 32         52 my $type = 'any';
27 32         49 my ($language, $datatype);
28              
29 32 100       204 if ($expr =~ /^(.*)\.$/) {
    100          
    100          
30 6         7 $type = 'resource';
31 6         21 $expr = $1;
32             } elsif ( $expr =~ /^([^@]*)@([^@]*)$/ ) {
33 10         56 ($expr, $language) = ($1, $2);
34 10 50 66     60 if ( $language eq '' or $language =~ languageTag ) {
35 10         90 $type = 'literal';
36             } else {
37 0         0 croak 'invalid languageTag in aREF query';
38             }
39             } elsif ( $expr =~ /^([^^]*)\^([^^]*)$/ ) { # TODO: support explicit IRI
40 3         19 ($expr, $datatype) = ($1, $2);
41 3 50       14 if ( $datatype =~ qName ) {
42 3         5 $type = 'literal';
43 3         16 $datatype = $decoder->prefixed_name( split '_', $datatype );
44 3 100       10 $datatype = undef if $datatype eq $decoder->prefixed_name('xsd','string');
45             } else {
46 0         0 croak 'invalid datatype qName in aREF query';
47             }
48             }
49              
50 32         96 my @path = split /\./, $expr;
51 32         73 foreach (@path) {
52 37 50 66     220 croak "invalid aref path expression: $_" if $_ !~ qName and $_ ne 'a';
53             }
54              
55 32         47 push @{$self->{items}}, {
  32         207  
56             path => \@path,
57             type => $type,
58             language => $language,
59             datatype => $datatype,
60             };
61             }
62              
63 26         137 $self;
64             }
65              
66             sub query {
67 0     0 1 0 my ($self) = @_;
68 0         0 join '|', map {
69 0         0 my $q = join '.', @{$_->{path}};
  0         0  
70 0 0       0 if ($_->{type} eq 'literal') {
    0          
71 0 0       0 if ($_->{datatype}) {
72 0         0 $q .= '^' . $_->{datatype};
73             } else {
74 0   0     0 $q .= '@' . ($_->{language} // '');
75             }
76             } elsif ($_->{type} eq 'resource') {
77 0         0 $q .= '.';
78             }
79 0         0 $q;
80 0         0 } @{$self->{items}}
81             }
82              
83             sub apply {
84 26     26 0 40 my ($self, $rdf, $subject) = @_;
85 26         35 map { $self->_apply_item($_, $rdf, $subject) } @{$self->{items}};
  32         84  
  26         70  
86             }
87              
88             sub _apply_item {
89 32     32   67 my ($self, $item, $rdf, $subject) = @_;
90              
91 32         52 my $decoder = $self->{decoder};
92              
93             # TODO: Support RDF::Trine::Model
94             # TODO: try abbreviated *and* full URI?
95 32         53 my @current = $rdf;
96 32 100       75 if ($subject) {
97 25 100       51 if ($rdf->{_id}) {
98 2 50       5 return if $rdf->{_id} ne $subject;
99             } else {
100 23         65 @current = ($rdf->{$subject});
101             }
102             }
103              
104 32         41 my @path = @{$item->{path}};
  32         56  
105 32 100 100     97 if (!@path and $item->{type} ne 'resource') {
106 1 50       4 if ($item->{type} eq 'any') {
107 1 50       11 return ($subject ? $subject : $rdf->{_id});
108             }
109             }
110              
111 31         89 while (my $field = shift @path) {
112              
113             # get objects in aREF
114 88 100 66     167 @current = grep { defined }
  55         258  
115 55         130 map { (ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_ }
116 37         51 map { $_->{$field} } @current;
117 37 100       79 return if !@current;
118              
119 35 100 100     176 if (@path or $item->{type} eq 'resource') {
120              
121             # get resources
122 38         60 @current = grep { defined }
  38         82  
123 11         24 map { $decoder->resource($_) } @current;
124              
125 11 100       37 if (@path) {
126             # TODO: only if RDF given as predicate map!
127 7         15 @current = grep { defined } map { $rdf->{$_} } @current;
  25         46  
  25         39  
128             }
129             }
130             }
131              
132             # last path element
133 29         46 @current = grep { defined } map { $decoder->object($_) } @current;
  59         97  
  59         131  
134              
135 29 100       73 if ($item->{type} eq 'literal') {
136 13         19 @current = grep { @$_ > 1 } @current;
  23         42  
137              
138 13 100       37 if ($item->{language}) { # TODO: use language tag substring
    100          
139 5 100       7 @current = grep { $_->[1] and $_->[1] eq $item->{language} } @current;
  11         36  
140             } elsif ($item->{datatype}) { # TODO: support qName and explicit IRI
141 2 50       2 @current = grep { $_->[2] and $_->[2] eq $item->{datatype} } @current;
  2         12  
142             }
143             }
144              
145 29         64 map { $_->[0] } @current; # IRI or string value
  50         277  
146             }
147              
148             1;
149             __END__
150              
151             =head1 NAME
152              
153             RDF::aREF::Query - aREF query expression
154              
155             =head1 SYNOPSIS
156              
157             my $rdf = {
158             'http://example.org/book' => {
159             dct_creator => [
160             'http://example.org/alice',
161             'http://example.org/bob'
162             ]
163             },
164             'http://example.org/alice' => {
165             foaf_name => "Alice"
166             },
167             'http://example.org/bob' => {
168             foaf_name => "Bob"
169             }
170             };
171              
172             my $getnames = RDF::aREF::Query->new(
173             query => 'dct_creator.foaf_name'
174             );
175             my @names = $getnames->apply( $rdf, 'http://example.org/boo' );
176             $getnames->query; # 'dct_creator.foaf_name'
177              
178             use RDF::aREF qw(aref_query_map);
179             my $record = aref_query_map( $rdf, $publication, {
180             'dct_creator@' => 'creator',
181             'dct_creator.foaf_name' => 'creator',
182             });
183              
184             =head1 DESCRIPTION
185              
186             Implements L<aREF query|http://gbv.github.io/aREF/aREF.html#aref-query>, a
187             query language to access strings and nodes from agiven RDF graph.
188              
189             See also functions C<aref_query> and C<aref_query_map> in L<RDF::aREF> for
190             convenient application.
191              
192             =head1 CONFIGURATION
193              
194             The constructor expects the following options:
195              
196             =over
197              
198             =item query
199              
200             L<aREF query|http://gbv.github.io/aREF/aREF.html#aref-query> expression
201              
202             =item decoder
203              
204             Instance of L<RDF::aREF::Decoder> to map qNames to URIs. A new instance is
205             created unless given.
206              
207             =item ns
208              
209             Optional namespace map (L<RDF::NS>), passed to the constructor of
210             L<RDF::aREF::Decoder> if no decoder is given.
211              
212             =back
213              
214             =head1 METHODS
215              
216             =head1 apply( $graph [, $origin ] )
217              
218             Perform the query on a given RDF graph. The graph can be given as aREF
219             structure (subject map or predicate map) or as instance of
220             L<RDF::Trine::Model>. An origin subject node must be provided unless the RDF
221             graph is provided as L<predicate
222             map|http://gbv.github.io/aREF/aREF.html#predicate-maps>.
223              
224             =head1 query
225              
226             Returns the aREF query expression
227              
228             =head1 SEE ALSO
229              
230             Use SPARQL for more complex queries, e.g. with L<RDF::Trine::Store::SPARQL>.
231              
232             =cut