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