File Coverage

blib/lib/Attean/SimpleQueryEvaluator.pm
Criterion Covered Total %
statement 424 875 48.4
branch 131 490 26.7
condition 43 223 19.2
subroutine 56 69 81.1
pod 2 4 50.0
total 656 1661 39.4


line stmt bran cond sub pod time code
1 3     3   4486 use v5.14;
  3         12  
2 3     3   15 use warnings;
  3         6  
  3         102  
3              
4             =head1 NAME
5              
6             Attean::SimpleQueryEvaluator - Simple query evaluator
7              
8             =head1 VERSION
9              
10             This document describes Attean::SimpleQueryEvaluator version 0.032
11              
12             =head1 SYNOPSIS
13              
14             use v5.14;
15             use Attean;
16             my $algebra = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { ... }');
17             my $active_graph = Attean::IRI->new('http://example.org/');
18             my $e = Attean::SimpleQueryEvaluator->new( model => $model );
19             my $iter = $e->evaluate( $algebra, $active_graph );
20              
21             =head1 DESCRIPTION
22              
23             The Attean::SimpleQueryEvaluator class implements a simple query evaluator that,
24             given an L<Attean::API::Algebra|Attean::API::Query> and a L<Attean::API::Model>
25             object, evaluates the query represented by the algebra using data from the
26             model, and returns a query result.
27              
28             =head1 ATTRIBUTES
29              
30             =over 4
31              
32             =cut
33              
34 3     3   17 use Attean::Algebra;
  3         6  
  3         53  
35 3     3   12 use Attean::Expression;
  3         5  
  3         83  
36              
37             use Moo;
38 3     3   14 use Encode qw(encode);
  3         5  
  3         19  
39 3     3   1025 use Attean::RDF;
  3         14  
  3         156  
40 3     3   42 use LWP::UserAgent;
  3         7  
  3         19  
41 3     3   2091 use Scalar::Util qw(blessed);
  3         5  
  3         66  
42 3     3   27 use List::Util qw(all any reduce);
  3         7  
  3         144  
43 3     3   17 use Types::Standard qw(ConsumerOf InstanceOf Bool);
  3         6  
  3         218  
44 3     3   22 use URI::Escape;
  3         8  
  3         44  
45 3     3   1995 use namespace::clean;
  3         7  
  3         161  
46 3     3   19  
  3         7  
  3         20  
