File Coverage

blib/lib/RDF/aREF/Query.pm
Criterion Covered Total %
statement 86 99 86.8
branch 39 52 75.0
condition 15 26 57.6
subroutine 9 10 90.0
pod 1 3 33.3
total 150 190 78.9


line stmt bran cond sub pod time code
1             package RDF::aREF::Query;
2 7     7   37 use strict;
  7         11  
  7         158  
3 7     7   26 use warnings;
  7         38  
  7         124  
4 7     7   57 use v5.10;
  7         19  
5              
6             our $VERSION = '0.27';
7              
8 7     7   1774 use RDF::aREF::Decoder qw(qName languageTag);
  7         16  
  7         409  
9 7     7   43 use Carp qw(croak);
  7         11  
  7         252  
10 7     7   36 use RDF::NS;
  7         14  
  7         5708  
11              
12             sub new {
13 26     26 0 71 my ($class, %options) = @_;
14              
15 26   33     81 my $expression = $options{query} // croak "query required";
16 26   33     133 my $ns = $options{ns} // RDF::NS->new;
17 26   33     736334 my $decoder = $options{decoder} // RDF::aREF::Decoder->new( ns => $ns );
18              
19 26         131 my $self = bless {
20             items => [],
21             decoder => $decoder
22             }, $class;
23              
24 26         124 my @items = split /\s*\|\s*/, $expression;
25 26 100       97 foreach my $expr ( @items ? @items : '' ) {
26 32         57 my $type = 'any';
27 32         51 my ($language, $datatype);
28              
29 32 100       181 if ($expr =~ /^(.*)\.$/) {
    100          
    100          
30 6         11 $type = 'resource';
31 6         22 $expr = $1;
32             } elsif ( $expr =~ /^([^@]*)@([^@]*)$/ ) {
33 10         58 ($expr, $language) = ($1, $2);
34 10 50 66     51 if ( $language eq '' or $language =~ languageTag ) {
35 10         18 $type = 'literal';
36             } else {
37 0         0 croak 'invalid languageTag in aREF query';
38             }
39             } elsif ( $expr =~ /^([^^]*)\^([^^]*)$/ ) { # TODO: support explicit IRI
40 3         20 ($expr, $datatype) = ($1, $2);
41 3 50       18 if ( $datatype =~ qName ) {
42 3         6 $type = 'literal';
43 3         14 $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         86 my @path = split /\./, $expr;
51 32         62 foreach (@path) {
52 37 50 66     177 croak "invalid aref path expression: $_" if $_ !~ qName and $_ ne 'a';
53             }
54              
55 32         55 push @{$self->{items}}, {
  32         181  
56             path => \@path,
57             type => $type,
58             language => $language,
59             datatype => $datatype,
60             };
61             }
62              
63 26         130 $self;
64             }
65              
66             sub query {
67 0     0 1 0 my ($self) = @_;
68             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}}
  0         0  
81             }
82              
83             sub apply {
84 26     26 0 67 my ($self, $rdf, $subject) = @_;
85 26         47 map { $self->_apply_item($_, $rdf, $subject) } @{$self->{items}};
  32         66  
  26         60  
86             }
87              
88             sub _apply_item {
89 32     32   60 my ($self, $item, $rdf, $subject) = @_;
90              
91 32         50 my $decoder = $self->{decoder};
92              
93             # TODO: Support RDF::Trine::Model
94             # TODO: try abbreviated *and* full URI?
95 32         55 my @current = $rdf;
96 32 100       56 if ($subject) {
97 25 100       63 if ($rdf->{_id}) {
98 2 50       6 return if $rdf->{_id} ne $subject;
99             } else {
100 23         43 @current = ($rdf->{$subject});
101             }
102             }
103              
104 32         44 my @path = @{$item->{path}};
  32         55  
105 32 100 100     81 if (!@path and $item->{type} ne 'resource') {
106 1 50       3 if ($item->{type} eq 'any') {
107 1 50       10 return ($subject ? $subject : $rdf->{_id});
108             }
109             }
110              
111 31         77 while (my $field = shift @path) {
112              
113             # get objects in aREF
114 88         176 @current = grep { defined }
115 55 100 66     236 map { (ref $_ and ref $_ eq 'ARRAY') ? @$_ : $_ }
116 37         67 map { $_->{$field} } @current;
  55         132  
117 37 100       90 return if !@current;
118              
119 35 100 100     145 if (@path or $item->{type} eq 'resource') {
120              
121             # get resources
122 38         73 @current = grep { defined }
123 11         21 map { $decoder->resource($_) } @current;
  38         125  
124              
125 11 100       33 if (@path) {
126             # TODO: only if RDF given as predicate map!
127 7         12 @current = grep { defined } map { $rdf->{$_} } @current;
  25         49  
  25         45  
128             }
129             }
130             }
131              
132             # last path element
133 29         59 @current = grep { defined } map { $decoder->object($_) } @current;
  59         138  
  59         174  
134              
135 29 100       81 if ($item->{type} eq 'literal') {
136 13         24 @current = grep { @$_ > 1 } @current;
  23         134  
137              
138 13 100       54 if ($item->{language}) { # TODO: use language tag substring
    100          
139 5 100       10 @current = grep { $_->[1] and $_->[1] eq $item->{language} } @current;
  11         42  
140             } elsif ($item->{datatype}) { # TODO: support qName and explicit IRI
141 2 50       4 @current = grep { $_->[2] and $_->[2] eq $item->{datatype} } @current;
  2         11  
142             }
143             }
144              
145 29         93 map { $_->[0] } @current; # IRI or string value
  50         244  
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