47             =item C<< model >>
48              
49             The L<Attean::API::Model> object used for query evaluation.
50              
51             =cut
52              
53             has 'model' => (is => 'ro', isa => ConsumerOf['Attean::API::Model'], required => 1);
54            
55             =item C<< default_graph >>
56              
57             The L<Attean::API::IRI> object representing the default graph in the C<< model >>.
58             The default graph will be excluded from enumeration of graph names for query
59             features such as C<< GRAPH ?g {} >>.
60              
61             =cut
62              
63             has 'default_graph' => (is => 'ro', isa => ConsumerOf['Attean::API::IRI'], required => 1);
64              
65             has 'user_agent' => (is => 'rw', isa => InstanceOf['LWP::UserAgent'], default => sub { my $ua = LWP::UserAgent->new(); $ua->agent("Attean/$Attean::VERSION " . $ua->_agent); $ua });
66            
67             has 'ground_blanks' => (is => 'rw', isa => Bool, default => 0);
68            
69             =back
70              
71             =head1 METHODS
72              
73             =over 4
74              
75             =item C<< evaluate( $algebra, $active_graph ) >>
76              
77             Returns an L<Attean::API::Iterator> object with results produced by evaluating
78             the query C<< $algebra >> against the evaluator's C<< model >>, using the
79             supplied C<< $active_graph >>.
80              
81             =cut
82              
83             my $self = shift;
84             my $algebra = shift;
85 65     65 1 2204 my $active_graph = shift || Carp::confess "No active-graph passed to Attean::SimpleQueryEvaluator->evaluate";
86 65         91
87 65   33     125 Carp::confess "No algebra passed for evaluation" unless ($algebra);
88            
89 65 50       134 my $expr_eval = Attean::SimpleQueryEvaluator::ExpressionEvaluator->new( evaluator => $self );
90              
91 65         1019 my @children = @{ $algebra->children };
92             my ($child) = $children[0];
93 65         3423 if ($algebra->isa('Attean::Algebra::Query') or $algebra->isa('Attean::Algebra::Update')) {
  65         180  
94 65         113 return $self->evaluate($algebra->child, $active_graph, @_);
95 65 50 33     1345 } elsif ($algebra->isa('Attean::Algebra::BGP')) {
    100 66        
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
    50          
    100          
    100          
    100          
    50          
    50          
    50          
    0          
96 0         0 my @triples = @{ $algebra->triples };
97             if (scalar(@triples) == 0) {
98 21         29 my $b = Attean::Result->new( bindings => {} );
  21         58  
99 21 50       46 return Attean::ListIterator->new(variables => [], values => [$b], item_type => 'Attean::API::Result');
100 0         0 } else {
101 0         0 my @iters;
102             my @new_vars;
103 21         53 my %blanks;
104             foreach my $t (@triples) {
105 21         0 push(@iters, $self->evaluate_pattern($t, $active_graph, \@new_vars, \%blanks));
106 21         39 }
107 24         183 while (scalar(@iters) > 1) {
108             my ($lhs, $rhs) = splice(@iters, 0, 2);
109 21         754 unshift(@iters, $lhs->join($rhs));
110 3         10 }
111 3         15 return shift(@iters)->map(sub { shift->project_complement(@new_vars) });
112             }
113 21     60   1322 } elsif ($algebra->isa('Attean::Algebra::Distinct') or $algebra->isa('Attean::Algebra::Reduced')) {
  60         150  
114             my %seen;
115             my $iter = $self->evaluate( $child, $active_graph );
116 1         4 return $iter->grep(sub {
117 1         5 my $r = shift;
118             my $str = $r->as_string;
119 4     4   6 my $ok = not($seen{ $str }) ? 1 : 0;
120 4         10 $seen{ $str }++;
121 4 100       11 return $ok;
122 4         11 });
123 4         14 } elsif ($algebra->isa('Attean::Algebra::Extend')) {
124 1         61 my $child = $algebra;
125             my @extends;
126 2         5 my %extends;
127 2         5 while ($child->isa('Attean::Algebra::Extend')) {
128             my $expr = $child->expression;
129 2         7 my $var = $child->variable->value;
130 2         7 $extends{ $var } = $expr;
131 2         7 unshift(@extends, $var);
132 2         5 ($child) = @{ $child->children };
133 2         7 }
134 2         3 return $self->evaluate( $child, $active_graph )->map(sub {
  2         10  
135             my $r = shift;
136             my %extension;
137 8     8   13 my %row_cache;
138 8         12 foreach my $var (@extends) {
139             my $expr = $extends{ $var };
140 8         13 my $val = $expr_eval->evaluate_expression( $expr, $r, $active_graph, \%row_cache );
141 8         14 if ($val->does('Attean::API::Binding')) {
142 8         23 # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple)
143 8 50       377 $val = $val->ground($r);
144             }
145 0         0 # warn "Extend error: $@" if ($@);
146             $r = Attean::Result->new( bindings => { $var => $val } )->join($r) if ($val);
147             }
148 8 50       317 return $r;
149             });
150 8         32 } elsif ($algebra->isa('Attean::Algebra::Filter')) {
151 2         6 # TODO: Merge adjacent filter evaluation so that they can share a row_cache hash (as is done for Extend above)
152             my $expr = $algebra->expression;
153             my $iter = $self->evaluate( $child, $active_graph );
154 1         4 return $iter->grep(sub {
155 1         4 my $t = $expr_eval->evaluate_expression( $expr, shift, $active_graph, {} );
156             # if ($@) { warn "Filter evaluation: $@\n" };
157 4     4   14 return ($t ? $t->ebv : 0);
158             });
159 4 50       23 } elsif ($algebra->isa('Attean::Algebra::OrderBy')) {
160 1         54 local($Attean::API::Binding::ALLOW_IRI_COMPARISON) = 1;
161             my $iter = $self->evaluate( $child, $active_graph );
162 3         6 my @rows = $iter->elements;
163 3         7 my @cmps = @{ $algebra->comparators };
164 3         99 my @exprs = map { $_->expression } @cmps;
165 3         5 my @dirs = map { $_->ascending } @cmps;
  3         12  
166 3         5 my @sorted = map { $_->[0] } sort {
  4         12  
167 3         7 my ($ar, $avalues) = @$a;
  4         11  
168 12         21 my ($br, $bvalues) = @$b;
169 12         20 my $c = 0;
170 12         16 foreach my $i (0 .. $#cmps) {
171 12         14 my ($av, $bv) = map { $_->[$i] } ($avalues, $bvalues);
172 12         26 # Mirrors code in Attean::Plan::OrderBy->sort_rows
173 13         18 if (blessed($av) and $av->does('Attean::API::Binding') and (not(defined($bv)) or not($bv->does('Attean::API::Binding')))) {
  26         41  
174             $c = 1;
175 13 50 33     47 } elsif (blessed($bv) and $bv->does('Attean::API::Binding') and (not(defined($av)) or not($av->does('Attean::API::Binding')))) {
    50 0        
      33        
      33        
      0        
      33        
176 0         0 $c = -1;
177             } else {
178 0         0 $c = eval { $av ? $av->compare($bv) : 1 };
179             if ($@) {
180 13 50       484 $c = 1;
  13         44  
181 13 50       24 }
182 0         0 }
183             $c *= -1 if ($dirs[$i] == 0);
184             last unless ($c == 0);
185 13 100       29 }
186 13 100       24 $c
187             } map { my $r = $_; [$r, [map { $expr_eval->evaluate_expression( $_, $r, $active_graph, {} ) } @exprs]] } @rows;
188             return Attean::ListIterator->new( values => \@sorted, item_type => $iter->item_type, variables => $iter->variables);
189 3         6 } elsif ($algebra->isa('Attean::Algebra::Service')) {
  12         15  
  12         15  
  16         30  
190 3         69 my $endpoint = $algebra->endpoint->value;
191             my ($pattern) = @{ $algebra->children };
192 1         6 my $sparql = Attean::Algebra::Project->new( variables => [ map { variable($_) } $pattern->in_scope_variables ], children => [ $pattern ] )->as_sparql;
193 1         3 my $url = $endpoint . '?query=' . uri_escape($sparql); # TODO: fix for cases where $endpoint already contains query parameters
  1         3  
194 1         6 my $ua = $self->user_agent;
  3         139  
195 1         36 my $req = HTTP::Request->new('GET', $url );
196 1         96 my $response = $ua->request($req);
197 1         16 if (blessed($response) and $response->is_success) {
198 1         2923 my $type = $response->header('Content-Type');
199 1 50 33     1441 my $pclass = Attean->get_parser(media_type => $type) or die "No parser for media type: $type";
    0          
200 1         15 my $parser = $pclass->new();
201 1 50       46 my $xml = $response->decoded_content;
202 1         5 my $bytes = encode('UTF-8', $xml, Encode::FB_CROAK);
203 1         53 return $parser->parse_iter_from_bytes($bytes);
204 1         1872 } elsif ($algebra->silent) {
205 1         35 my $b = Attean::Result->new( bindings => {} );
206             return Attean::ListIterator->new(variables => [], values => [$b], item_type => 'Attean::API::Result');
207 0         0 } else {
208 0         0 die "Service error: " . $response->status_line;
209             }
210 0         0 } elsif ($algebra->isa('Attean::Algebra::Graph')) {
211             my $graph = $algebra->graph;
212             return $self->evaluate($child, $graph) if ($graph->does('Attean::API::Term'));
213 3         9
214 3 100       11 my @iters;
215             my $graphs = $self->model->get_graphs();
216 1         23 my %vars;
217 1         22 while (my $g = $graphs->next) {
218 1         26 next if ($g->value eq $self->default_graph->value);
219 1         7 my $gr = Attean::Result->new( bindings => { $graph->value => $g } );
220 2 100       14 my $iter = $self->evaluate($child, $g)->map(sub { if (my $result = shift->join($gr)) { return $result } else { return } });
221 1         18 foreach my $v (@{ $iter->variables }) {
222 1 50   4   26 $vars{$v}++;
  4         10  
  4         14  
  0         0  
223 1         30 }
  1         17  
224 2         10 push(@iters, $iter);
225             }
226 1         4 return Attean::IteratorSequence->new( variables => [keys %vars], iterators => \@iters, item_type => 'Attean::API::Result' );
227             } elsif ($algebra->isa('Attean::Algebra::Group')) {
228 1         19 my @groupby = @{ $algebra->groupby };
229             my $iter = $self->evaluate($child, $active_graph);
230 0         0 my %groups;
  0         0  
231 0         0 while (my $r = $iter->next) {
232 0         0 my %vars;
233 0         0 my %row_cache;
234 0         0 my @group_terms = map { $expr_eval->evaluate_expression( $_, $r, $active_graph, \%row_cache ) } @groupby;
235             my $key = join(' ', map { blessed($_) ? $_->as_string : '' } @group_terms);
236 0         0 my %group_bindings;
  0         0  
237 0 0       0 foreach my $i (0 .. $#group_terms) {
  0         0  
238 0         0 my $v = $groupby[$i];
239 0         0 if (blessed($v) and $v->isa('Attean::ValueExpression') and $v->value->does('Attean::API::Variable') and $group_terms[$i]) {
240 0         0 $group_bindings{$v->value->value} = $group_terms[$i];
241 0 0 0     0 }
      0        
      0        
242 0         0 }
243             $groups{$key} = [Attean::Result->new( bindings => \%group_bindings ), []] unless (exists($groups{$key}));
244             push(@{ $groups{$key}[1] }, $r);
245 0 0       0 }
246 0         0 my @keys = keys %groups;
  0         0  
247             $groups{''} = [Attean::Result->new( bindings => {} ), []] if (scalar(@keys) == 0);
248 0         0 my $aggs = $algebra->aggregates;
249 0 0       0 my @results;
250 0         0 my %vars;
251 0         0 foreach my $key (keys %groups) {
252             my %row_cache;
253 0         0 my ($binding, $rows) = @{ $groups{$key} };
254 0         0 my $count = scalar(@$rows);
255 0         0 my %bindings;
  0         0  
256 0         0 foreach my $i (0 .. $#{ $aggs }) {
257 0         0 my $name = $aggs->[$i]->variable->value;
258 0         0 my $term = $expr_eval->evaluate_expression( $aggs->[$i], $rows, $active_graph, {} );
  0         0  
259 0         0 # warn "AGGREGATE error: $@" if ($@);
260 0         0 $vars{$name}++;
261             $bindings{ $name } = $term if ($term);
262 0         0 }
263 0 0       0 push(@results, Attean::Result->new( bindings => \%bindings )->join($binding));
264             }
265 0         0 return Attean::ListIterator->new(variables => [keys %vars], values => \@results, item_type => 'Attean::API::Result');
266             } elsif ($algebra->isa('Attean::Algebra::Join')) {
267 0         0 my ($lhs, $rhs) = map { $self->evaluate($_, $active_graph) } @children;
268             return $lhs->join($rhs);
269 2         7 } elsif ($algebra->isa('Attean::Algebra::LeftJoin')) {
  4         74  
270 2         75 my $expr = $algebra->expression;
271             my ($lhs_iter, $rhs_iter) = map { $self->evaluate($_, $active_graph) } @children;
272 0         0 my @rhs = $rhs_iter->elements;
273 0         0 my @results;
  0         0  
274 0         0 my %vars = map { $_ => 1 } (@{ $lhs_iter->variables }, @{ $rhs_iter->variables });
275 0         0 while (my $lhs = $lhs_iter->next) {
276 0         0 my $joined = 0;
  0         0  
  0         0  
  0         0  
277 0         0 foreach my $rhs (@rhs) {
278 0         0 if (my $j = $lhs->join($rhs)) {
279 0         0 if ($expr_eval->evaluate_expression( $expr, $j, $active_graph, {} )->ebv) {
280 0 0       0 $joined++;
281 0 0       0 push(@results, $j);
282 0         0 }
283 0         0 }
284             }
285             push(@results, $lhs) unless ($joined);
286             }
287 0 0       0 return Attean::ListIterator->new( variables => [keys %vars], values => \@results, item_type => 'Attean::API::Result');
288             } elsif ($algebra->isa('Attean::Algebra::Minus')) {
289 0         0 my ($lhsi, $rhs) = map { $self->evaluate($_, $active_graph) } @children;
290             my @rhs = $rhs->elements;
291 0         0 my @results;
  0         0  
292 0         0 while (my $lhs = $lhsi->next) {
293 0         0 my @compatible;
294 0         0 my @disjoint;
295 0         0 RHS: foreach my $rhs (@rhs) {
296             if (my $j = $lhs->join($rhs)) {
297 0         0 push(@compatible, 1);
298 0 0       0 } else {
299 0         0 push(@compatible, 0);
300             }
301 0         0
302             my $intersects = 0;
303             my %lhs_dom = map { $_ => 1 } $lhs->variables;
304 0         0 foreach my $rvar ($rhs->variables) {
305 0         0 if (exists $lhs_dom{$rvar}) {
  0         0  
306 0         0 $intersects = 1;
307 0 0       0 }
308 0         0 }
309             push(@disjoint, not($intersects));
310             }
311 0         0
312             my $count = scalar(@rhs);
313             my $keep = 1;
314 0         0 foreach my $i (0 .. $#rhs) {
315 0         0 $keep = 0 unless ($compatible[$i] == 0 or $disjoint[$i] == 1);
316 0         0 }
317 0 0 0     0
318             push(@results, $lhs) if ($keep);
319             }
320 0 0       0 return Attean::ListIterator->new( variables => $lhsi->variables, values => \@results, item_type => 'Attean::API::Result');
321             } elsif ($algebra->isa('Attean::Algebra::Path')) {
322 0         0 my $s = $algebra->subject;
323             my $path = $algebra->path;
324 24         51 my $o = $algebra->object;
325 24         43 my @children = @{ $path->children };
326 24         44 my ($child) = $children[0];
327 24         30
  24         58  
328 24         49 return $self->model->get_bindings( $s, $path->predicate, $o, $active_graph ) if ($path->isa('Attean::Algebra::PredicatePath'));
329             if ($path->isa('Attean::Algebra::InversePath')) {
330 24 100       135 my $path = Attean::Algebra::Path->new( subject => $o, path => $child, object => $s );
331 11 50 66     137 return $self->evaluate( $path, $active_graph );
    50          
    100          
    100          
    100          
    50          
332 0         0 } elsif ($path->isa('Attean::Algebra::AlternativePath')) {
333 0         0 my @children = @{ $path->children };
334             my @algebras = map { Attean::Algebra::Path->new( subject => $s, path => $_, object => $o ) } @children;
335 0         0 my @iters = map { $self->evaluate($_, $active_graph) } @algebras;
  0         0  
336 0         0 return Attean::IteratorSequence->new( iterators => \@iters, item_type => $iters[0]->item_type, variables => [$algebra->in_scope_variables] );
  0         0  
337 0         0 } elsif ($path->isa('Attean::Algebra::NegatedPropertySet')) {
  0         0  
338 0         0 my $preds = $path->predicates;
339             my %preds = map { $_->value => 1 } @$preds;
340 1         3 my $filter = $self->model->get_quads($s, undef, $o, $active_graph)->grep(sub {
341 1         3 my $q = shift;
  1         6  
342             my $p = $q->predicate;
343 2     2   4 return not exists $preds{ $p->value };
344 2         6 });
345 2         10 my %vars;
346 1         7 $vars{subject} = $s->value if ($s->does('Attean::API::Variable'));
347 1         31 $vars{object} = $o->value if ($o->does('Attean::API::Variable'));
348 1 50       4 return $filter->map(sub {
349 1 50       20 my $q = shift;
350             return unless $q;
351 1     1   2 my %bindings = map { $vars{$_} => $q->$_() } (keys %vars);
352 1 50       4 return Attean::Result->new( bindings => \%bindings );
353 1         3 }, 'Attean::API::Result', variables => [values %vars]);
  1         5  
354 1         20 } elsif ($path->isa('Attean::Algebra::SequencePath')) {
355 1         24 if (scalar(@children) == 1) {
356             my $path = Attean::Algebra::Path->new( subject => $s, path => $children[0], object => $o );
357 1 50       4 return $self->evaluate($path, $active_graph);
358 0         0 } else {
359 0         0 my @paths;
360             my $first = shift(@children);
361 1         3 my $join = Attean::Variable->new();
362 1         2 my @new_vars = ($join->value);
363 1         19 push(@paths, Attean::Algebra::Path->new( subject => $s, path => $first, object => $join ));
364 1         60 foreach my $i (0 .. $#children) {
365 1         19 my $newjoin = Attean::Variable->new();
366 1         4 my $obj = ($i == $#children) ? $o : $newjoin;
367 1         284 push(@new_vars, $newjoin->value);
368 1 50       52 push(@paths, Attean::Algebra::Path->new( subject => $join, path => $children[$i], object => $obj ));
369 1         4 $join = $newjoin;
370 1         17 }
371 1         5
372             while (scalar(@paths) > 1) {
373             my ($l, $r) = splice(@paths, 0, 2);
374 1         3 unshift(@paths, Attean::Algebra::Join->new( children => [$l, $r] ));
375 1         4 }
376 1         19 return $self->evaluate(shift(@paths), $active_graph)->map(sub { shift->project_complement(@new_vars) });
377             }
378 1     1   4 } elsif ($path->isa('Attean::Algebra::ZeroOrMorePath') or $path->isa('Attean::Algebra::OneOrMorePath')) {
  1         5  
379             if ($s->does('Attean::API::TermOrTriple') and $o->does('Attean::API::Variable')) {
380             my $v = {};
381 4 100 66     14 if ($path->isa('Attean::Algebra::ZeroOrMorePath')) {
    50 33        
    0 0        
382 3         79 $self->_ALP($active_graph, $s, $child, $v);
383 3 50       10 } else {
384 3         9 my $iter = $self->_eval($active_graph, $s, $child);
385             while (my $n = $iter->next) {
386 0         0 $self->_ALP($active_graph, $n, $child, $v);
387 0         0 }
388 0         0 }
389             my @results = map { Attean::Result->new( bindings => { $o->value => $_ } ) } (values %$v);
390             return Attean::ListIterator->new(variables => [$o->value], values => \@results, item_type => 'Attean::API::Result');
391 3         8 } elsif ($s->does('Attean::API::Variable') and $o->does('Attean::API::Variable')) {
  6         158  
392 3         109 my $nodes = $self->model->graph_nodes( $active_graph );
393             my @results;
394 1         55 while (my $t = $nodes->next) {
395 1         29 my $tr = Attean::Result->new( bindings => { $s->value => $t } );
396 1         4 my $p = Attean::Algebra::Path->new( subject => $t, path => $path, object => $o );
397 3         52 my $iter = $self->evaluate($p, $active_graph);
398 3         98 while (my $r = $iter->next) {
399 3         10 push(@results, $r->join($tr));
400 3         328 }
401 6         19 }
402             my %vars = map { $_ => 1 } ($s->value, $o->value);
403             return Attean::ListIterator->new(variables => [keys %vars], values => \@results, item_type => 'Attean::API::Result');
404 1         6 } elsif ($s->does('Attean::API::Variable') and $o->does('Attean::API::TermOrTriple')) {
  2         5  
405 1         21 my $pp = Attean::Algebra::InversePath->new( children => [$child] );
406             my $p = Attean::Algebra::Path->new( subject => $o, path => $pp, object => $s );
407 0         0 return $self->evaluate($p, $active_graph);
408 0         0 } else { # Term ZeroOrMorePath(path) Term
409 0         0 my $v = {};
410             $self->_ALP($active_graph, $s, $child, $v);
411 0         0 my @results;
412 0         0 foreach my $v (values %$v) {
413 0         0 return Attean::ListIterator->new(variables => [], values => [Attean::Result->new()], item_type => 'Attean::API::Result')
414 0         0 if ($v->equals($o));
415 0 0       0 }
416             return Attean::ListIterator->new(variables => [], values => [], item_type => 'Attean::API::Result');
417             }
418 0         0 } elsif ($path->isa('Attean::Algebra::ZeroOrOnePath')) {
419             my $path = Attean::Algebra::Path->new( subject => $s, path => $child, object => $o );
420             my @iters;
421 5         88 my %seen;
422 5         9 push(@iters, $self->evaluate( $path, $active_graph )->grep(sub { return not($seen{shift->as_string}++); }));
423             push(@iters, $self->_zeroLengthPath($s, $o, $active_graph));
424 5     1   14 my %vars;
  1         4  
425 5         156 foreach my $iter (@iters) {
426 5         455 $vars{$_}++ for (@{ $iter->variables });
427 5         10 }
428 10         37 return Attean::IteratorSequence->new( iterators => \@iters, item_type => 'Attean::API::Result', variables => [keys %vars] );
  10         153  
429             }
430 5         104 die "Unimplemented path type: $path";
431             } elsif ($algebra->isa('Attean::Algebra::Project')) {
432 0         0 my $iter = $self->evaluate( $child, $active_graph );
433             my @vars = map { $_->value } @{ $algebra->variables };
434 3         139 return $iter->map(sub {
435 3         96 my $r = shift;
  3         12  
  3         11  
436             my $b = { map { my $t = $r->value($_); $t ? ($_ => $t) : () } @vars };
437 9     9   17 return Attean::Result->new( bindings => $b );
438 9 50       13 }, undef, variables => \@vars); #->debug('Project result');
  9         21  
  9         37  
439 9         147 } elsif ($algebra->isa('Attean::Algebra::Slice')) {
440 3         18 my $iter = $self->evaluate( $child, $active_graph );
441             $iter = $iter->offset($algebra->offset) if ($algebra->offset > 0);
442 3         8 $iter = $iter->limit($algebra->limit) if ($algebra->limit >= 0);
443 3 100       113 return $iter;
444 3 100       19 } elsif ($algebra->isa('Attean::Algebra::Union')) {
445 3         75 my ($lhs, $rhs) = map { $self->evaluate($_, $active_graph) } @children;
446             return Attean::IteratorSequence->new(
447 0         0 iterators => [$lhs, $rhs],
  0         0  
448 0         0 item_type => 'Attean::API::Result',
449             variables => [$algebra->in_scope_variables]
450             );
451             } elsif ($algebra->isa('Attean::Algebra::Ask')) {
452             my $iter = $self->evaluate($child, $active_graph);
453             my $result = $iter->next;
454 0         0 return Attean::ListIterator->new(values => [$result ? Attean::Literal->true : Attean::Literal->false], item_type => 'Attean::API::Term');
455 0         0 } elsif ($algebra->isa('Attean::Algebra::Construct')) {
456 0 0       0 my $iter = $self->evaluate($child, $active_graph);
457             my $patterns = $algebra->triples;
458 1         5 use Data::Dumper;
459 1         34 my %seen;
460 3     3   12868 return Attean::CodeIterator->new(
  3         10  
  3         3969  
461 1         2 generator => sub {
462             my $r = $iter->next;
463             return unless ($r);
464 2     2   6 my %mapping = map { my $t = $r->value($_); $t ? ("?$_" => $t) : (); } ($r->variables);
465 2 100       6 my $mapper = Attean::TermMap->rewrite_map(\%mapping);
466 1 50       5 my @triples;
  2         6  
  2         9  
467 1         10 PATTERN: foreach my $p (@$patterns) {
468 1         50 my @terms = map {
469 1         3 ($_->does('Attean::API::TriplePattern'))
470             ? $_->as_triple
471 1 50       6 : $_
  3         42  
472             } $p->apply_map($mapper)->values;
473             unless (all { $_->does('Attean::API::TermOrTriple') } @terms) {
474             next PATTERN;
475 1 50       25 }
  3         25  
476 0         0 push(@triples, Attean::Triple->new(@terms));
477             }
478 1         35 return @triples;
479             },
480 1         32 item_type => 'Attean::API::Triple'
481             )->grep(sub { return not($seen{shift->as_string}++); });
482             } elsif ($algebra->isa('Attean::Algebra::Table')) {
483 1     1   65 my $vars = [map { $_->value } @{ $algebra->variables }];
  1         5  
484             return Attean::ListIterator->new(variables => $vars, values => $algebra->rows, item_type => 'Attean::API::Result');
485 0         0 }
  0         0  
  0         0  
486 0         0 die "Unimplemented algebra evaluation for: $algebra";
487             }
488 0         0  
489            
490             =item C<< evaluate_pattern( $pattern, $active_graph, \@new_vars, \%blanks ) >>
491              
492             Returns an L<Attean::API::Iterator> object with results produced by evaluating
493             the triple- or quad-pattern C<< $pattern >> against the evaluator's
494             C<< model >>, using the supplied C<< $active_graph >>.
495              
496             If the C<< ground_blanks >> option is false, replaces blank nodes in the
497             pattern with fresh variables before evaluation, and populates C<< %blanks >>
498             with pairs ($variable_name => $variable_node). Each new variable is also
499             appended to C<< @new_vars >> as it is created.
500              
501             =cut
502              
503             my $self = shift;
504             my $t = shift;
505             my $active_graph = shift || Carp::confess "No active-graph passed to Attean::SimpleQueryEvaluator->evaluate";
506 24     24 1 34 my $new_vars = shift;
507 24         31 my $blanks = shift;
508 24   33     49 my $q = $t->as_quad_pattern($active_graph);
509 24         31 my @values;
510 24         54 foreach my $v ($q->values) {
511 24         79 if (not($self->ground_blanks) and $v->does('Attean::API::Blank')) {
512 24         867 unless (exists $blanks->{$v->value}) {
513 24         59 $blanks->{$v->value} = Attean::Variable->new();
514 96 100 100     1344 push(@$new_vars, $blanks->{$v->value}->value);
515 2 100       52 }
516 1         16 push(@values, $blanks->{$v->value});
517 1         62 } else {
518             push(@values, $v);
519 2         7 }
520             }
521 94         2146 return $self->model->get_bindings( @values );
522             }
523            
524 24         111 my $self = shift;
525             my $graph = shift;
526             my $term = shift;
527             my $path = shift;
528 6     6   8 my $v = shift;
529 6         7 return if (exists $v->{ $term->as_string });
530 6         9 $v->{ $term->as_string } = $term;
531 6         7
532 6         7 my $iter = $self->_eval($graph, $term, $path);
533 6 50       16 while (my $n = $iter->next) {
534 6         318 $self->_ALP($graph, $n, $path, $v);
535             }
536 6         291 }
537 6         185
538 3         13 my $self = shift;
539             my $graph = shift;
540             my $term = shift;
541             my $path = shift;
542             my $pp = Attean::Algebra::Path->new( subject => $term, path => $path, object => variable('o') );
543 6     6   7 my $iter = $self->evaluate($pp, $graph);
544 6         9 my $terms = $iter->map(sub { shift->value('o') }, 'Attean::API::Term');
545 6         7 my %seen;
546 6         7 return $terms->grep(sub { not $seen{ shift->as_string }++ });
547 6         16 }
548 6         16
549 6     3   222 my $self = shift;
  3         9  
550 6         171 my $s = shift;
551 6     3   36 my $o = shift;
  3         8  
552             my $graph = shift;
553             my $s_term = ($s->does('Attean::API::TermOrTriple'));
554             my $o_term = ($o->does('Attean::API::TermOrTriple'));
555 5     5   9 if ($s_term and $o_term) {
556 5         8 my @r;
557 5         7 push(@r, Attean::Result->new()) if ($s->equals($o));
558 5         8 return Attean::ListIterator->new(variables => [], values => \@r, item_type => 'Attean::API::Result');
559 5         11 } elsif ($s_term) {
560 5         82 my $name = $o->value;
561 5 100 100     78 my $r = Attean::Result->new( bindings => { $name => $s } );
    100          
    100          
562 2         4 return Attean::ListIterator->new(variables => [$name], values => [$r], item_type => 'Attean::API::Result');
563 2 100       7 } elsif ($o_term) {
564 2         54 my $name = $s->value;
565             my $r = Attean::Result->new( bindings => { $name => $o } );
566 1         4 return Attean::ListIterator->new(variables => [$name], values => [$r], item_type => 'Attean::API::Result');
567 1         20 } else {
568 1         40 my @vars = map { $_->value } ($s, $o);
569             my $nodes = $self->model->graph_nodes( $graph );
570 1         5 return $nodes->map(
571 1         19 sub {
572 1         35 my $term = shift;
573             Attean::Result->new( bindings => { map { $_ => $term } @vars } );
574 1         3 },
  2         7  
575 1         8 'Attean::API::Result',
576             variables => \@vars
577             );
578 5     5   6 }
579 5         11 }
  10         92  
580             }
581 1         38  
582             use Moo;
583             use Attean::RDF;
584             use Scalar::Util qw(blessed);
585             use Types::Standard qw(InstanceOf);
586             use URI::Escape qw(uri_escape_utf8);
587             use Encode qw(encode);
588             use POSIX qw(ceil floor);
589 3     3   2529 use Digest;
  3         7  
  3         18  
590 3     3   1001 use UUID::Tiny ':std';
  3         7  
  3         16  
591 3     3   2419 use List::MoreUtils qw(zip);
  3         7  
  3         128  
592 3     3   16 use DateTime::Format::W3CDTF;
  3         5  
  3         15  
593 3     3   1285 use I18N::LangTags;
  3         8  
  3         151  
594 3     3   21 use namespace::clean;
  3         5  
  3         109  
595 3     3   17
  3         6  
  3         24  
596 3     3   1723 has 'evaluator' => (is => 'ro', isa => InstanceOf['Attean::SimpleQueryEvaluator']);
  3         1574  
  3         90  
597 3     3   21 my $self = shift;
  3         8  
  3         535  
598 3     3   20 my $expr = shift;
  3         10  
  3         22  
599 3     3   2722 my $row = shift;
  3         6  
  3         66  
600 3     3   15 my $active_graph = shift;
  3         4  
  3         84  
601 3     3   16 my $row_cache = shift || {};
  3         5  
  3         19  
602             my $impl = $self->impl($expr, $active_graph);
603             return eval { $impl->($row, row_cache => $row_cache) };
604             }
605 53     53 0 2021
606 53         74 my $self = shift;
607 53         69 my $expr = shift;
608 53         70 my $active_graph = shift;
609 53   100     140 my $op = $expr->operator;
610 53         112 my $true = Attean::Literal->true;
611 53         87 my $false = Attean::Literal->false;
  53         90  
612             if ($expr->isa('Attean::ExistsExpression')) {
613             my $pattern = $expr->pattern;
614             return sub {
615 127     127 0 151 my $r = shift;
616 127         146 my $table = Attean::Algebra::Table->new( variables => [map { variable($_) } $r->variables], rows => [$r] );
617 127         135 my $join = Attean::Algebra::Join->new( children => [$table, $pattern] );
618 127         234 # TODO: substitute variables at top-level of EXISTS pattern
619 127         282 my $iter = $self->evaluator->evaluate($join, $active_graph);
620 127         250 return ($iter->next) ? $true : $false;
621 127 50       658 };
    100          
    50          
    100          
    50          
    50          
    50          
622 0         0 } elsif ($expr->isa('Attean::ValueExpression')) {
623             my $node = $expr->value;
624 0     0   0 if ($node->does('Attean::API::Variable')) {
625 0         0 return sub { return shift->value($node->value); };
  0         0  
626 0         0 } else {
627             return sub { return $node };
628 0         0 }
629 0 0       0 } elsif ($expr->isa('Attean::UnaryExpression')) {
630 0         0 my ($child) = @{ $expr->children };
631             my $impl = $self->impl($child, $active_graph);
632 88         138 if ($op eq '!') {
633 88 100       198 return sub {
634 29     29   454 my $term = $impl->(@_);
  29         74  
635             return ($term->ebv) ? $false : $true;
636 59     55   1378 }
  55         98  
637             } elsif ($op eq '-' or $op eq '+') {
638             return sub {
639 0         0 my $term = $impl->(@_);
  0         0  
640 0         0 die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::NumericLiteral'));
641 0 0 0     0 my $v = $term->numeric_value;
    0          
642             return Attean::Literal->new( value => eval "$op$v", datatype => $term->datatype );
643 0     0   0 };
644 0 0       0 }
645             die "Unimplemented UnaryExpression evaluation: " . $expr->operator;
646 0         0 } elsif ($expr->isa('Attean::BinaryExpression')) {
647             my ($lhs, $rhs) = @{ $expr->children };
648 0     0   0 my ($lhsi, $rhsi) = map { $self->impl($_, $active_graph) } ($lhs, $rhs);
649 0 0 0     0 if ($op eq '&&') {
650 0         0 return sub {
651 0         0 my ($r, %args) = @_;
652 0         0 my $lbv = eval { $lhsi->($r, %args) };
653             my $rbv = eval { $rhsi->($r, %args) };
654 0         0 die "TypeError $op" unless ($lbv or $rbv);
655             return $false if (not($lbv) and not($rbv->ebv));
656 35         40 return $false if (not($rbv) and not($lbv->ebv));
  35         87  
657 35         57 die "TypeError $op" unless ($lbv and $rbv);
  70         142  
658 35 100       116 return ($lbv->ebv && $rbv->ebv) ? $true : $false;
    100          
    50          
    0          
    0          
659             }
660 9     9   21 } elsif ($op eq '||') {
661 9         12 return sub {
  9         27  
662 9         540 my ($r, %args) = @_;
  9         18  
663 9 100 100     694 my $lbv = eval { $lhsi->($r, %args) };
664 8 100 100     25 return $true if ($lbv and $lbv->ebv);
665 7 100 100     22 my $rbv = eval { $rhsi->($r, %args) };
666 6 100 100     52 die "TypeError $op" unless ($rbv);
667 4 100 100     13 return $true if ($rbv->ebv);
668             return $false if ($lbv);
669 9         35 die "TypeError $op";
670             }
671 9     9   26 } elsif ($op =~ m#^(?:[-+*/])$#) { # numeric operators: - + * /
672 9         10 return sub {
  9         28  
673 9 100 100     570 my ($r, %args) = @_;
674 6         12 ($lhs, $rhs) = map { $_->($r, %args) } ($lhsi, $rhsi);
  6         16  
675 6 100       488 for ($lhs, $rhs) { die "TypeError $op" unless (blessed($_) and $_->does('Attean::API::NumericLiteral')); }
676 4 100       16 my $lv = $lhs->numeric_value;
677 2 100       14 my $rv = $rhs->numeric_value;
678 1         18 return Attean::Literal->new( value => eval "$lv $op $rv", datatype => $lhs->binary_promotion_type($rhs, $op) );
679             };
680 9         47 } elsif ($op =~ /^!?=$/) {
681             return sub {
682 16     16   34 my ($r, %args) = @_;
683 16         31 ($lhs, $rhs) = map { $_->($r, %args) } ($lhsi, $rhsi);
  32         66  
684 16 100 66     33 for ($lhs, $rhs) { die "TypeError $op" unless (blessed($_) and $_->does('Attean::API::TermOrTriple')); }
  32         365  
685 15         200 my $ok;
686 15         48 if ($lhs->does('Attean::API::Binding')) {
687 15         607 $ok = $lhs->equals($rhs);
688 17         82 } else {
689             $ok = $lhs->equals($rhs);
690             }
691 0     0   0 $ok = not($ok) if ($op eq '!=');
692 0         0 return $ok ? $true : $false;
  0         0  
693 0 0 0     0 }
  0         0  
694 0         0 } elsif ($op =~ /^[<>]=?$/) {
695 0 0       0 return sub {
696 0         0 my ($r, %args) = @_;
697             ($lhs, $rhs) = map { $_->($r, %args) } ($lhsi, $rhsi);
698 0         0 for ($lhs, $rhs) {
699             die "TypeError $op" unless $_->does('Attean::API::TermOrTriple');
700 0 0       0 die "TypeError $op" if ($_->does('Attean::API::IRI')); # comparison of IRIs is only defined for `ORDER BY`, not for general expressions
701 0 0       0 }
702            
703 0         0 my $c = ($lhs->compare($rhs));
704             return $true if (($c < 0 and ($op =~ /<=?/)) or ($c > 0 and ($op =~ />=?/)) or ($c == 0 and ($op =~ /=/)));
705 0     0   0 return $false;
706 0         0 }
  0         0  
707 0         0 }
708 0 0       0 die "Unexpected operator evaluation: $op";
709 0 0       0 } elsif ($expr->isa('Attean::FunctionExpression')) {
710             my $func = $expr->operator;
711             my @children = map { $self->impl($_, $active_graph) } @{ $expr->children };
712 0         0 my %type_roles = qw(URI IRI IRI IRI BLANK Blank LITERAL Literal NUMERIC NumericLiteral TRIPLE Triple);
713 0 0 0     0 my %type_classes = qw(URI Attean::IRI IRI Attean::IRI STR Attean::Literal);
      0        
      0        
      0        
      0        
714 0         0 return sub {
715             my ($r, %args) = @_;
716 0         0 my $row_cache = $args{row_cache} || {};
717 0         0
718             if ($func eq 'IF') {
719 0         0 my $term = $children[0]->( $r, %args );
720 0         0 return ($term->ebv) ? $children[1]->( $r, %args ) : $children[2]->( $r, %args );
  0         0  
  0         0  
721 0         0 } elsif ($func eq 'IN' or $func eq 'NOTIN') {
722 0         0 ($true, $false) = ($false, $true) if ($func eq 'NOTIN');
723             my $child = shift(@children);
724 0     0   0 my $term = $child->( $r, %args );
725 0   0     0 foreach my $c (@children) {
726             if (my $value = eval { $c->( $r, %args ) }) {
727 0 0 0     0 return $true if ($term->equals($value));
    0          
    0          
728 0         0 }
729 0 0       0 }
730             return $false;
731 0 0       0 } elsif ($func eq 'COALESCE') {
732 0         0 foreach my $c (@children) {
733 0         0 my $t = eval { $c->( $r, %args ) };
734 0         0 next if ($@);
735 0 0       0 return $t if $t;
  0         0  
736 0 0       0 }
737             return;
738             }
739 0         0
740             my @operands = map { $_->( $r, %args ) } @children;
741 0         0 if ($func =~ /^(STR)$/) {
742 0         0 return $type_classes{$1}->new($operands[0]->value);
  0         0  
743 0 0       0 } elsif ($func =~ /^(SUBJECT|PREDICATE|OBJECT)$/) {
744 0 0       0 my $pos = lc($func);
745             my $term = $operands[0]->$pos();
746 0         0 return $term;
747             } elsif ($func =~ /^([UI]RI)$/) {
748             my @base = $expr->has_base ? (base => $expr->base) : ();
749 0         0 return $type_classes{$1}->new(value => $operands[0]->value, @base);
  0         0  
750 0 0 0     0 } elsif ($func eq 'BNODE') {
    0 0        
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
751 0         0 if (scalar(@operands)) {
752             my $name = $operands[0]->value;
753 0         0 if (my $b = $row_cache->{bnodes}{$name}) {
754 0         0 return $b;
755 0         0 } else {
756             my $b = Attean::Blank->new();
757 0 0       0 $row_cache->{bnodes}{$name} = $b;
758 0         0 return $b;
759             }
760 0 0       0 }
761 0         0 return Attean::Blank->new();
762 0 0       0 } elsif ($func eq 'LANG') {
763 0         0 die "TypeError: LANG" unless ($operands[0]->does('Attean::API::Literal'));
764             return Attean::Literal->new($operands[0]->language // '');
765 0         0 } elsif ($func eq 'LANGMATCHES') {
766 0         0 my ($lang, $match) = map { $_->value } @operands;
767 0         0 if ($match eq '*') {
768             # """A language-range of "*" matches any non-empty language-tag string."""
769             return ($lang ? $true : $false);
770 0         0 } else {
771             return (I18N::LangTags::is_dialect_of( $lang, $match )) ? $true : $false;
772 0 0       0 }
773 0   0     0 } elsif ($func eq 'DATATYPE') {
774             return $operands[0]->datatype;
775 0         0 } elsif ($func eq 'BOUND') {
  0         0  
776 0 0       0 return $operands[0] ? $true : $false;
777             } elsif ($func eq 'RAND') {
778 0 0       0 return Attean::Literal->new( value => rand(), datatype => 'http://www.w3.org/2001/XMLSchema#double' );
779             } elsif ($func eq 'ABS') {
780 0 0       0 return Attean::Literal->new( value => abs($operands[0]->value), $operands[0]->construct_args );
781             } elsif ($func =~ /^(?:CEIL|FLOOR)$/) {
782             my $v = $operands[0]->value;
783 0         0 return Attean::Literal->new( value => (($func eq 'CEIL') ? ceil($v) : floor($v)), $operands[0]->construct_args );
784             } elsif ($func eq 'ROUND') {
785 0 0       0 return Attean::Literal->new( value => sprintf('%.0f', (0.000000000000001 + $operands[0]->numeric_value)), $operands[0]->construct_args );
786             } elsif ($func eq 'CONCAT') {
787 0         0 my $all_lang = 1;
788             my $all_str = 1;
789 0         0 my $lang;
790             foreach my $n (@operands) {
791 0         0 die "CONCAT called with a non-literal argument" unless ($n->does('Attean::API::Literal'));
792 0 0       0 if ($n->datatype->value ne 'http://www.w3.org/2001/XMLSchema#string') {
793             die "CONCAT called with a datatyped-literal other than xsd:string";
794 0         0 } elsif ($n->language) {
795             $all_str = 0;
796 0         0 if (defined($lang) and $lang ne $n->language) {
797 0         0 $all_lang = 0;
798 0         0 } else {
799 0         0 $lang = $n->language;
800 0 0       0 }
801 0 0       0 } else {
    0          
802 0         0 $all_lang = 0;
803             $all_str = 0;
804 0         0 }
805 0 0 0     0 }
806 0         0 my %strtype;
807             if ($all_lang and $lang) {
808 0         0 $strtype{language} = $lang;
809             } elsif ($all_str) {
810             $strtype{datatype} = 'http://www.w3.org/2001/XMLSchema#string'
811 0         0 }
812 0         0 return Attean::Literal->new( value => join('', map { $_->value } @operands), %strtype );
813             } elsif ($func eq 'SUBSTR') {
814             my $str = shift(@operands);
815 0         0 my @args = map { $_->numeric_value } @operands;
816 0 0 0     0 my $v = scalar(@args == 1) ? substr($str->value, $args[0]-1) : substr($str->value, $args[0]-1, $args[1]);
    0          
817 0         0 return Attean::Literal->new( value => $v, $str->construct_args );
818             } elsif ($func eq 'STRLEN') {
819 0         0 return Attean::Literal->integer(length($operands[0]->value));
820             } elsif ($func eq 'REPLACE') {
821 0         0 my ($node, $pat, $rep) = @operands;
  0         0  
822             die "TypeError: REPLACE called without a literal arg1 term" unless (blessed($node) and $node->does('Attean::API::Literal'));
823 0         0 die "TypeError: REPLACE called without a literal arg2 term" unless (blessed($pat) and $pat->does('Attean::API::Literal'));
824 0         0 die "TypeError: REPLACE called without a literal arg3 term" unless (blessed($rep) and $rep->does('Attean::API::Literal'));
  0         0  
825 0 0       0 die "TypeError: REPLACE called with a datatyped (non-xsd:string) literal" if ($node->datatype and $node->datatype->value ne 'http://www.w3.org/2001/XMLSchema#string');
826 0         0 my ($value, $pattern, $replace) = map { $_->value } @operands;
827             die "EvaluationError: REPLACE called with unsafe ?{} match pattern" if (index($pattern, '(?{') != -1 or index($pattern, '(??{') != -1);
828 0         0 die "EvaluationError: REPLACE called with unsafe ?{} replace pattern" if (index($replace, '(?{') != -1 or index($replace, '(??{') != -1);
829            
830 0         0 $replace =~ s/\\/\\\\/g;
831 0 0 0     0 $replace =~ s/\$(\d+)/\$$1/g;
832 0 0 0     0 $replace =~ s/"/\\"/g;
833 0 0 0     0 $replace = qq["$replace"];
834 0 0 0     0 no warnings 'uninitialized';
835 0         0 $value =~ s/$pattern/"$replace"/eeg;
  0         0  
836 0 0 0     0 return Attean::Literal->new(value => $value, $node->construct_args);
837 0 0 0     0 } elsif ($func =~ /^[UL]CASE$/) {
838             return Attean::Literal->new( value => ($func eq 'UCASE' ? uc($operands[0]->value) : lc($operands[0]->value) ), $operands[0]->construct_args );
839 0         0 } elsif ($func eq 'ENCODE_FOR_URI') {
840 0         0 return Attean::Literal->new( uri_escape_utf8($operands[0]->value) );
841 0         0 } elsif ($func eq 'CONTAINS') {
842 0         0 my ($node, $pat) = @operands;
843 3     3   9248 my ($lit, $plit) = map { $_->value } @operands;
  3         8  
  3         8889  
844 0         0 die "TypeError: CONTAINS" if ($node->language and $pat->language and $node->language ne $pat->language);
  0         0  
845 0         0 return (index($lit, $plit) >= 0) ? $true : $false;
846             } elsif ($func eq 'STRSTARTS' or $func eq 'STRENDS') {
847 0 0       0 my ($lit, $plit) = map { $_->value } @operands;
848             if ($func eq 'STRENDS') {
849 0         0 my $pos = length($lit) - length($plit);
850             return (rindex($lit, $plit) == $pos) ? $true : $false;
851 0         0 } else {
852 0         0 return (index($lit, $plit) == 0) ? $true : $false;
  0         0  
853 0 0 0     0 }
      0        
854 0 0       0 } elsif ($func eq 'STRBEFORE' or $func eq 'STRAFTER') {
855             my ($node, $substr) = @operands;
856 0         0  
  0         0  
857 0 0       0 die "$func called without a literal arg1 term" unless (blessed($node) and $node->does('Attean::API::Literal'));
858 0         0 die "$func called without a literal arg2 term" unless (blessed($substr) and $substr->does('Attean::API::Literal'));
859 0 0       0 die "$func called with a datatyped (non-xsd:string) literal" if ($node->datatype and $node->datatype->value ne 'http://www.w3.org/2001/XMLSchema#string');
860              
861 0 0       0 my $lhs_simple = (not($node->language) and ($node->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string'));
862             my $rhs_simple = (not($substr->language) and ($substr->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string'));
863             if ($lhs_simple and $rhs_simple) {
864 0         0 # ok
865             } elsif ($node->language and $substr->language and $node->language eq $substr->language) {
866 0 0 0     0 # ok
867 0 0 0     0 } elsif ($node->language and $rhs_simple) {
868 0 0 0     0 # ok
869             } else {
870 0   0     0 die "$func called with literals that are not argument compatible";
871 0   0     0 }
872 0 0 0     0
    0 0        
    0 0        
      0        
873             my $value = $node->value;
874             my $match = $substr->value;
875             my $i = index($value, $match, 0);
876             if ($i < 0) {
877             return Attean::Literal->new('');
878             } else {
879 0         0 if ($func eq 'STRBEFORE') {
880             return Attean::Literal->new(value => substr($value, 0, $i), $node->construct_args);
881             } else {
882 0         0 return Attean::Literal->new(value => substr($value, $i+length($match)), $node->construct_args);
883 0         0 }
884 0         0 }
885 0 0       0 } elsif ($func =~ /^(?:YEAR|MONTH|DAY|HOURS|MINUTES)$/) {
886 0         0 my $method = lc($func =~ s/^(HOUR|MINUTE)S$/$1/r);
887             my $dt = $operands[0]->datetime;
888 0 0       0 return Attean::Literal->integer($dt->$method());
889 0         0 } elsif ($func eq 'SECONDS') {
890             my $dt = $operands[0]->datetime;
891 0         0 return Attean::Literal->decimal($dt->second());
892             } elsif ($func eq 'TZ' or $func eq 'TIMEZONE') {
893             my $dt = $operands[0]->datetime;
894             my $tz = $dt->time_zone;
895 0         0 if ($tz->is_floating) {
896 0         0 return Attean::Literal->new('') if ($func eq 'TZ');
897 0         0 die "TIMEZONE called with a dateTime without a timezone";
898             }
899 0         0 return Attean::Literal->new('Z') if ($func eq 'TZ' and $tz->is_utc);
900 0         0 if ($tz) {
901             my $offset = $tz->offset_for_datetime( $dt );
902 0         0 my $hours = 0;
903 0         0 my $minutes = 0;
904 0 0       0 my $minus = ($func eq 'TZ') ? '+' : '';
905 0 0       0 if ($offset < 0) {
906 0         0 $minus = '-';
907             $offset = -$offset;
908 0 0 0     0 }
909 0 0       0  
910 0         0 my $duration = "${minus}PT";
911 0         0 if ($offset >= 60*60) {
912 0         0 my $h = int($offset / (60*60));
913 0 0       0 $duration .= "${h}H" if ($h > 0);
914 0 0       0 $hours = int($offset / (60*60));
915 0         0 $offset = $offset % (60*60);
916 0         0 }
917             if ($offset >= 60) {
918             my $m = int($offset / 60);
919 0         0 $duration .= "${m}M" if ($m > 0);
920 0 0       0 $minutes = int($offset / 60);
921 0         0 $offset = $offset % 60;
922 0 0       0 }
923 0         0 my $seconds = int($offset);
924 0         0 my $s = int($offset);
925             $duration .= "${s}S" if ($s > 0 or $duration eq 'PT');
926 0 0       0
927 0         0 return ($func eq 'TZ')
928 0 0       0 ? Attean::Literal->new(sprintf('%s%02d:%02d', $minus, $hours, $minutes))
929 0         0 : Attean::Literal->new( value => $duration, datatype => "http://www.w3.org/2001/XMLSchema#dayTimeDuration");
930 0         0 } else {
931             return Attean::Literal->new('') if ($func eq 'TZ');
932 0         0 die "TIMEZONE called without a valid dateTime";
933 0         0 }
934 0 0 0     0 } elsif ($func eq 'NOW') {
935             my $value = DateTime::Format::W3CDTF->new->format_datetime( DateTime->now );
936 0 0       0 return Attean::Literal->new( value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#dateTime' );
937             } elsif ($func =~ /^(?:STR)?UUID$/) {
938             return Attean::Literal->new(uc(uuid_to_string(create_uuid()))) if ($func eq 'STRUUID');
939             return Attean::IRI->new('urn:uuid:' . uc(uuid_to_string(create_uuid())));
940 0 0       0 } elsif ($func =~ /^(MD5|SHA1|SHA256|SHA384|SHA512)$/) {
941 0         0 my $hash = $func =~ s/SHA/SHA-/r;
942             my $digest = eval { Digest->new($hash)->add(encode('UTF-8', $operands[0]->value, Encode::FB_CROAK))->hexdigest };
943             return Attean::Literal->new($digest);
944 0         0 } elsif ($func eq 'STRLANG') {
945 0         0 my ($str, $lang) = @operands;
946             my @values = map { $_->value } @operands;
947 0 0       0 die "TypeError: STRLANG must be called with two plain literals" unless (blessed($str) and $str->does('Attean::API::Literal') and blessed($lang) and $lang->does('Attean::API::Literal'));
948 0         0 die "TypeError: STRLANG not called with a simple literal" unless ($str->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string' and not($str->language));
949             return Attean::Literal->new( value => $values[0], language => $values[1] );
950 0         0 } elsif ($func eq 'STRDT') {
951 0         0 die "TypeError: STRDT" unless ($operands[0]->does('Attean::API::Literal') and not($operands[0]->language));
  0         0  
952 0         0 if (my $dt = $operands[0]->datatype) {
953             die "TypeError: STRDT" unless ($dt->value eq 'http://www.w3.org/2001/XMLSchema#string');
954 0         0 }
955 0         0 die "TypeError: STRDT" unless ($operands[1]->does('Attean::API::IRI'));
  0         0  
956 0 0 0     0 my @values = map { $_->value } @operands;
      0        
      0        
957 0 0 0     0 return Attean::Literal->new( value => $values[0], datatype => $values[1] );
958 0         0 } elsif ($func eq 'SAMETERM') {
959             my ($a, $b) = @operands;
960 0 0 0     0 die "TypeError: SAMETERM" unless (blessed($operands[0]) and blessed($operands[1]));
961 0 0       0 if ($a->compare($b)) {
962 0 0       0 return $false;
963             }
964 0 0       0 if ($a->does('Attean::API::Binding')) {
965 0         0 my $ok = ($a->sameTerms($b));
  0         0  
966 0         0 return $ok ? $true : $false;
967             } else {
968 0         0 my $ok = ($a->value eq $b->value);
969 0 0 0     0 return $ok ? $true : $false;
970 0 0       0 }
971 0         0 } elsif ($func =~ /^IS([UI]RI|BLANK|LITERAL|NUMERIC|TRIPLE)$/) {
972             return $operands[0]->does("Attean::API::$type_roles{$1}") ? $true : $false;
973 0 0       0 } elsif ($func eq 'REGEX') {
974 0         0 my ($value, $pattern) = map { $_->value } @operands;
975 0 0       0 return ($value =~ /$pattern/) ? $true : $false;
976             } elsif ($func eq 'INVOKE') {
977 0         0 my $furi = shift(@operands)->value;
978 0 0       0 my $func = Attean->get_global_function($furi);
979             unless (ref($func)) {
980             die "No extension registered for <$furi>";
981 0 0       0 }
982             return $func->(@operands);
983 0         0 }
  0         0  
984 0 0       0 die "Unimplemented FunctionExpression evaluation: " . $expr->operator;
985             };
986 0         0 } elsif ($expr->isa('Attean::AggregateExpression')) {
987 0         0 my $agg = $expr->operator;
988 0 0       0 my ($child) = @{ $expr->children };
989 0         0 if ($agg eq 'COUNT') {
990             if ($child) {
991 0         0 my $impl = $self->impl($child, $active_graph);
992             return sub {
993 0         0 my ($rows, %args) = @_;
994 0         0 my @terms = grep { blessed($_) } map { $impl->($_, %args) } @{ $rows };
995             if ($expr->distinct) {
996 0         0 my %seen;
997 0         0 @terms = grep { not($seen{$_->as_string}++) } @terms;
  0         0  
998 0 0       0 }
    0          
    0          
999 0 0       0 return Attean::Literal->integer(scalar(@terms));
1000 0         0 };
1001             } else {
1002 0     0   0 return sub {
1003 0         0 my ($rows, %args) = @_;
  0         0  
  0         0  
  0         0  
1004 0 0       0 return Attean::Literal->integer(scalar(@$rows));
1005 0         0 };
1006 0         0 }
  0         0  
1007             } elsif ($agg =~ /^(?:SAMPLE|MIN|MAX|SUM|AVG|GROUP_CONCAT)$/) {
1008 0         0 my $impl = $self->impl($child, $active_graph);
1009 0         0 if ($agg eq 'SAMPLE') {
1010             return sub {
1011             my ($rows, %args) = @_;
1012 0     0   0 return $impl->( shift(@$rows), %args )
1013 0         0 };
1014 0         0 } elsif ($agg eq 'MIN' or $agg eq 'MAX') {
1015             my $expect = ($agg eq 'MIN') ? 1 : -1;
1016             return sub {
1017 0         0 my ($rows, %args) = @_;
1018 0 0 0     0 my $extrema;
    0 0        
    0          
    0          
1019             foreach my $r (@$rows) {
1020 0     0   0 my $t = $impl->( $r, %args );
1021 0         0 return if (not($t) and $agg eq 'MIN'); # unbound is always minimal
1022 0         0 next if (not($t)); # unbound need not be considered for MAX
1023             $extrema = $t if (not($extrema) or $extrema->compare($t) == $expect);
1024 0 0       0 }
1025             return $extrema;
1026 0     0   0 };
1027 0         0 } elsif ($agg eq 'SUM' or $agg eq 'AVG') {
1028 0         0 return sub {
1029 0         0 my ($rows, %args) = @_;
1030 0 0 0     0 my $count = 0;
1031 0 0       0 my $sum = Attean::Literal->integer(0);
1032 0 0 0     0 my %seen;
1033             foreach my $r (@$rows) {
1034 0         0 my $term = $impl->( $r, %args );
1035 0         0 if ($expr->distinct) {
1036             next if ($seen{ $term->as_string }++);
1037             }
1038 0     0   0 if ($term->does('Attean::API::NumericLiteral')) {
1039 0         0 $count++;
1040 0         0 $sum = Attean::Literal->new( value => ($sum->numeric_value + $term->numeric_value), datatype => $sum->binary_promotion_type($term, '+') );
1041 0         0 } else {
1042 0         0 die "TypeError: AVG";
1043 0         0 }
1044 0 0       0 }
1045 0 0       0 if ($agg eq 'AVG') {
1046             $sum = not($count) ? undef : Attean::Literal->new( value => ($sum->numeric_value / $count), datatype => $sum->binary_promotion_type(Attean::Literal->integer($count), '/') );
1047 0 0       0 }
1048 0         0 return $sum;
1049 0         0 };
1050             } elsif ($agg eq 'GROUP_CONCAT') {
1051 0         0 my $sep = $expr->scalar_vars->{ 'seperator' } // ' ';
1052             return sub {
1053             my ($rows, %args) = @_;
1054 0 0       0 my %seen;
1055 0 0       0 my @strings;
1056             foreach my $r (@$rows) {
1057 0         0 my $term = eval { $impl->( $r, %args ) };
1058 0         0 if ($expr->distinct) {
1059             next if ($seen{ blessed($term) ? $term->as_string : '' }++);
1060 0   0     0 }
1061             push(@strings, $term->value // '');
1062 0     0   0 }
1063 0         0 return Attean::Literal->new(join($sep, sort @strings));
1064             };
1065 0         0 }
1066 0         0 } elsif ($agg eq 'CUSTOM') {
  0         0  
1067 0 0       0 my $iri = $expr->custom_iri;
1068 0 0       0 my $data = Attean->get_global_aggregate($iri);
    0          
1069             unless ($data) {
1070 0   0     0 die "No extension aggregate registered for <$iri>";
1071             }
1072 0         0 my $start = $data->{'start'};
1073 0         0 my $process = $data->{'process'};
1074             my $finalize = $data->{'finalize'};
1075              
1076 0         0 my $impl = $self->impl($child, $active_graph);
1077 0         0 return sub {
1078 0 0       0 my ($rows, %args) = @_;
1079 0         0 my $thunk = $start->();
1080             foreach my $r (@$rows) {
1081 0         0 my $t = $impl->( $r, %args );
1082 0         0 $process->($thunk, $t);
1083 0         0 }
1084             return $finalize->($thunk);
1085 0         0 };
1086             }
1087 0     0   0 die "Unimplemented AggregateExpression evaluation: " . $expr->operator;
1088 0         0 } elsif ($expr->isa('Attean::CastExpression')) {
1089 0         0 my ($child) = @{ $expr->children };
1090 0         0 my $impl = $self->impl( $child, $active_graph );
1091 0         0 my $type = $expr->datatype;
1092             return sub {
1093 0         0 my ($r, %args) = @_;
1094 0         0 my $term = $impl->($r, %args);
1095             # TODO: reformat syntax for xsd:double
1096 0         0 my $cast = Attean::Literal->new( value => $term->value, datatype => $type );
1097             return $cast->canonicalized_term if ($cast->does('Attean::API::CanonicalizingLiteral'));
1098 4         5 return $cast;
  4         11  
1099 4         17 }
1100 4         10 } else {
1101             Carp::confess "No impl for expression " . $expr->as_string;
1102 4     4   11 }
1103 4         13 }
1104             }
1105 4         79  
1106 4 50       328 1;
1107 0            
1108              
1109 4         14 =back
1110 0            
1111             =head1 BUGS
1112              
1113             Please report any bugs or feature requests to through the GitHub web interface
1114             at L<https://github.com/kasei/attean/issues>.
1115              
1116             =head1 SEE ALSO
1117              
1118              
1119              
1120             =head1 AUTHOR
1121              
1122             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
1123              
1124             =head1 COPYRIGHT
1125              
1126             Copyright (c) 2014--2022 Gregory Todd Williams.
1127             This program is free software; you can redistribute it and/or modify it under
1128             the same terms as Perl itself.
1129              
1130             =cut