File Coverage

blib/lib/Attean/Plan.pm
Criterion Covered Total %
statement 561 1853 30.2
branch 31 600 5.1
condition 4 113 3.5
subroutine 151 249 60.6
pod 0 84 0.0
total 747 2899 25.7


line stmt bran cond sub pod time code
1 50     50   649 use v5.14;
  50         162  
2 50     50   259 use warnings;
  50         100  
  50         1364  
3 50     50   258 use utf8;
  50         102  
  50         404  
4              
5             =head1 NAME
6              
7             Attean::Plan - Representation of SPARQL query plan operators
8              
9             =head1 VERSION
10              
11             This document describes Attean::Plan version 0.032
12              
13             =head1 SYNOPSIS
14              
15             use v5.14;
16             use Attean;
17              
18             =head1 DESCRIPTION
19              
20             This is a utility package that defines all the Attean query plan classes
21             in the Attean::Plan namespace:
22              
23             =over 4
24              
25             =cut
26              
27 50     50   1327 use Attean::API::Query;
  50         130  
  50         1984  
28              
29             =item * L<Attean::Plan::Quad>
30              
31             Evaluates a quad pattern against the model.
32              
33             =cut
34              
35             use Moo;
36 50     50   254 use Scalar::Util qw(blessed reftype);
  50         107  
  50         286  
37 50     50   16225 use Types::Standard qw(ConsumerOf ArrayRef);
  50         133  
  50         2769  
38 50     50   306 use namespace::clean;
  50         102  
  50         413  
39 50     50   29233  
  50         155  
  50         657  
40             has 'subject' => (is => 'ro', required => 1);
41             has 'predicate' => (is => 'ro', required => 1);
42             has 'object' => (is => 'ro', required => 1);
43             has 'graph' => (is => 'ro', required => 1);
44            
45             with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::NullaryQueryTree';
46             with 'Attean::API::QuadPattern';
47              
48             around 'BUILDARGS' => sub {
49             my $orig = shift;
50             my $class = shift;
51             my $args = $orig->( $class, @_ );
52             if (exists $args->{in_scope_variables}) {
53             Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
54             }
55            
56             my %vars;
57             foreach my $pos (qw(subject predicate object graph)) {
58             my $term = $args->{$pos};
59             if (blessed($term) and $term->does('Attean::API::Variable')) {
60             $vars{$term->value} = $term;
61             }
62             }
63            
64             my @vars = keys %vars;
65             $args->{in_scope_variables} = [@vars];
66              
67             return $args;
68             };
69              
70             my $self = shift;
71             my @nodes = $self->values;
72 10     10 0 19 my @strings;
73 10         28 foreach my $t (@nodes) {
74 10         17 if (ref($t) eq 'ARRAY') {
75 10         20 my @tstrings = map { $_->ntriples_string } @$t;
76 40 100       513 if (scalar(@tstrings) == 1) {
    50          
77 7         14 push(@strings, @tstrings);
  7         92  
78 7 50       66 } else {
79 7         16 push(@strings, '[' . join(', ', @tstrings) . ']');
80             }
81 0         0 } elsif ($t->does('Attean::API::TermOrVariable')) {
82             push(@strings, $t->ntriples_string);
83             } else {
84 33         871 use Data::Dumper;
85             die "Unrecognized node in quad pattern: " . Dumper($t);
86 50     50   32315 }
  50         110  
  50         19086  
87 0         0 }
88             return sprintf('Quad { %s }', join(', ', @strings));
89             }
90 10         92
91             my $self = shift;
92             my $model = shift;
93             my $b = shift;
94 0     0 0 0 my @values = $self->values;
95 0         0 foreach my $i (0 .. $#values) {
96 0         0 my $value = $values[$i];
97 0         0 if (reftype($value) eq 'ARRAY') {
98 0         0 my @values;
99 0         0 foreach my $value (@{ $value }) {
100 0 0       0 my $name = $value->value;
    0          
101 0         0 if (my $node = $b->value($name)) {
102 0         0 push(@values, $node);
  0         0  
103 0         0 } else {
104 0 0       0 push(@values, $value);
105 0         0 }
106             $values[$i] = \@values;
107 0         0 }
108             } elsif ($value->does('Attean::API::Variable')) {
109 0         0 my $name = $value->value;
110             if (my $node = $b->value($name)) {
111             $values[$i] = $node;
112 0         0 }
113 0 0       0 }
114 0         0 }
115            
116             return sub {
117             return $model->get_bindings( @values );
118             }
119             }
120 0     0   0  
121             my $self = shift;
122 0         0 my $model = shift;
123             my @values = $self->values;
124             return sub {
125 11     11 0 15 return $model->get_bindings( @values );
126 11         25 }
127 11         28 }
128             }
129 11     11   46  
130             =item * L<Attean::Plan::NestedLoopJoin>
131 11         64  
132             Evaluates a join (natural-, anti-, or left-) using a nested loop.
133              
134             =cut
135              
136             use Moo;
137             use List::MoreUtils qw(all);
138             use namespace::clean;
139              
140             with 'Attean::API::BindingSubstitutionPlan';
141 50     50   18895 with 'Attean::API::Plan::Join';
  50         111  
  50         287  
142 50     50   16499 my $self = shift;
  50         126  
  50         470  
143 50     50   47034 if ($self->left) {
  50         129  
  50         256  
144             return 'NestedLoop Left Join';
145             } elsif ($self->anti) {
146             return 'NestedLoop Anti Join';
147             } else {
148 1     1 0 3 return 'NestedLoop Join';
149 1 50       6 }
    50          
150 0         0 }
151              
152 0         0 my $self = shift;
153             my $model = shift;
154 1         4 my @children = map { $_->impl($model) } @{ $self->children };
155             return $self->_impl($model, @children);
156             }
157            
158             my $self = shift;
159 4     4 0 5 my $model = shift;
160 4         7 my $b = shift;
161 4         6 unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) {
  8         18  
  4         10  
162 4         17 die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string;
163             }
164            
165             my @children = map { $_->substitute_impl($model, $b) } @{ $self->children };
166 0     0 0 0 return $self->_impl($model, @children);
167 0         0 }
168 0         0
169 0 0   0   0 my $self = shift;
  0         0  
  0         0  
170 0         0 my $model = shift;
171             my @children = @_;
172             my $left = $self->left;
173 0         0 my $anti = $self->anti;
  0         0  
  0         0  
174 0         0 my $iter_variables = $self->in_scope_variables;
175            
176             return sub {
177             my ($lhs, $rhs) = map { $_->() } @children;
178 4     4   9 my @right = $rhs->elements;
179 4         5 my @results;
180 4         10 while (my $l = $lhs->next) {
181 4         14 my $seen = 0;
182 4         10 foreach my $r (@right) {
183 4         10 my @shared = $l->shared_domain($r);
184             if ($anti and scalar(@shared) == 0) {
185             # in a MINUS, two results that have disjoint domains are considered not to be joinable
186 4     4   9 next;
  8         148  
187 4         173 }
188 4         6 if (my $j = $l->join($r)) {
189 4         13 $seen++;
190 2         5 if ($left) {
191 2         5 # TODO: filter with expression
192 2         19 push(@results, $j);
193 2 50 33     8 } elsif ($anti) {
194             } else {
195 0         0 push(@results, $j);
196             }
197 2 50       8 }
198 2         4 }
199 2 50       9 if ($left and not($seen)) {
    50          
200             push(@results, $l);
201 0         0 } elsif ($anti and not($seen)) {
202             push(@results, $l);
203             }
204 2         7 }
205             return Attean::ListIterator->new(
206             item_type => 'Attean::API::Result',
207             variables => $iter_variables,
208 2 50 33     20 values => \@results,
    50 33        
209 0         0 );
210             }
211 0         0 }
212             }
213              
214 4         77 =item * L<Attean::Plan::HashJoin>
215              
216             Evaluates a join (natural-, anti-, or left-) using a hash join.
217              
218             =cut
219              
220 4         23 use Moo;
221             use List::MoreUtils qw(all);
222             use namespace::clean;
223            
224             my $self = shift;
225             if ($self->anti) {
226             die "Cannot use a HashJoin for anti-joins";
227             }
228             }
229            
230 50     50   50860 with 'Attean::API::BindingSubstitutionPlan';
  50         119  
  50         224  
231 50     50   15166 with 'Attean::API::Plan::Join';
  50         124  
  50         273  
232 50     50   27711 my $self = shift;
  50         132  
  50         213  
233             my $name;
234             if ($self->left) {
235 622     622 0 91419 $name = "Hash Left Join";
236 622 50       3361 } else {
237 0         0 $name = "Hash Join";
238             }
239             return sprintf('%s { %s }', $name, join(', ', @{$self->join_variables}));
240             }
241              
242             my $self = shift;
243             my $model = shift;
244 1     1 0 3 my @children = map { $_->impl($model) } @{ $self->children };
245 1         2 return $self->_impl($model, @children);
246 1 50       4 }
247 0         0
248             my $self = shift;
249 1         3 my $model = shift;
250             my $b = shift;
251 1         2
  1         8  
252             unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) {
253             die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string;
254             }
255 0     0 0 0
256 0         0 my @children = map { $_->substitute_impl($model, $b) } @{ $self->children };
257 0         0 return $self->_impl($model, @children);
  0         0  
  0         0  
258 0         0 }
259            
260             my $self = shift;
261             my $model = shift;
262 0     0 0 0 my @children = @_;
263 0         0 my $left = $self->left;
264 0         0 my $iter_variables = $self->in_scope_variables;
265              
266 0 0   0   0 return sub {
  0         0  
  0         0  
267 0         0 my %hash;
268             my @vars = @{ $self->join_variables };
269             my $rhs = $children[1]->();
270 0         0 while (my $r = $rhs->next()) {
  0         0  
  0         0  
271 0         0 my $has_unbound_right_join_var = 0;
272             my @values;
273             foreach my $var (@vars) {
274             my $value = $r->value($var);
275 0     0   0 unless (defined($value)) {
276 0         0 $has_unbound_right_join_var++;
277 0         0 }
278 0         0 push(@values, $value);
279 0         0 }
280             if ($has_unbound_right_join_var) {
281             # this is a RHS row that doesn't have a term bound to one of the join variables.
282 0     0   0 # this will make it impossible to compute the proper hash key to access the row bucket,
283 0         0 # so we add this row to the null bucket (hash key '') which we try to join all LHS rows
  0         0  
284 0         0 # against.
285 0         0 push(@{ $hash{''} }, $r);
286 0         0 } else {
287 0         0 my $key = join(',', map { ref($_) ? $_->as_string : '' } @values);
288 0         0 push(@{ $hash{$key} }, $r);
289 0         0 }
290 0 0       0 }
291 0         0
292             my @results;
293 0         0 my $lhs = $children[0]->();
294             while (my $l = $lhs->next()) {
295 0 0       0 my $seen = 0;
296             my @values;
297             my $has_unbound_left_join_var = 0;
298             foreach my $var (@vars) {
299             my $value = $l->value($var);
300 0         0 unless (defined($value)) {
  0         0  
301             $has_unbound_left_join_var++;
302 0 0       0 }
  0         0  
303 0         0 push(@values, $value);
  0         0  
304             }
305            
306             my @buckets;
307 0         0 if (my $b = $hash{''}) {
308 0         0 push(@buckets, $b);
309 0         0 }
310 0         0
311 0         0 if ($has_unbound_left_join_var) {
312 0         0 my $pattern = join(',', map { ref($_) ? quotemeta($_->as_string) : '.*' } @values);
313 0         0 foreach my $key (keys %hash) {
314 0         0 if ($key =~ /^${pattern}$/) {
315 0 0       0 push(@buckets, $hash{$key});
316 0         0 }
317             }
318 0         0 } else {
319             my $key = join(',', map { ref($_) ? $_->as_string : '' } @values);
320             if (my $rows = $hash{$key}) {
321 0         0 push(@buckets, $rows);
322 0 0       0 }
323 0         0 }
324            
325             foreach my $rows (@buckets) {
326 0 0       0 foreach my $r (@$rows) {
327 0 0       0 if (my $j = $l->join($r)) {
  0         0  
328 0         0 $seen++;
329 0 0       0 if ($left) {
330 0         0 # TODO: filter with expression
331             push(@results, $j);
332             } else {
333             push(@results, $j);
334 0 0       0 }
  0         0  
335 0 0       0 }
336 0         0 }
337             }
338             if ($left and not($seen)) {
339             push(@results, $l);
340 0         0 }
341 0         0 }
342 0 0       0 return Attean::ListIterator->new(
343 0         0 item_type => 'Attean::API::Result',
344 0 0       0 variables => $iter_variables,
345             values => \@results
346 0         0 );
347             }
348 0         0 }
349             }
350              
351             =item * L<Attean::Plan::Construct>
352              
353 0 0 0     0 =cut
354 0         0  
355             use Moo;
356             use List::MoreUtils qw(all);
357 0         0 use Types::Standard qw(Str ArrayRef ConsumerOf InstanceOf);
358             use namespace::clean;
359             has 'triples' => (is => 'ro', 'isa' => ArrayRef[ConsumerOf['Attean::API::TripleOrQuadPattern']], required => 1);
360              
361             with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree';
362              
363 0         0 my $self = shift;
364             my $triples = $self->triples;
365             return sprintf('Construct { %s }', join(' . ', map { $_->as_string } @$triples));
366             }
367              
368             # TODO: this code is repeated in several plan classes; figure out a way to share it.
369             my $class = shift;
370             my %args = @_;
371 50     50   67837 my %vars = map { $_ => 1 } map { @{ $_->in_scope_variables } } @{ $args{ children } };
  50         133  
  50         230  
372 50     50   15177 my @vars = keys %vars;
  50         153  
  50         326  
373 50     50   28478
  50         121  
  50         236  
374 50     50   37895 if (exists $args{in_scope_variables}) {
  50         127  
  50         212  
375             Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
376             }
377             $args{in_scope_variables} = \@vars;
378              
379             return $class->SUPER::BUILDARGS(%args);
380 3     3 0 5 }
381 3         7  
382 3         7 my $self = shift;
  3         10  
383             my $model = shift;
384             my @children = map { $_->impl($model) } @{ $self->children };
385             return $self->_impl($model, @children);
386             }
387 1     1 0 4022
388 1         5 my $self = shift;
389 1         2 my $model = shift;
  2         6  
  1         1  
  1         7  
  1         3  
390 1         4 my $b = shift;
391             unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) {
392 1 50       5 die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string;
393 0         0 }
394            
395 1         2 warn "TODO: fix substitute_impl to substitute construct triples";
396             my @children = map { $_->substitute_impl($model, $b) } @{ $self->children };
397 1         8 return $self->_impl($model, @children);
398             }
399            
400             my $self = shift;
401 0     0 0 0 my $model = shift;
402 0         0 my $child = shift;
403 0         0
  0         0  
  0         0  
404 0         0 my @triples = @{ $self->triples };
405             return sub {
406             my $iter = $child->();
407             my @buffer;
408 0     0 0 0 my %seen;
409 0         0 return Attean::CodeIterator->new(
410 0         0 item_type => 'Attean::API::Triple',
411 0 0   0   0 generator => sub {
  0         0  
  0         0  
412 0         0 if (scalar(@buffer)) {
413             return shift(@buffer);
414             }
415 0         0 while (my $row = $iter->next) {
416 0         0 foreach my $tp (@triples) {
  0         0  
  0         0  
417 0         0 my $tp = $tp->apply_bindings($row);
418             my $t = eval { $tp->as_triple };
419             if ($t) {
420             push(@buffer, $t);
421 0     0   0 }
422 0         0 }
423 0         0 if (scalar(@buffer)) {
424             my $t = shift(@buffer);
425 0         0 return $t;
  0         0  
426             }
427 0     0   0 }
428 0         0 }
429             )->grep(sub {
430             return not $seen{$_->as_string}++;
431             });
432             }
433 0 0       0 }
434 0         0 }
435              
436 0         0 =item * L<Attean::Plan::Describe>
437 0         0  
438 0         0 =cut
439 0         0  
  0         0  
440 0 0       0 use Moo;
441 0         0 use Attean::RDF;
442             use List::MoreUtils qw(all);
443             use Types::Standard qw(Str ArrayRef ConsumerOf InstanceOf);
444 0 0       0 use namespace::clean;
445 0         0  
446 0         0 has 'graph' => (is => 'ro');
447             has 'terms' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::TermOrVariable']]);
448              
449             with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree';
450             with 'Attean::API::UnionScopeVariablesPlan';
451 0         0  
452 0         0 my $self = shift;
453             my $terms = $self->terms;
454 0         0 return sprintf('Describe { %s }', join(' . ', map { $_->as_string } @$terms));
455             }
456              
457             my $self = shift;
458             my $model = shift;
459             my @children = map { $_->impl($model) } @{ $self->children };
460             return $self->_impl($model, @children);
461             }
462 50     50   63059
  50         114  
  50         230  
463 50     50   16043 my $self = shift;
  50         155  
  50         491  
464 50     50   37307 my $model = shift;
  50         151  
  50         221  
465 50     50   44685 my $b = shift;
  50         118  
  50         234  
466 50     50   36146 unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) {
  50         136  
  50         255  
467             die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string;
468             }
469            
470             warn "TODO: fix substitute_impl to substitute describe terms";
471             my @children = map { $_->substitute_impl($model, $b) } @{ $self->children };
472             return $self->_impl($model, @children);
473             }
474            
475 1     1 0 2 my $self = shift;
476 1         3 my $model = shift;
477 1         4 my $child = shift;
  1         4  
478            
479             my $graph = $self->graph;
480             my @terms = @{ $self->terms };
481 1     1 0 2 # TODO: Split @terms into ground terms and variables.
482 1         2 # Only call get_quads once for ground terms.
483 1         2 # For variable terms, call get_quads for each variable-result combination.
  1         4  
  1         4  
484 1         5 return sub {
485             my $iter = $child->();
486             my @buffer;
487             my %seen;
488 0     0 0 0 return Attean::CodeIterator->new(
489 0         0 item_type => 'Attean::API::Triple',
490 0         0 generator => sub {
491 0 0   0   0 if (scalar(@buffer)) {
  0         0  
  0         0  
492 0         0 return shift(@buffer);
493             }
494             while (my $row = $iter->next) {
495 0         0 foreach my $term (@terms) {
496 0         0 my $value = $term->apply_binding($row);
  0         0  
  0         0  
497 0         0 if ($value->does('Attean::API::Term')) {
498             my $iter = $model->get_quads( $value, variable('predicate'), variable('object'), $graph );
499             push(@buffer, $iter->elements);
500             }
501 1     1   2 if (scalar(@buffer)) {
502 1         1 return shift(@buffer);
503 1         2 }
504             }
505 1         3 }
506 1         2 }
  1         3  
507             )->grep(sub {
508             return not $seen{$_->as_string}++;
509             });
510             }
511 1     1   5 }
512 1         68 }
513              
514             =item * L<Attean::Plan::EBVFilter>
515              
516             Filters results from a sub-plan based on the effective boolean value of a
517 1 50       4 named variable binding.
518 0         0  
519             =cut
520 1         14  
521 1         3 use Moo;
522 1         4 use Scalar::Util qw(blessed);
523 1 50       4 use Types::Standard qw(Str ConsumerOf);
524 1         15 use namespace::clean;
525 1         8
526             with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree';
527 1 50       4 with 'Attean::API::UnionScopeVariablesPlan';
528 1         4  
529             has 'variable' => (is => 'ro', isa => Str, required => 1);
530              
531             my $self = shift;
532             return sprintf('EBVFilter { ?%s }', $self->variable);
533             }
534 1         4
535 1         37 my $self = shift;
536             my $model = shift;
537 1         6 my $bind = shift;
538             my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children };
539             my $var = $self->variable;
540              
541             return sub {
542             my $iter = $impl->();
543             return $iter->grep(sub {
544             my $r = shift;
545             my $term = $r->value($var);
546             return 0 unless (blessed($term) and $term->does('Attean::API::Term'));
547             return $term->ebv;
548 50     50   76548 });
  50         136  
  50         250  
549 50     50   18169 };
  50         154  
  50         2656  
550 50     50   350 }
  50         130  
  50         294  
551 50     50   26698
  50         125  
  50         234  
552             my $self = shift;
553             my $model = shift;
554             my ($impl) = map { $_->impl($model) } @{ $self->children };
555             my $var = $self->variable;
556             return sub {
557             my $iter = $impl->();
558             return $iter->grep(sub {
559 1     1 0 2 my $r = shift;
560 1         8 my $term = $r->value($var);
561             return 0 unless (blessed($term) and $term->does('Attean::API::Term'));
562 0     0 0 0 return $term->ebv;
563             });
564             };
565 0     0 0 0 }
566 0         0 }
567 0         0  
568 0         0 =item * L<Attean::Plan::Merge>
  0         0  
  0         0  
569 0         0  
570             Evaluates a set of sub-plans, returning the merged union of results, preserving
571             ordering.
572 0     0   0  
573             =cut
574 0         0  
575 0         0 use Moo;
576 0 0 0     0 use Scalar::Util qw(blessed);
577 0         0 use Types::Standard qw(Str ArrayRef ConsumerOf);
578 0         0 use namespace::clean;
579 0         0
580             with 'Attean::API::Plan', 'Attean::API::BinaryQueryTree';
581             with 'Attean::API::UnionScopeVariablesPlan';
582              
583 0     0 0 0 has 'variables' => (is => 'ro', isa => ArrayRef[Str], required => 1);
584 0         0  
585 0         0
  0         0  
  0         0  
586 0         0 my $self = shift;
587             my $model = shift;
588 0     0   0 my @children = map { $_->impl($model) } @{ $self->children };
589             return sub {
590 0         0 die "Unimplemented";
591 0         0 };
592 0 0 0     0 }
593 0         0 }
594 0         0  
595 0         0 =item * L<Attean::Plan::Union>
596              
597             Evaluates a set of sub-plans, returning the union of results.
598              
599             =cut
600              
601             use Moo;
602             use Scalar::Util qw(blessed);
603             use namespace::clean;
604            
605             with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::BinaryQueryTree';
606             with 'Attean::API::UnionScopeVariablesPlan';
607 50     50   46765  
  50         121  
  50         231  
608 50     50   15534
  50         127  
  50         2489  
609 50     50   343 my $self = shift;
  50         120  
  50         282  
610 50     50   31267 my $model = shift;
  50         120  
  50         244  
611             my @children = map { $_->impl($model) } @{ $self->children };
612             return $self->_impl($model, @children);
613             }
614            
615             my $self = shift;
616             my $model = shift;
617 0     0 0 0 my $b = shift;
618             unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) {
619             die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string;
620 0     0 0 0 }
621 0         0
622 0         0 my @children = map { $_->substitute_impl($model, $b) } @{ $self->children };
  0         0  
  0         0  
623             return $self->_impl($model, @children);
624 0     0   0 }
625 0         0
626             my $self = shift;
627             my $model = shift;
628             my @children = @_;
629             my $iter_variables = $self->in_scope_variables;
630              
631             return sub {
632             if (my $current = shift(@children)) {
633             my $iter = $current->();
634             return Attean::CodeIterator->new(
635             item_type => 'Attean::API::Result',
636 50     50   36120 variables => $iter_variables,
  50         117  
  50         208  
637 50     50   16100 generator => sub {
  50         147  
  50         2012  
638 50     50   326 while (blessed($iter)) {
  50         119  
  50         232  
639             my $row = $iter->next();
640             if ($row) {
641             return $row;
642             } else {
643 1     1 0 4 $current = shift(@children);
644             if ($current) {
645             $iter = $current->();
646 0     0 0 0 } else {
647 0         0 undef $iter;
648 0         0 }
  0         0  
  0         0  
649 0         0 }
650             }
651             },
652             );
653 0     0 0 0 } else {
654 0         0 return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => [], values => [], );
655 0         0 }
656 0 0       0 };
  0         0  
  0         0  
657 0         0 }
658             }
659              
660 0         0 =item * L<Attean::Plan::Extend>
  0         0  
  0         0  
661 0         0  
662             Evaluates a sub-plan, and extends each result by evaluating a set of
663             expressions, binding the produced values to new variables.
664              
665 0     0   0 =cut
666 0         0  
667 0         0 use Moo;
668 0         0 use Encode;
669             use UUID::Tiny ':std';
670             use URI::Escape;
671 0 0   0   0 use Data::Dumper;
672 0         0 use I18N::LangTags;
673             use POSIX qw(ceil floor);
674             use Digest::SHA;
675             use Digest::MD5 qw(md5_hex);
676             use Scalar::Util qw(blessed looks_like_number);
677 0         0 use List::MoreUtils qw(uniq all);
678 0         0 use Types::Standard qw(ConsumerOf InstanceOf HashRef);
679 0 0       0 use namespace::clean;
680 0         0  
681             with 'MooX::Log::Any';
682 0         0 with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree';
683 0 0       0 has 'expressions' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Expression']], required => 1);
684 0         0
685            
686 0         0 my $self = shift;
687             my @strings = map { sprintf('?%s ← %s', $_, $self->expressions->{$_}->as_string) } keys %{ $self->expressions };
688             return sprintf('Extend { %s }', join(', ', @strings));
689             }
690            
691 0         0 my $class = shift;
692             my %args = @_;
693 0         0 my $exprs = $args{ expressions };
694             my @vars = map { @{ $_->in_scope_variables } } @{ $args{ children } };
695 0         0 my @evars = (@vars, keys %$exprs);
696            
697             if (exists $args{in_scope_variables}) {
698             Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
699             }
700             $args{in_scope_variables} = [@evars];
701             return $class->SUPER::BUILDARGS(%args);
702             }
703            
704             my $self = shift;
705             my $model = shift;
706             my $expr = shift;
707 50     50   46363 my $r = shift;
  50         130  
  50         211  
708 50     50   14630 Carp::confess unless ($expr->can('operator'));
  50         134  
  50         4256  
709 50     50   366 my $op = $expr->operator;
  50         118  
  50         11106  
710 50     50   368  
  50         117  
  50         2789  
711 50     50   336 state $true = Attean::Literal->true;
  50         158  
  50         2011  
712 50     50   29534 state $false = Attean::Literal->false;
  50         128615  
  50         2387  
713 50     50   379 state $type_roles = { qw(URI IRI IRI IRI BLANK Blank LITERAL Literal NUMERIC NumericLiteral TRIPLE Triple) };
  50         105  
  50         450  
714 50     50   3704 state $type_classes = { qw(URI Attean::IRI IRI Attean::IRI STR Attean::Literal) };
  50         117  
  50         1728  
715 50     50   278
  50         104  
  50         1589  
716 50     50   281 if ($expr->isa('Attean::CastExpression')) {
  50         97  
  50         1922  
717 50     50   305 my $datatype = $expr->datatype->value;
  50         103  
  50         392  
718 50     50   49937 my ($child) = @{ $expr->children };
  50         121  
  50         343  
719 50     50   32506 my $term = $self->evaluate_expression($model, $child, $r);
  50         131  
  50         360  
720              
721             if ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#string$>) {
722             my $value = $term->value;
723             if ($term->does('Attean::API::IRI')) {
724             return Attean::Literal->new(value => $term->value);
725             } elsif ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
726             my $v = ($value eq 'true' or $value eq '1') ? 'true' : 'false';
727 0     0 0 0 return Attean::Literal->new(value => $v);
728 0         0 } elsif ($term->does('Attean::API::NumericLiteral')) {
  0         0  
  0         0  
729 0         0 my $v = $term->numeric_value();
730             if ($v == int($v)) {
731 0     0 0 0 return Attean::Literal->new(value => int($v));
732             }
733             }
734 10     10 0 12932
735 10         38 return Attean::Literal->new(value => $value);
736 10         21 }
737 10         19  
  10         17  
  10         48  
  10         26  
738 10         37 die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::Literal'));
739             if ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#(integer|float|double|decimal)>) {
740 10 50       30 my $value = $term->value;
741 0         0 my $num;
742             if ($datatype eq 'http://www.w3.org/2001/XMLSchema#integer') {
743 10         27 if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
744 10         53 $value = ($value eq 'true' or $value eq '1') ? '1' : '0';
745             } elsif ($term->does('Attean::API::NumericLiteral')) {
746             my $v = $term->numeric_value();
747             $v =~ s/[.].*$//;
748 0     0 0 0 $value = int($v);
749 0         0 } elsif ($value =~ /^[-+]\d+$/) {
750 0         0 my ($v) = "$value";
751 0         0 $v =~ s/[.].*$//;
752 0 0       0 $value = int($v);
753 0         0 }
754             $num = $value;
755 0         0 } elsif ($datatype eq 'http://www.w3.org/2001/XMLSchema#decimal') {
756 0         0 if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
757 0         0 $value = ($value eq 'true') ? '1' : '0';
758 0         0 } elsif ($term->does('Attean::API::NumericLiteral')) {
759             $value = $term->numeric_value;
760 0 0       0 } elsif (looks_like_number($value)) {
    0          
    0          
    0          
    0          
    0          
761 0         0 if ($value =~ /[eE]/) { # double
762 0         0 die "cannot cast to xsd:decimal as precision would be lost";
  0         0  
763 0         0 }
764             $value = +$value;
765 0 0       0 }
766 0         0 $num = "$value";
767 0 0       0 $num =~ s/[.]0+$/.0/;
    0          
    0          
768 0         0 $num =~ s/[.](\d+)0*$/.$1/;
769             } elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#(float|double)$>) {
770 0 0 0     0 my $typename = $1;
771 0         0 if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
772             $value = ($value eq 'true') ? '1.0' : '0.0';
773 0         0 } elsif ($term->does('Attean::API::NumericLiteral')) {
774 0 0       0 # no-op
775 0         0 } elsif (looks_like_number($value)) {
776             $value = +$value;
777             } else {
778             die "cannot cast unrecognized value '$value' to xsd:$typename";
779 0         0 }
780             $num = sprintf("%e", $value);
781             }
782 0 0 0     0 my $c = Attean::Literal->new(value => $num, datatype => $expr->datatype);
783 0 0       0 if (my $term = $c->canonicalized_term()) {
    0          
    0          
784 0         0 return $term;
785 0         0 } else {
786 0 0       0 die "Term value is not a valid lexical form for $datatype";
    0          
    0          
787 0 0       0 }
    0          
    0          
788 0 0 0     0 } elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#boolean$>) {
789             if ($term->does('Attean::API::NumericLiteral')) {
790 0         0 my $value = $term->numeric_value;
791 0         0 return ($value == 0) ? Attean::Literal->false : Attean::Literal->true;
792 0         0 } else {
793             my $value = $term->value;
794 0         0 if ($value =~ m/^(true|false|0|1)$/) {
795 0         0 return ($value eq 'true' or $value eq '1') ? Attean::Literal->true : Attean::Literal->false;
796 0         0 } else {
797             die "Bad lexical form for xsd:boolean: '$value'";
798 0         0 }
799             }
800 0 0       0 } elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#dateTime$>) {
    0          
    0          
801 0 0       0 my $value = $term->value;
802             my $c = Attean::Literal->new(value => $value, datatype => $expr->datatype);
803 0         0 if ($c->does('Attean::API::DateTimeLiteral') and $c->datetime) {
804             return $c;
805 0 0       0 } else {
806 0         0 die "Bad lexical form for xsd:dateTime: '$value'";
807             }
808 0         0 }
809             $self->log->warn("Cast expression unimplemented for $datatype: " . Dumper($expr));
810 0         0 } elsif ($expr->isa('Attean::ValueExpression')) {
811 0         0 my $node = $expr->value;
812 0         0 if ($node->does('Attean::API::Variable')) {
813             return $r->value($node->value);
814 0         0 } else {
815 0 0       0 return $node;
    0          
    0          
816 0 0       0 }
817             } elsif ($expr->isa('Attean::UnaryExpression')) {
818             my ($child) = @{ $expr->children };
819             my $term = $self->evaluate_expression($model, $child, $r);
820 0         0 if ($op eq '!') {
821             return ($term->ebv) ? $false : $true;
822 0         0 } elsif ($op eq '-' or $op eq '+') {
823             die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::NumericLiteral'));
824 0         0 my $v = $term->numeric_value;
825             return Attean::Literal->new( value => eval "$op$v", datatype => $term->datatype );
826 0         0 }
827 0 0       0 die "Unimplemented UnaryExpression evaluation: " . $expr->operator;
828 0         0 } elsif ($expr->isa('Attean::BinaryExpression')) {
829             my $op = $expr->operator;
830 0         0 if ($op eq '&&') {
831             foreach my $child (@{ $expr->children }) {
832             my $term = $self->evaluate_expression($model, $child, $r);
833 0 0       0 unless ($term->ebv) {
834 0         0 return $false;
835 0 0       0 }
836             }
837 0         0 return $true;
838 0 0       0 } elsif ($op eq '||') {
839 0 0 0     0 foreach my $child (@{ $expr->children }) {
840             my $term = $self->evaluate_expression($model, $child, $r);
841 0         0 if (blessed($term) and $term->ebv) {
842             return $true;
843             }
844             }
845 0         0 return $false;
846 0         0 } elsif ($op eq '=') {
847 0 0 0     0 my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
848 0         0 return $lhs->equals($rhs) ? $true : $false; # TODO: this may not be using value-space comparision for numerics...
849             } elsif ($op eq '!=') {
850 0         0 my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
851             return not($lhs->equals($rhs)) ? $true : $false; # TODO: this may not be using value-space comparision for numerics...
852             } elsif ($op =~ m#[<>]=?#) {
853 0         0 my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
854             my $cmp = $lhs->compare($rhs);
855 0         0 if ($cmp < 0) {
856 0 0       0 return ($op =~ /^<=?/) ? $true : $false;
857 0         0 } elsif ($cmp > 0) {
858             return ($op =~ /^>=?/) ? $true : $false;
859 0         0 } else {
860             return ($op =~ /=/) ? $true : $false;
861             }
862 0         0 } elsif ($op =~ m<^[-+*/]$>) {
  0         0  
863 0         0 my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
864 0 0 0     0 die "TypeError $op" unless all { blessed($_) and $_->does('Attean::API::NumericLiteral') } ($lhs, $rhs);
    0          
865 0 0       0 my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs);
866             my $type = $lhs->binary_promotion_type($rhs, $op);
867 0 0 0     0 if ($op eq '+') {
868 0         0 return Attean::Literal->new(value => ($lv + $rv), datatype => $type);
869 0         0 } elsif ($op eq '-') {
870             return Attean::Literal->new(value => ($lv - $rv), datatype => $type);
871 0         0 } elsif ($op eq '*') {
872             return Attean::Literal->new(value => ($lv * $rv), datatype => $type);
873 0         0 } elsif ($op eq '/') {
874 0 0       0 return Attean::Literal->new(value => ($lv / $rv), datatype => $type);
    0          
    0          
    0          
    0          
    0          
875 0         0 }
  0         0  
876 0         0 }
877 0 0       0
878 0         0 $self->log->warn("Binary operator $op expression evaluation unimplemented: " . Dumper($expr));
879             die "Expression evaluation unimplemented: " . $expr->as_string;
880             } elsif ($expr->isa('Attean::FunctionExpression')) {
881 0         0 my $func = $expr->operator;
882             if ($func eq 'IF') {
883 0         0 my ($check, @children) = @{ $expr->children };
  0         0  
884 0         0 my ($term) = $self->evaluate_expression($model, $check, $r);
885 0 0 0     0 $self->log->warn($@) if ($@);
886 0         0 my $expr = $children[ (blessed($term) and $term->ebv) ? 0 : 1 ];
887             my $value = $self->evaluate_expression($model, $expr, $r);
888             # warn '############# ' . $value->as_string;
889 0         0 return $value;
890             } elsif ($func eq 'COALESCE') {
891 0         0 # warn "COALESCE: . " . $r->as_string . "\n";
  0         0  
  0         0  
892 0 0       0 foreach my $child (@{ $expr->children }) {
893             # warn '- ' . $child->as_string . "\n";
894 0         0 my $term = eval { $self->evaluate_expression($model, $child, $r) };
  0         0  
  0         0  
895 0 0       0 # warn $@ if $@;
896             if (blessed($term)) {
897 0         0 # warn ' returning ' . $term->as_string . "\n";
  0         0  
  0         0  
898 0         0 return $term;
899 0 0       0 }
    0          
900 0 0       0 }
901             # warn " no value\n";
902 0 0       0 return;
903             }
904 0 0       0
905             my @terms = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
906             if ($func =~ /^IS([UI]RI|BLANK|LITERAL|NUMERIC|TRIPLE)$/) {
907 0         0 my $role = "Attean::API::$type_roles->{$1}";
  0         0  
  0         0  
908 0 0   0   0 my $t = shift(@terms);
  0 0       0  
909 0         0 my $ok = (blessed($t) and $t->does($role));
  0         0  
910 0         0 return $ok ? $true : $false;
911 0 0       0 } elsif ($func eq 'REGEX') {
    0          
    0          
    0          
912 0         0 my ($string, $pattern, $flags) = @terms;
913             # my ($string, $pattern, $flags) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
914 0         0 # TODO: ensure that $string is a literal
915             ($string, $pattern, $flags) = map { blessed($_) ? $_->value : '' } ($string, $pattern, $flags);
916 0         0 my $re;
917             if ($flags =~ /i/) {
918 0         0 $re = qr/$pattern/i;
919             } else {
920             $re = qr/$pattern/;
921             }
922 0         0 return ($string =~ $re) ? $true : $false;
923 0         0 } elsif ($func =~ /^(NOT)?IN$/) {
924             my $ok = ($func eq 'IN') ? $true : $false;
925 0         0 my $notok = ($func eq 'IN') ? $false : $true;
926 0 0       0 # my @children = @{ $expr->children };
    0          
927 0         0 my ($term, @children) = @terms;
  0         0  
928 0         0 # my ($term) = $self->evaluate_expression($model, shift(@children), $r);
929 0 0       0 # foreach my $child (@{ $expr->children }) {
930 0 0 0     0 foreach my $value (@children) {
931 0         0 # my $value = $self->evaluate_expression($model, $child, $r);
932             if ($term->equals($value)) {
933 0         0 return $ok;
934             }
935             }
936 0         0 return $notok;
  0         0  
937             } elsif ($func eq 'NOW') {
938 0         0 my $dt = DateTime->now;
  0         0  
939             my $value = DateTime::Format::W3CDTF->new->format_datetime( $dt );
940 0 0       0 return Attean::Literal->new(value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#dateTime');
941             } elsif ($func eq 'STR') {
942 0         0 my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
943             return Attean::Literal->new(value => $term->value);
944             } elsif ($func =~ /^[UI]RI$/) { # IRI URI
945             my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
946 0         0 return Attean::IRI->new(value => $term->value, base => $expr->base);
947             } elsif ($func eq 'ABS') {
948             my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
949 0         0 my $value = abs($string->numeric_value);
  0         0  
  0         0  
950 0 0       0 return Attean::Literal->new(value => $value, datatype => $string->datatype);
    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          
    0          
    0          
    0          
    0          
951 0         0 } elsif ($func eq 'ROUND') {
952 0         0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
953 0   0     0 my $value = $string->numeric_value;
954 0 0       0 my $mult = 1;
955             if ($value < 0) {
956 0         0 $mult = -1;
957             $value = -$value;
958             }
959 0 0       0 my $round = $mult * POSIX::floor($value + 0.50000000000008);
  0         0  
960 0         0 return Attean::Literal->new(value => $round, datatype => $string->datatype);
961 0 0       0 } elsif ($func eq 'CEIL') {
962 0         0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
963             my $value = ceil($string->numeric_value);
964 0         0 return Attean::Literal->new(value => $value, datatype => $string->datatype);
965             } elsif ($func eq 'FLOOR') {
966 0 0       0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
967             my $value = floor($string->numeric_value);
968 0 0       0 return Attean::Literal->new(value => $value, datatype => $string->datatype);
969 0 0       0 } elsif ($func eq 'CONCAT') {
970             my @strings = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
971 0         0 # die "CONCAT called with terms that are not argument compatible" unless ($strings[0]->argument_compatible(@strings));
972             my %args;
973             if (my $l = $strings[0]->language) {
974 0         0 $args{language} = $l;
975             } else {
976 0 0       0 my $dt = $strings[0]->datatype;
977 0         0 if ($dt->value eq '') {
978             $args{datatype} = 'http://www.w3.org/2001/XMLSchema#string';
979             }
980 0         0 }
981             foreach my $s (@strings) {
982 0         0 die unless ($s->does('Attean::API::Literal'));
983 0         0 die if ($s->datatype and not($s->datatype->value =~ m<http://www.w3.org/(1999/02/22-rdf-syntax-ns#langString|2001/XMLSchema#string)>));
984 0         0 if (my $l2 = $s->language) {
985             if (my $l1 = $args{language}) {
986 0         0 if ($l1 ne $l2) {
  0         0  
  0         0  
987 0         0 delete $args{language};
988             }
989 0         0 }
  0         0  
  0         0  
990 0         0 } else {
991             delete $args{language};
992 0         0 }
  0         0  
  0         0  
993 0         0 }
994 0         0 my $c = Attean::Literal->new(value => join('', map { $_->value } @strings), %args);
995             return $c;
996 0         0 } elsif ($func eq 'DATATYPE') {
  0         0  
  0         0  
997 0         0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
998 0         0 die unless ($string->does('Attean::API::Literal'));
999 0 0       0 return $string->datatype;
1000 0         0 } elsif ($func eq 'LANG') {
1001 0         0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1002             die unless ($string->does('Attean::API::Literal'));
1003 0         0 my $value = $string->language // '';
1004 0         0 return Attean::Literal->new(value => $value);
1005             } elsif ($func eq 'LANGMATCHES') {
1006 0         0 my ($term, $pat) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
  0         0  
  0         0  
1007 0         0 my $lang = $term->value;
1008 0         0 my $match = $pat->value;
1009             if ($match eq '*') {
1010 0         0 # """A language-range of "*" matches any non-empty language-tag string."""
  0         0  
  0         0  
1011 0         0 return $lang ? $true : $false;
1012 0         0 } else {
1013             return (I18N::LangTags::is_dialect_of( $lang, $match )) ? $true : $false;
1014 0         0 }
  0         0  
  0         0  
1015            
1016 0         0 } elsif ($func eq 'ENCODE_FOR_URI') {
1017 0 0       0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1018 0         0 return Attean::Literal->new(value => uri_escape_utf8($string->value));
1019             } elsif ($func =~ /^[LU]CASE$/) {
1020 0         0 my $term = shift(@terms);
1021 0 0       0 my $value = ($func eq 'LCASE') ? lc($term->value) : uc($term->value);
1022 0         0 return Attean::Literal->new(value => $value, $term->construct_args);
1023             } elsif ($func eq 'STRLANG') {
1024             my ($term, $lang) = @terms;
1025 0         0 die unless ($term->does('Attean::API::Literal'));
1026 0 0       0 die unless ($term->datatype->value =~ m<http://www.w3.org/(1999/02/22-rdf-syntax-ns#langString|2001/XMLSchema#string)>);
1027 0 0 0     0 die if ($term->language);
1028 0 0       0 return Attean::Literal->new(value => $term->value, language => $lang->value);
1029 0 0       0 } elsif ($func eq 'STRDT') {
1030 0 0       0 my ($term, $dt) = @terms;
1031 0         0 die unless ($term->does('Attean::API::Literal'));
1032             die unless ($term->datatype->value =~ m<http://www.w3.org/(1999/02/22-rdf-syntax-ns#langString|2001/XMLSchema#string)>);
1033             die if ($term->language);
1034             # my ($term, $dt) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1035 0         0 return Attean::Literal->new(value => $term->value, datatype => $dt->value);
1036             } elsif ($func eq 'REPLACE') {
1037             my ($term, $pat, $rep) = @terms;
1038 0         0 die unless ($term->does('Attean::API::Literal'));
  0         0  
1039 0         0 die unless ($term->language or $term->datatype->value =~ m<http://www.w3.org/(1999/02/22-rdf-syntax-ns#langString|2001/XMLSchema#string)>);
1040             # my ($term, $pat, $rep) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1041 0         0 my $value = $term->value;
  0         0  
  0         0  
1042 0 0       0 my $pattern = $pat->value;
1043 0         0 my $replace = $rep->value;
1044             die 'REPLACE() called with unsafe ?{} match pattern' if (index($pattern, '(?{') != -1 or index($pattern, '(??{') != -1);
1045 0         0 die 'REPLACE() called with unsafe ?{} replace pattern' if (index($replace, '(?{') != -1 or index($replace, '(??{') != -1);
  0         0  
  0         0  
1046 0 0       0  
1047 0   0     0 $replace =~ s/\\/\\\\/g;
1048 0         0 $replace =~ s/\$(\d+)/\$$1/g;
1049             $replace =~ s/"/\\"/g;
1050 0         0 $replace = qq["$replace"];
  0         0  
  0         0  
1051 0         0 no warnings 'uninitialized';
1052 0         0 $value =~ s/$pattern/"$replace"/eeg;
1053 0 0       0 # warn "==> " . Dumper($value);
1054             return Attean::Literal->new(value => $value, $term->construct_args);
1055 0 0       0 } elsif ($func eq 'SUBSTR') {
1056             my ($term, @args) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1057 0 0       0 my $value = $term->value;
1058             my @nums;
1059             foreach my $i (0 .. $#args) {
1060             my $argnum = $i + 2;
1061 0         0 my $arg = $args[ $i ];
  0         0  
  0         0  
1062 0         0 push(@nums, $arg->numeric_value);
1063             }
1064 0         0 $nums[0]--;
1065 0 0       0 my $substring = (scalar(@nums) > 1) ? substr($value, $nums[0], $nums[1]) : substr($value, $nums[0]);
1066 0         0 return Attean::Literal->new(value => $substring, $term->construct_args);
1067             } elsif ($func eq 'CONTAINS') {
1068 0         0 my ($term, $pattern) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1069 0 0       0 if ($term->has_language and $pattern->has_language) {
1070 0 0       0 if ($term->literal_value_language ne $pattern->literal_value_language) {
1071 0 0       0 die "CONTAINS called with literals of different languages";
1072 0         0 }
1073             }
1074 0         0 my ($string, $pat) = map { $_->value } ($term, $pattern);
1075 0 0       0 my $pos = index($string, $pat);
1076 0 0       0 return ($pos >= 0) ? $true : $false;
1077 0 0       0 } elsif ($func eq 'STRSTARTS') {
1078             my (@terms) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1079 0         0 my ($string, $pat) = map { $_->value } @terms;
1080             return (substr($string, 0, length($pat)) eq $pat) ? $true : $false;
1081 0         0 } elsif ($func eq 'STRENDS') {
1082 0 0       0 my (@terms) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1083 0 0 0     0 my ($string, $pat) = map { $_->value } @terms;
1084             return (substr($string, length($string) - length($pat)) eq $pat) ? $true : $false;
1085 0         0 } elsif ($func eq 'STRAFTER') {
1086 0         0 my ($term, $pat) = @terms;
1087 0         0 die "STRAFTER called without a literal" unless ($term->does('Attean::API::Literal'));
1088 0 0 0     0 die "STRAFTER called without a plain literal" unless ($term->language or $term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string');
1089 0 0 0     0 die "$func arguments are not term compatible: " . join(', ', map { $_->as_string } @terms) unless ($term->argument_compatible($pat));
1090             # TODO: check that the terms are argument compatible
1091 0         0 my $value = $term->value;
1092 0         0 my $match = $pat->value;
1093 0         0 my $i = index($value, $match, 0);
1094 0         0 if ($i < 0) {
1095 50     50   223498 return Attean::Literal->new(value => '');
  50         152  
  50         163022  
1096 0         0 } else {
  0         0  
1097             return Attean::Literal->new(value => substr($value, $i+length($match)), $term->construct_args);
1098 0         0 }
1099             } elsif ($func eq 'STRBEFORE') {
1100 0         0 my ($term, $pat) = @terms;
  0         0  
  0         0  
1101 0         0 die "STRBEFORE called without a literal" unless ($term->does('Attean::API::Literal'));
1102 0         0 die "STRBEFORE called without a plain literal" unless ($term->language or $term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string');
1103 0         0 die "$func arguments are not term compatible: " . join(', ', map { $_->as_string } @terms) unless ($term->argument_compatible($pat));
1104 0         0 # TODO: check that the terms are argument compatible
1105 0         0 my $value = $term->value;
1106 0         0 my $match = $pat->value;
1107             my $i = index($value, $match, 0);
1108 0         0 if ($i < 0) {
1109 0 0       0 return Attean::Literal->new(value => '');
1110 0         0 } else {
1111             return Attean::Literal->new(value => substr($value, 0, $i), $term->construct_args);
1112 0         0 }
  0         0  
  0         0  
1113 0 0 0     0 } elsif ($func eq 'STRLEN') {
1114 0 0       0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1115 0         0 return Attean::Literal->new(value => length($string->value), datatype => 'http://www.w3.org/2001/XMLSchema#integer');
1116             } elsif ($func eq 'MD5') {
1117             my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1118 0         0 my $bytes = encode('UTF-8', $string->value, Encode::FB_CROAK);
  0         0  
1119 0         0 return Attean::Literal->new(value => md5_hex($bytes));
1120 0 0       0 } elsif ($func =~ /^SHA(\d+)$/) {
1121             my $sha = Digest::SHA->new($1);
1122 0         0 my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
  0         0  
  0         0  
1123 0         0 my $bytes = encode('UTF-8', $string->value, Encode::FB_CROAK);
  0         0  
1124 0 0       0 $sha->add($bytes);
1125             return Attean::Literal->new(value => $sha->hexdigest);
1126 0         0 } elsif ($func eq 'RAND') {
  0         0  
  0         0  
1127 0         0 return Attean::Literal->new(value => rand(), datatype => 'http://www.w3.org/2001/XMLSchema#double');
  0         0  
1128 0 0       0 } elsif ($func =~ /^(YEAR|MONTH|DAY|HOUR|MINUTE)S?$/) {
1129             my $method = lc($1);
1130 0         0 my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1131 0 0       0 my $dt = $term->datetime;
1132 0 0 0     0 return Attean::Literal->new(value => $dt->$method(), datatype => 'http://www.w3.org/2001/XMLSchema#integer');
1133 0 0       0 } elsif ($func eq 'SECONDS') {
  0         0  
1134             my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1135 0         0 my $dt = $term->datetime;
1136 0         0 return Attean::Literal->new(value => $dt->second, datatype => 'http://www.w3.org/2001/XMLSchema#decimal');
1137 0         0 } elsif ($func eq 'TIMEZONE') {
1138 0 0       0 my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1139 0         0 my $dt = $term->datetime;
1140             my $tz = $dt->time_zone;
1141 0         0 die "TIMEZONE called with a dateTime without a timezone" if ($tz->is_floating);
1142             my $offset = $tz->offset_for_datetime( $dt );
1143             my $minus = '';
1144 0         0 if ($offset < 0) {
1145 0 0       0 $minus = '-';
1146 0 0 0     0 $offset = -$offset;
1147 0 0       0 }
  0         0  
1148              
1149 0         0 my $duration = "${minus}PT";
1150 0         0 if ($offset >= 60*60) {
1151 0         0 my $h = int($offset / (60*60));
1152 0 0       0 $duration .= "${h}H" if ($h > 0);
1153 0         0 $offset = $offset % (60*60);
1154             }
1155 0         0 if ($offset >= 60) {
1156             my $m = int($offset / 60);
1157             $duration .= "${m}M" if ($m > 0);
1158 0         0 $offset = $offset % 60;
  0         0  
  0         0  
1159 0         0 }
1160             my $s = int($offset);
1161 0         0 $duration .= "${s}S" if ($s > 0 or $duration eq 'PT');
  0         0  
  0         0  
1162 0         0
1163 0         0 return Attean::Literal->new(value => $duration, datatype => 'http://www.w3.org/2001/XMLSchema#dayTimeDuration');
1164             } elsif ($func eq 'TZ') {
1165 0         0 my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1166 0         0 my $dt = $term->datetime;
  0         0  
  0         0  
1167 0         0 my $tz = $dt->time_zone;
1168 0         0 return Attean::Literal->new(value =>'') if ($tz->is_floating);
1169 0         0 return Attean::Literal->new('Z') if ($tz->is_utc);
1170             my $offset = $tz->offset_for_datetime( $dt );
1171 0         0 my $hours = 0;
1172             my $minutes = 0;
1173 0         0 my $minus = '+';
1174 0         0 if ($offset < 0) {
  0         0  
  0         0  
1175 0         0 $minus = '-';
1176 0         0 $offset = -$offset;
1177             }
1178 0         0  
  0         0  
  0         0  
1179 0         0 if ($offset >= 60*60) {
1180 0         0 $hours = int($offset / (60*60));
1181             $offset = $offset % (60*60);
1182 0         0 }
  0         0  
  0         0  
1183 0         0 if ($offset >= 60) {
1184 0         0 $minutes = int($offset / 60);
1185 0 0       0 $offset = $offset % 60;
1186 0         0 }
1187 0         0 my $seconds = int($offset);
1188 0 0       0 return Attean::Literal->new(value => sprintf('%s%02d:%02d', $minus, $hours, $minutes));
1189 0         0 } elsif ($func eq 'UUID') {
1190 0         0 my $uuid = 'urn:uuid:' . uc(uuid_to_string(create_uuid()));
1191             return Attean::IRI->new(value => $uuid);
1192             } elsif ($func eq 'STRUUID') {
1193 0         0 return Attean::Literal->new(value => uc(uuid_to_string(create_uuid())));
1194 0 0       0 } elsif ($func eq 'BNODE') {
1195 0         0 if (scalar(@{ $expr->children })) {
1196 0 0       0 my $string = $self->evaluate_expression($model, $expr->children->[0], $r);
1197 0         0 my $value = $string->value;
1198             my $b = (exists $r->eval_stash->{'sparql:bnode'}{$value})
1199 0 0       0 ? $r->eval_stash->{'sparql:bnode'}{$value}
1200 0         0 : Attean::Blank->new();
1201 0 0       0 $r->eval_stash->{'sparql:bnode'}{$value} = $b;
1202 0         0 return $b;
1203             } else {
1204 0         0 return Attean::Blank->new();
1205 0 0 0     0 }
1206             } elsif ($func eq 'SAMETERM') {
1207 0         0 my @operands = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1208             my ($a, $b) = @operands;
1209 0         0 die "TypeError: SAMETERM" unless (blessed($operands[0]) and blessed($operands[1]));
  0         0  
  0         0  
1210 0         0 if ($a->compare($b)) {
1211 0         0 return $false;
1212 0 0       0 }
1213 0 0       0 if ($a->does('Attean::API::Binding')) {
1214 0         0 my $ok = ($a->sameTerms($b));
1215 0         0 return $ok ? $true : $false;
1216 0         0 } else {
1217 0         0 my $ok = ($a->value eq $b->value);
1218 0 0       0 return $ok ? $true : $false;
1219 0         0 }
1220 0         0 } elsif ($func =~ /^(SUBJECT|PREDICATE|OBJECT)$/) {
1221             my @operands = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1222             my $pos = lc($func);
1223 0 0       0 my $term = $operands[0]->$pos();
1224 0         0 return $term;
1225 0         0 } elsif ($func eq 'INVOKE') {
1226             my @operands = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children };
1227 0 0       0 my $furi = shift(@operands)->value;
1228 0         0 my $func = Attean->get_global_function($furi);
1229 0         0 unless (ref($func)) {
1230             die "No extension registered for <$furi>";
1231 0         0 }
1232 0         0 return $func->(@operands);
1233             } else {
1234 0         0 warn "Expression evaluation unimplemented: " . $expr->as_string;
1235 0         0 $self->log->warn("Expression evaluation unimplemented: " . $expr->as_string);
1236             die "Expression evaluation unimplemented: " . $expr->as_string;
1237 0         0 }
1238             } elsif ($expr->isa('Attean::ExistsPlanExpression')) {
1239 0 0       0 my $plan = $expr->plan;
  0         0  
1240 0         0 my $impl = $plan->substitute_impl($model, $r);
1241 0         0 my $iter = $impl->();
1242             my $found = 0;
1243 0 0       0 if (my $row = $iter->next) {
1244             # warn "EXISTS found row: " . $row->as_string;
1245 0         0 $found++;
1246 0         0 }
1247            
1248 0         0 return $found ? Attean::Literal->true : Attean::Literal->false;
1249             } else {
1250             $self->log->warn("Expression evaluation unimplemented: " . $expr->as_string);
1251 0         0 die "Expression evaluation unimplemented: " . $expr->as_string;
  0         0  
  0         0  
1252 0         0 }
1253 0 0 0     0 }
1254 0 0       0
1255 0         0 my $self = shift;
1256             my $model = shift;
1257 0 0       0 my $bind = shift;
1258 0         0 my %exprs = %{ $self->expressions };
1259 0 0       0 my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children };
1260             # TODO: substitute variables in the expression
1261 0         0 return $self->_impl($model, $impl, %exprs);
1262 0 0       0 }
1263            
1264             my $self = shift;
1265 0         0 my $model = shift;
  0         0  
  0         0  
1266 0         0 my %exprs = %{ $self->expressions };
1267 0         0 my ($impl) = map { $_->impl($model) } @{ $self->children };
1268 0         0 return $self->_impl($model, $impl, %exprs);
1269             }
1270 0         0
  0         0  
  0         0  
1271 0         0 my $self = shift;
1272 0         0 my $model = shift;
1273 0 0       0 my $impl = shift;
1274 0         0 my %exprs = @_;
1275             my $iter_variables = $self->in_scope_variables;
1276 0         0  
1277             return sub {
1278 0         0 my $iter = $impl->();
1279 0         0 return Attean::CodeIterator->new(
1280 0         0 item_type => 'Attean::API::Result',
1281             variables => $iter_variables,
1282             generator => sub {
1283 0         0 ROW: while (my $r = $iter->next) {
1284 0         0 # warn 'Extend Row -------------------------------> ' . $r->as_string;
1285 0         0 my %row = map { $_ => $r->value($_) } $r->variables;
1286 0         0 foreach my $var (keys %exprs) {
1287 0 0       0 my $expr = $exprs{$var};
1288             # warn "-> $var => " . $expr->as_string;
1289 0         0 my $term = eval { $self->evaluate_expression($model, $expr, $r) };
1290             # warn $@ if ($@);
1291             if (blessed($term)) {
1292 0 0       0 # warn "===> " . $term->as_string;
1293             if ($row{ $var } and $term->as_string ne $row{ $var }->as_string) {
1294 0         0 next ROW;
1295 0         0 }
1296            
1297             if ($term->does('Attean::API::Binding')) {
1298             # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple)
1299             $term = $term->ground($r);
1300 0     0 0 0 }
1301 0         0
1302 0         0 $row{ $var } = $term;
1303 0         0 }
  0         0  
1304 0         0 }
  0         0  
  0         0  
1305             return Attean::Result->new( bindings => \%row, eval_stash => $r->eval_stash );
1306 0         0 }
1307             return;
1308             }
1309             );
1310 0     0 0 0 };
1311 0         0 }
1312 0         0 }
  0         0  
1313 0         0  
  0         0  
  0         0  
1314 0         0 =item * L<Attean::Plan::HashDistinct>
1315              
1316             Evaluates a sub-plan, and returns distinct results by checking a persistent
1317             hash of already-seen results.
1318 0     0   0  
1319 0         0 =cut
1320 0         0  
1321 0         0 use Moo;
1322 0         0 use namespace::clean;
1323            
1324             with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1325 0     0   0 with 'Attean::API::UnionScopeVariablesPlan';
1326              
1327            
1328             my $self = shift;
1329             my $model = shift;
1330 0         0 my ($impl) = map { $_->impl($model) } @{ $self->children };
1331             my %seen;
1332 0         0 return sub {
  0         0  
1333 0         0 my $iter = $impl->();
1334 0         0 return $iter->grep(sub { return not($seen{ shift->as_string }++); });
1335             };
1336 0         0 }
  0         0  
1337             }
1338 0 0       0  
1339             =item * L<Attean::Plan::Unique>
1340 0 0 0     0  
1341 0         0 Evaluates an already-ordered sub-plan, and returns distinct results by
1342             filtering out sequential duplicates.
1343              
1344 0 0       0 =cut
1345              
1346 0         0 use Moo;
1347             use namespace::clean;
1348            
1349 0         0 with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1350             with 'Attean::API::UnionScopeVariablesPlan';
1351              
1352 0         0
1353             my $self = shift;
1354 0         0 my $model = shift;
1355             my ($impl) = map { $_->impl($model) } @{ $self->children };
1356 0         0 return sub {
1357 0         0 my $iter = $impl->();
1358             my $last = '';
1359             return $iter->grep(sub {
1360             my $r = shift;
1361             my $s = $r->as_string;
1362             my $ok = $s ne $last;
1363             $last = $s;
1364             return $ok;
1365             });
1366             };
1367             }
1368             }
1369 50     50   76273  
  50         122  
  50         361  
1370 50     50   16029 =item * L<Attean::Plan::Slice>
  50         134  
  50         250  
1371              
1372             Evaluates a sub-plan, and returns the results after optionally skipping some
1373             number of results ("offset") and limiting the total number of returned results
1374             ("limit").
1375 0     0 0 0  
1376             =cut
1377              
1378 0     0 0 0 use Moo;
1379 0         0 use Types::Standard qw(Int);
1380 0         0 use namespace::clean;
  0         0  
  0         0  
1381 0         0
1382             with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1383 0     0   0 with 'Attean::API::UnionScopeVariablesPlan';
1384 0         0  
  0         0  
1385 0         0 has 'limit' => (is => 'ro', isa => Int, default => -1);
1386             has 'offset' => (is => 'ro', isa => Int, default => 0);
1387              
1388             my $self = shift;
1389             my @str;
1390             push(@str, "Limit=" . $self->limit) if ($self->limit >= 0);
1391             push(@str, "Offset=" . $self->offset) if ($self->offset > 0);
1392             return sprintf('Slice { %s }', join(' ', @str));
1393             }
1394            
1395             my $self = shift;
1396             my $model = shift;
1397 50     50   30876 my ($impl) = map { $_->impl($model) } @{ $self->children };
  50         121  
  50         228  
1398 50     50   14799 my $offset = $self->offset;
  50         109  
  50         236  
1399             my $limit = $self->limit;
1400             return sub {
1401             my $iter = $impl->();
1402             $iter = $iter->offset($offset) if ($offset > 0);
1403 0     0 0 0 $iter = $iter->limit($limit) if ($limit >= 0);
1404             return $iter;
1405             };
1406 0     0 0 0 }
1407 0         0 }
1408 0         0  
  0         0  
  0         0  
1409             =item * L<Attean::Plan::Project>
1410 0     0   0  
1411 0         0 Evaluates a sub-plan and returns projected results by only keeping a fixed-set
1412             of variable bindings in each result.
1413 0         0  
1414 0         0 =cut
1415 0         0  
1416 0         0 use Moo;
1417 0         0 with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree';
1418 0         0 use Types::Standard qw(ArrayRef ConsumerOf);
1419 0         0 has 'variables' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']], required => 1);
1420              
1421             my $class = shift;
1422             my %args = @_;
1423             my @vars = map { $_->value } @{ $args{variables} };
1424            
1425             if (exists $args{in_scope_variables}) {
1426             Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
1427             }
1428             $args{in_scope_variables} = \@vars;
1429              
1430             return $class->SUPER::BUILDARGS(%args);
1431             }
1432 50     50   32616
  50         132  
  50         222  
1433 50     50   15343 # sub BUILD {
  50         135  
  50         673  
1434 50     50   23398 # my $self = shift;
  50         135  
  50         249  
1435             # my @vars = map { $_->value } @{ $self->variables };
1436             # unless (scalar(@vars)) {
1437             # Carp::confess "No vars in project?";
1438             # }
1439             # }
1440            
1441             my $self = shift;
1442             return sprintf('Project { %s }', join(' ', map { '?' . $_->value } @{ $self->variables }));
1443 0     0 0 0 }
1444 0         0
1445 0 0       0 my $self = shift;
1446 0 0       0 my $model = shift;
1447 0         0 my $bind = shift;
1448             my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children };
1449             my @vars = map { $_->value } @{ $self->variables };
1450             my $iter_variables = $self->in_scope_variables;
1451 0     0 0 0  
1452 0         0 # TODO: substitute variables in the projection where appropriate
1453 0         0 return sub {
  0         0  
  0         0  
1454 0         0 my $iter = $impl->();
1455 0         0 return $iter->map(sub {
1456             my $r = shift;
1457 0     0   0 my $b = { map { my $t = $r->value($_); $t ? ($_ => $t) : () } @vars };
1458 0 0       0 return Attean::Result->new( bindings => $b );
1459 0 0       0 }, $iter->item_type, variables => $iter_variables);
1460 0         0 };
1461 0         0 }
1462            
1463             my $self = shift;
1464             my $model = shift;
1465             my ($impl) = map { $_->impl($model) } @{ $self->children };
1466             my @vars = map { $_->value } @{ $self->variables };
1467             my $iter_variables = $self->in_scope_variables;
1468              
1469             return sub {
1470             my $iter = $impl->();
1471             return $iter->map(sub {
1472             my $r = shift;
1473 50     50   37320 my $b = { map { my $t = $r->value($_); $t ? ($_ => $t) : () } @vars };
  50         159  
  50         222  
1474             return Attean::Result->new( bindings => $b );
1475 50     50   15658 }, $iter->item_type, variables => $iter_variables);
  50         156  
  50         288  
1476             };
1477             }
1478             }
1479 10     10 0 16508  
1480 10         45 =item * L<Attean::Plan::OrderBy>
1481 10         20  
  16         59  
  10         27  
1482             Evaluates a sub-plan and returns the results after fully materializing and
1483 10 50       36 sorting is applied.
1484 0         0  
1485             =cut
1486 10         25  
1487             use Moo;
1488 10         59 use Types::Standard qw(HashRef ArrayRef InstanceOf Bool Str);
1489             use Scalar::Util qw(blessed);
1490             use namespace::clean;
1491            
1492             with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1493             with 'Attean::API::UnionScopeVariablesPlan';
1494              
1495             has 'variables' => (is => 'ro', isa => ArrayRef[Str], required => 1);
1496             has 'ascending' => (is => 'ro', isa => HashRef[Bool], required => 1);
1497              
1498             my $self = shift;
1499             my @vars = @{ $self->variables };
1500 0     0 0 0 my $ascending = $self->ascending;
1501 0         0 my @strings = map { sprintf('%s(?%s)', ($ascending->{$_} ? 'ASC' : 'DESC'), $_) } @vars;
  0         0  
  0         0  
1502             return sprintf('Order { %s }', join(', ', @strings));
1503 0     0 0 0 }
1504            
1505             my $self = shift;
1506 0     0 0 0 my $vars = shift;
1507 0         0 my $ascending = shift;
1508 0         0 my $rows = shift;
1509 0         0 local($Attean::API::Binding::ALLOW_IRI_COMPARISON) = 1;
  0         0  
  0         0  
1510 0         0 my @sorted = map { $_->[0] } sort {
  0         0  
  0         0  
1511 0         0 my ($ar, $avalues) = @$a;
1512             my ($br, $bvalues) = @$b;
1513             my $c = 0;
1514             foreach my $i (0 .. $#{ $vars }) {
1515 0     0   0 my $ascending = $ascending->{ $vars->[$i] };
1516             my ($av, $bv) = map { $_->[$i] } ($avalues, $bvalues);
1517 0         0  
1518 0 0       0 # Mirrors code in Attean::SimpleQueryEvaluator->evaluate
  0         0  
  0         0  
1519 0         0 if (blessed($av) and $av->does('Attean::API::Binding') and (not(defined($bv)) or not($bv->does('Attean::API::Binding')))) {
1520 0         0 $c = 1;
1521 0         0 } elsif (blessed($bv) and $bv->does('Attean::API::Binding') and (not(defined($av)) or not($av->does('Attean::API::Binding')))) {
1522             $c = -1;
1523             } else {
1524             $c = eval { $av ? $av->compare($bv) : 1 };
1525 2     2 0 5 if ($@) {
1526 2         4 $c = 1;
1527 2         4 }
  2         8  
  2         7  
1528 2         4 }
  2         8  
  2         7  
1529 2         6 $c *= -1 unless ($ascending);
1530             last unless ($c == 0);
1531             }
1532 2     2   6 $c
1533             } map {
1534 2         5 my $r = $_;
1535 2 50       5 [$r, [map { $r->value($_) } @$vars]]
  2         6  
  2         11  
1536 2         35 } @$rows;
1537 2         88 return @sorted;
1538 2         10 }
1539            
1540             my $self = shift;
1541             my $model = shift;
1542             my $vars = $self->variables;
1543             my $ascending = $self->ascending;
1544             my ($impl) = map { $_->impl($model) } @{ $self->children };
1545             my $iter_variables = $self->in_scope_variables;
1546              
1547             return sub {
1548             my $iter = $impl->();
1549             my @rows = $iter->elements;
1550 50     50   55369 my @sorted = $self->sort_rows($vars, $ascending, \@rows);
  50         150  
  50         264  
1551 50     50   15298 return Attean::ListIterator->new(
  50         149  
  50         328  
1552 50     50   40505 values => \@sorted,
  50         108  
  50         2525  
1553 50     50   317 variables => $iter_variables,
  50         132  
  50         281  
1554             item_type => $iter->item_type
1555             );
1556             }
1557             }
1558             }
1559              
1560             =item * L<Attean::Plan::Service>
1561              
1562 1     1 0 3 Evaluates a SPARQL query against a remote endpoint.
1563 1         2  
  1         4  
1564 1         4 =cut
1565 1 50       2  
  1         7  
1566 1         6 use Moo;
1567             use Types::Standard qw(ConsumerOf Bool Str InstanceOf);
1568             use Encode qw(encode);
1569             use Scalar::Util qw(blessed);
1570 0     0 0 0 use URI::Escape;
1571 0         0 use Attean::SPARQLClient;
1572 0         0 use namespace::clean;
1573 0         0  
1574 0         0 with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1575 0         0  
1576 0         0 has 'endpoint' => (is => 'ro', isa => ConsumerOf['Attean::API::TermOrVariable'], required => 1);
1577 0         0 has 'silent' => (is => 'ro', isa => Bool, default => 0);
1578 0         0 has 'sparql' => (is => 'ro', isa => Str, required => 1);
1579 0         0 has 'user_agent' => (is => 'rw', isa => InstanceOf['LWP::UserAgent']);
  0         0  
1580 0         0 has 'request_signer' => (is => 'rw');
1581 0         0  
  0         0  
1582             my $self = shift;
1583             my $sparql = $self->sparql;
1584 0 0 0     0 $sparql =~ s/\s+/ /g;
    0 0        
      0        
      0        
      0        
      0        
1585 0         0 return sprintf('Service <%s> %s', $self->endpoint->as_string, $sparql);
1586             }
1587 0         0
1588             my $self = shift;
1589 0 0       0 my $model = shift;
  0         0  
1590 0 0       0  
1591 0         0 my $endpoint = $self->endpoint->value;
1592             my $sparql = $self->sparql;
1593             my $silent = $self->silent;
1594 0 0       0 my %args = (
1595 0 0       0 endpoint => $endpoint,
1596             silent => $silent,
1597             request_signer => $self->request_signer,
1598             );
1599 0         0 $args{user_agent} = $self->user_agent if ($self->user_agent);
  0         0  
1600 0         0 my $client = Attean::SPARQLClient->new(%args);
  0         0  
1601             return sub {
1602 0         0 return $client->query($sparql);
1603             };
1604             }
1605             }
1606 0     0 0 0  
1607 0         0 =item * L<Attean::Plan::Table>
1608 0         0  
1609 0         0 Returns a constant set of results.
1610 0         0  
  0         0  
  0         0  
1611 0         0 =cut
1612              
1613             use Moo;
1614 0     0   0 use Types::Standard qw(ArrayRef ConsumerOf);
1615 0         0 use namespace::clean;
1616 0         0  
1617 0         0 with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1618              
1619             has variables => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']]);
1620             has rows => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Result']]);
1621              
1622             my $self = shift;
1623 0         0 my $level = shift;
1624             my $indent = ' ' x ($level + 1);
1625             my $vars = join(', ', map { "?$_" } @{ $self->in_scope_variables });
1626             my $s = "Table (" . $vars . ")";
1627             foreach my $row (@{ $self->rows }) {
1628             $s .= "\n-${indent} " . $row->as_string;
1629             }
1630             return $s;
1631             }
1632            
1633 50     50   66236 my $class = shift;
  50         123  
  50         225  
1634 50     50   16132 my %args = @_;
  50         123  
  50         308  
1635 50     50   36544 my @vars = map { $_->value } @{ $args{variables} };
  50         120  
  50         2390  
1636 50     50   325
  50         110  
  50         1866  
1637 50     50   301 if (exists $args{in_scope_variables}) {
  50         113  
  50         2663  
1638 50     50   21097 Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
  50         145  
  50         1618  
1639 50     50   669 }
  50         124  
  50         335  
1640             $args{in_scope_variables} = \@vars;
1641              
1642             return $class->SUPER::BUILDARGS(%args);
1643             }
1644            
1645             my $self = shift;
1646             my $model = shift;
1647             my $rows = $self->rows;
1648             my $iter_variables = $self->in_scope_variables;
1649              
1650 0     0 0 0 return sub {
1651 0         0 return Attean::ListIterator->new(
1652 0         0 item_type => 'Attean::API::Result',
1653 0         0 variables => $iter_variables,
1654             values => $rows
1655             );
1656 0     0 0 0 };
1657             }
1658 0     0 0 0 }
1659 0         0  
1660             =item * L<Attean::Plan::Iterator>
1661 0         0  
1662 0         0 Returns a constant set of results.
1663 0         0  
1664 0         0 Be aware that if the iterator being wrapped is not repeatable (consuming the
1665             L<Attean::API::RepeatableIterator> role), then this plan may only be evaluated
1666             once.
1667              
1668             A size estimate may be given if it is available. If the iterator is an
1669 0 0       0 L<Attean::ListIterator>, the size of that iterator will be used.
1670 0         0  
1671             =cut
1672 0     0   0  
1673 0         0 use Moo;
1674             use Types::Standard qw(ArrayRef ConsumerOf Int);
1675             use namespace::clean;
1676              
1677             with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1678              
1679             has iterator => (is => 'ro', isa => ConsumerOf['Attean::API::ResultIterator']);
1680             has size_estimate => (is => 'lazy', isa => Int, predicate => 1);
1681              
1682             my $self = shift;
1683             my $iter = $self->iterator;
1684 50     50   53359 if ($iter->isa('Attean::ListIterator')) {
  50         113  
  50         236  
1685 50     50   16148 return $iter->size;
  50         149  
  50         435  
1686 50     50   31011 }
  50         132  
  50         224  
1687             }
1688              
1689              
1690             my $self = shift;
1691             my $level = shift;
1692             my $indent = ' ' x ($level + 1);
1693 0     0 0 0 my $string = 'Iterator (';
1694             $string .= join(', ', map { "?$_" } @{ $self->in_scope_variables });
1695 0     0 0 0 if ($self->has_size_estimate) {
1696 0         0 $string .= ' with ' . $self->size_estimate . ' elements';
1697 0         0 }
1698 0         0 $string .= ')';
  0         0  
  0         0  
1699 0         0 return $string;
1700 0         0 }
  0         0  
1701 0         0
1702             my $class = shift;
1703 0         0 my %args = @_;
1704             my $vars = $args{iterator}->variables;
1705            
1706             if (exists $args{in_scope_variables}) {
1707 8     8 0 18332 Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
1708 8         40 }
1709 8         18 $args{in_scope_variables} = $vars;
  0         0  
  8         27  
1710              
1711 8 50       29 return $class->SUPER::BUILDARGS(%args);
1712 0         0 }
1713            
1714 8         24 my $self = shift;
1715             my $model = shift;
1716 8         56 my $iter = $self->iterator;
1717              
1718             return sub {
1719             if ($iter->does('Attean::API::RepeatableIterator')) {
1720 0     0 0 0 $iter->reset;
1721 0         0 }
1722 0         0 return $iter;
1723 0         0 };
1724             }
1725             }
1726 0     0   0  
1727             =item * L<Attean::Plan::ALPPath>
1728              
1729             =cut
1730              
1731 0         0 use Moo;
1732             use Attean::TreeRewriter;
1733             use Types::Standard qw(ArrayRef ConsumerOf);
1734             use namespace::clean;
1735              
1736             has 'subject' => (is => 'ro', required => 1);
1737             has 'object' => (is => 'ro', required => 1);
1738             has 'graph' => (is => 'ro', required => 1);
1739             has 'step_begin' => (is => 'ro', required => 1);
1740             has 'step_end' => (is => 'ro', required => 1);
1741             has 'skip' => (is => 'ro', required => 1, default => 0);
1742             # has 'children' => (is => 'ro', isa => ConsumerOf['Attean::API::BindingSubstitutionPlan'], required => 1);
1743            
1744             with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::NullaryQueryTree';
1745              
1746             with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1747            
1748             my $self = shift;
1749 50     50   46197 my @strings;
  50         135  
  50         233  
1750 50     50   16150 push(@strings, sprintf('%s ← %s', map { $_->ntriples_string } ($self->subject, $self->step_begin)));
  50         144  
  50         287  
1751 50     50   30965 push(@strings, sprintf('%s ← %s', map { $_->ntriples_string } ($self->object, $self->step_end)));
  50         133  
  50         232  
1752             return sprintf('ALPPath %s', join(', ', @strings));
1753             }
1754            
1755             my $class = shift;
1756             my %args = @_;
1757             my @vars = map { $_->value } grep { $_->does('Attean::API::Variable') } (@args{qw(subject object)});
1758            
1759 1     1   1203 if (exists $args{in_scope_variables}) {
1760 1         5 Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
1761 1 50       7 }
1762 1         9 $args{in_scope_variables} = \@vars;
1763              
1764             return $class->SUPER::BUILDARGS(%args);
1765             }
1766            
1767 0     0 0 0 my $model = shift;
1768             my $graph = shift;
1769 4     4 0 6 my $skip = shift;
1770 4         7 my $x = shift;
1771 4         7 my $path = shift;
1772 4         7 my $v = shift;
1773 4         6 my $start = shift;
  4         15  
  4         11  
1774 4 100       13 my $end = shift;
1775 3         43 my $bind = shift;
1776             if (exists $v->{$x->as_string}) {
1777 4         26 return;
1778 4         10 }
1779             my $binding = Attean::Result->new( bindings => { $start => $x } )->join($bind);
1780             unless ($binding) {
1781             return;
1782 5     5 0 5223 }
1783 5         22
1784 5         84 if ($skip) {
1785             $skip--;
1786 5 50       36 } else {
1787 0         0 $v->{$x->as_string} = $x;
1788             }
1789 5         12
1790             my $impl = $path->substitute_impl($model, $binding);
1791 5         24 my $iter = $impl->();
1792             while (my $row = $iter->next()) {
1793             my $n = $row->value($end);
1794             alp($model, $graph, $skip, $n, $path, $v, $start, $end, $bind);
1795 1     1 0 229 }
1796 1         3 }
1797 1         5
1798             my $self = shift;
1799             my $model = shift;
1800 1 50   1   555 my $bind = shift;
1801 1         43 my $path = $self->children->[0];
1802             my $subject = $self->subject;
1803 1         34 my $object = $self->object;
1804 1         6 my $graph = $self->graph;
1805             my $start = $self->step_begin->value;
1806             my $end = $self->step_end->value;
1807             my $skip = $self->skip;
1808             my $iter_variables = $self->in_scope_variables;
1809              
1810             for ($subject, $object) {
1811             if ($_->does('Attean::API::Variable')) {
1812             my $name = $_->value;
1813 50     50   47695 if (my $node = $bind->value($name)) {
  50         131  
  50         258  
1814 50     50   36107 $_ = $node;
  50         174  
  50         1857  
1815 50     50   449 }
  50         109  
  50         357  
1816 50     50   27941 }
  50         122  
  50         359  
1817             }
1818            
1819             my $s_var = $subject->does('Attean::API::Variable');
1820             my $o_var = $object->does('Attean::API::Variable');
1821             if ($s_var and $o_var) {
1822             return sub {
1823             my $nodes = $model->graph_nodes($graph);
1824             my @rows;
1825             while (my $n = $nodes->next) {
1826             my %seen;
1827             alp($model, $graph, $skip, $n, $path, \%seen, $start, $end, $bind);
1828 0     0 0 0 foreach my $term (values %seen) {
1829             my $b = Attean::Result->new( bindings => {
1830             $subject->value => $n,
1831             $object->value => $term,
1832 0     0 0 0 } );
1833 0         0 push(@rows, $b);
1834 0         0 }
  0         0  
1835 0         0 }
  0         0  
1836 0         0 return Attean::ListIterator->new(
1837             item_type => 'Attean::API::Result',
1838             variables => $iter_variables,
1839             values => \@rows,
1840 0     0 0 0 );
1841 0         0 };
1842 0         0 } elsif ($o_var) {
  0         0  
  0         0  
1843             return sub {
1844 0 0       0 my %seen;
1845 0         0 alp($model, $graph, $skip, $subject, $path, \%seen, $start, $end, $bind);
1846             my @rows = map { Attean::Result->new( bindings => { $object->value => $_ } ) } (values %seen);
1847 0         0 return Attean::ListIterator->new(
1848             item_type => 'Attean::API::Result',
1849 0         0 variables => $iter_variables,
1850             values => \@rows,
1851             );
1852             };
1853 0     0 0 0 } elsif ($s_var) {
1854 0         0 die "ALP for FB should never occur in a plan (should be inversed during planning)";
1855 0         0 } else {
1856 0         0 return sub {
1857 0         0 my %seen;
1858 0         0 alp($model, $graph, $skip, $subject, $path, \%seen, $start, $end, $bind);
1859 0         0 if (exists $seen{ $object->as_string }) {
1860 0         0 return Attean::ListIterator->new(
1861 0         0 item_type => 'Attean::API::Result',
1862 0 0       0 variables => $iter_variables,
1863 0         0 values => [Attean::Result->new()]
1864             );
1865 0         0 } else {
1866 0 0       0 return Attean::ListIterator->new(
1867 0         0 item_type => 'Attean::API::Result',
1868             variables => $iter_variables,
1869             values => []
1870 0 0       0 );
1871 0         0 }
1872             };
1873 0         0 }
1874             }
1875             }
1876 0         0  
1877 0         0 use Moo;
1878 0         0 use Attean::TreeRewriter;
1879 0         0 use Types::Standard qw(ArrayRef ConsumerOf);
1880 0         0 use namespace::clean;
1881              
1882             has 'subject' => (is => 'ro', required => 1);
1883             has 'object' => (is => 'ro', required => 1);
1884             has 'graph' => (is => 'ro', required => 1);
1885 0     0 0 0
1886 0         0 with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::NullaryQueryTree';
1887 0         0  
1888 0         0 my $class = shift;
1889 0         0 my %args = @_;
1890 0         0 my @vars = map { $_->value } grep { $_->does('Attean::API::Variable') } (@args{qw(subject object)});
1891 0         0
1892 0         0 if (exists $args{in_scope_variables}) {
1893 0         0 Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
1894 0         0 }
1895 0         0 $args{in_scope_variables} = \@vars;
1896              
1897 0         0 return $class->SUPER::BUILDARGS(%args);
1898 0 0       0 }
1899 0         0
1900 0 0       0 with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1901 0         0
1902            
1903             my $self = shift;
1904             my $model = shift;
1905             my $bind = shift;
1906 0         0 my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children };
1907 0         0 my $iter_variables = $self->in_scope_variables;
1908 0 0 0     0  
    0          
    0          
1909             my $subject = $self->subject;
1910 0     0   0 my $object = $self->object;
1911 0         0 my $graph = $self->graph;
1912 0         0 for ($subject, $object) {
1913 0         0 if ($_->does('Attean::API::Variable')) {
1914 0         0 my $name = $_->value;
1915 0         0 if (my $node = $bind->value($name)) {
1916 0         0 $_ = $node;
1917             }
1918             }
1919             }
1920 0         0  
1921             my $s_var = $subject->does('Attean::API::Variable');
1922             my $o_var = $object->does('Attean::API::Variable');
1923 0         0 return sub {
1924             my @extra;
1925             if ($s_var and $o_var) {
1926             my $nodes = $model->graph_nodes($graph);
1927             while (my $n = $nodes->next) {
1928 0         0 push(@extra, Attean::Result->new( bindings => { map { $_->value => $n } ($subject, $object) } ));
1929             }
1930             } elsif ($s_var) {
1931 0     0   0 push(@extra, Attean::Result->new( bindings => { $subject->value => $object } ));
1932 0         0 } elsif ($o_var) {
1933 0         0 push(@extra, Attean::Result->new( bindings => { $object->value => $subject } ));
  0         0  
1934 0         0 } else {
1935             if (0 == $subject->compare($object)) {
1936             push(@extra, Attean::Result->new( bindings => {} ));
1937             }
1938             }
1939 0         0 my $iter = $impl->();
1940             my %seen;
1941 0         0 return Attean::CodeIterator->new(
1942             item_type => 'Attean::API::Result',
1943             variables => $iter_variables,
1944 0     0   0 generator => sub {
1945 0         0 while (scalar(@extra)) {
1946 0 0       0 my $r = shift(@extra);
1947 0         0 unless ($seen{$r->as_string}++) {
1948             return $r;
1949             }
1950             }
1951             while (my $r = $iter->next()) {
1952             return unless ($r);
1953 0         0 if ($seen{$r->as_string}++) {
1954             next;
1955             }
1956             return $r;
1957             }
1958             }
1959 0         0 );
1960             };
1961             }
1962             }
1963              
1964             =item * L<Attean::Plan::Exists>
1965 50     50   80107  
  50         136  
  50         250  
1966 50     50   16621 Returns an iterator containing a single boolean term indicating whether any
  50         145  
  50         1390  
1967 50     50   320 results were produced by evaluating the sub-plan.
  50         132  
  50         262  
1968 50     50   26999  
  50         146  
  50         277  
1969             =cut
1970              
1971             use Moo;
1972             use Types::Standard qw(ArrayRef ConsumerOf);
1973             use namespace::clean;
1974            
1975             with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
1976             with 'Attean::API::UnionScopeVariablesPlan';
1977 0     0 0 0  
1978 0         0 has variables => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']]);
1979 0         0 has rows => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Result']]);
  0         0  
  0         0  
1980              
1981 0 0       0
1982 0         0 my $self = shift;
1983             my $model = shift;
1984 0         0 my ($impl) = map { $_->impl($model) } @{ $self->children };
1985             return sub {
1986 0         0 my $iter = $impl->();
1987             my $term = ($iter->next) ? Attean::Literal->true : Attean::Literal->false;
1988             return Attean::ListIterator->new(values => [$term], item_type => 'Attean::API::Term');
1989 0     0 0 0 }
1990             }
1991             }
1992 0     0 0 0  
1993             =item * L<Attean::Plan::Aggregate>
1994              
1995 0     0 0 0 =cut
1996 0         0  
1997 0         0 use Moo;
1998 0         0 use Encode;
  0         0  
  0         0  
1999 0         0 use UUID::Tiny ':std';
2000             use URI::Escape;
2001 0         0 use I18N::LangTags;
2002 0         0 use POSIX qw(ceil floor);
2003 0         0 use Digest::SHA;
2004 0         0 use Digest::MD5 qw(md5_hex);
2005 0 0       0 use Scalar::Util qw(blessed);
2006 0         0 use List::MoreUtils qw(uniq);
2007 0 0       0 use Types::Standard qw(ConsumerOf InstanceOf HashRef ArrayRef);
2008 0         0 use namespace::clean;
2009              
2010             with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
2011             has 'aggregates' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Expression']], required => 1);
2012             has 'groups' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Expression']], required => 1);
2013 0         0
2014 0         0 my $self = shift;
2015             my @astrings = map { sprintf('?%s ← %s', $_, $self->aggregates->{$_}->as_string) } keys %{ $self->aggregates };
2016 0     0   0 my @gstrings = map { sprintf('%s', $_->as_string) } @{ $self->groups };
2017 0 0 0     0 return sprintf('Aggregate { %s } Groups { %s }', join(', ', @astrings), join(', ', @gstrings));
    0          
    0          
2018 0         0 }
2019 0         0
2020 0         0 my $class = shift;
  0         0  
2021             my %args = @_;
2022             my $aggs = $args{ aggregates };
2023 0         0 my @vars = map { $_->value } grep { $_->does('Attean::API::Variable') } map { $_->value } @{ $args{groups} // [] };
2024             my @evars = (@vars, keys %$aggs);
2025 0         0 if (exists $args{in_scope_variables}) {
2026             Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
2027 0 0       0 }
2028 0         0 $args{in_scope_variables} = [@evars];
2029             return $class->SUPER::BUILDARGS(%args);
2030             }
2031 0         0
2032 0         0 my $self = shift;
2033             my $model = shift;
2034             my $expr = shift;
2035             my $rows = shift;
2036             my $op = $expr->operator;
2037 0         0 my ($e) = @{ $expr->children };
2038 0         0 # my @children = map { Attean::Plan::Extend->evaluate_expression($model, $_, $r) } @{ $expr->children };
2039 0 0       0 # warn "$op — " . join(' ', map { $_->as_string } @children);
2040 0         0 if ($op eq 'COUNT') {
2041             my $count = 0;
2042             foreach my $r (@$rows) {
2043 0         0 if ($e) {
2044 0 0       0 my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r);
2045 0 0       0 if ($term) {
2046 0         0 $count++;
2047             }
2048 0         0 } else {
2049             # This is the special-case branch for COUNT(*)
2050             $count++;
2051 0         0 }
2052 0         0 }
2053             return Attean::Literal->new(value => $count, datatype => 'http://www.w3.org/2001/XMLSchema#integer');
2054             } elsif ($op eq 'SUM') {
2055             my @cmp;
2056             my @terms;
2057             foreach my $r (@$rows) {
2058             my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r);
2059             if ($term->does('Attean::API::NumericLiteral')) {
2060             push(@terms, $term);
2061             }
2062             }
2063             my $lhs = shift(@terms);
2064 50     50   59758 while (my $rhs = shift(@terms)) {
  50         143  
  50         228  
2065 50     50   15944 my $type = $lhs->binary_promotion_type($rhs, '+');
  50         157  
  50         260  
2066 50     50   26247 my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs);
  50         112  
  50         243  
2067             $lhs = Attean::Literal->new(value => ($lv + $rv), datatype => $type);
2068             }
2069             return $lhs;
2070             } elsif ($op eq 'AVG') {
2071             my @cmp;
2072             my $count = 0;
2073             my $all_ints = 1;
2074 0     0 0 0 my @terms;
2075 0     0 0 0 foreach my $r (@$rows) {
2076             my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r);
2077             die unless ($term->does('Attean::API::NumericLiteral'));
2078 4     4 0 7 push(@terms, $term);
2079 4         6 $count++;
2080 4         8 }
  4         12  
  4         14  
2081             my $lhs = shift(@terms);
2082 4     4   8 while (my $rhs = shift(@terms)) {
2083 4 100       2180 my $type = $lhs->binary_promotion_type($rhs, '+');
2084 4         71 my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs);
2085             $lhs = Attean::Literal->new(value => ($lv + $rv), datatype => $type);
2086 4         17 }
2087            
2088             my $rhs = Attean::Literal->new(value => $count, datatype => 'http://www.w3.org/2001/XMLSchema#integer');
2089             my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs);
2090             my $type = $lhs->binary_promotion_type($rhs, '/');
2091             return Attean::Literal->new(value => ($lv / $rv), datatype => $type);
2092             } elsif ($op eq 'SAMPLE') {
2093             foreach my $r (@$rows) {
2094 50     50   36898 my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r);
  50         121  
  50         282  
2095 50     50   15290 return $term if (blessed($term));
  50         137  
  50         4254  
2096 50     50   372 }
  50         137  
  50         9704  
2097 50     50   343 } elsif ($op =~ /^(MIN|MAX)$/) {
  50         128  
  50         2647  
2098 50     50   387 my @cmp;
  50         99  
  50         1984  
2099 50     50   313 foreach my $r (@$rows) {
  50         114  
  50         440  
2100 50     50   3641 my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r);
  50         154  
  50         1934  
2101 50     50   319 push(@cmp, $term);
  50         129  
  50         2189  
2102 50     50   416 }
  50         117  
  50         2178  
2103 50     50   361 @cmp = sort { $a->compare($b) } @cmp;
  50         108  
  50         412  
2104 50     50   47121 return ($op eq 'MIN') ? shift(@cmp) : pop(@cmp);
  50         137  
  50         236  
2105 50     50   36541 } elsif ($op eq 'GROUP_CONCAT') {
  50         124  
  50         260  
2106             my $sep = $expr->scalar_vars->{seperator} // ' ';
2107             my @values;
2108             foreach my $r (@$rows) {
2109             my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r);
2110             push(@values, $term->value);
2111             }
2112 0     0 0 0 my $string = join($sep, @values);
2113 0         0 return Attean::Literal->new(value => $string);
  0         0  
  0         0  
2114 0         0 } elsif ($op eq 'CUSTOM') {
  0         0  
  0         0  
2115 0         0 my $iri = $expr->custom_iri;
2116             my $data = Attean->get_global_aggregate($iri);
2117 0     0 0 0 unless ($data) {
2118             die "No extension aggregate registered for <$iri>";
2119             }
2120 4     4 0 4766 my $start = $data->{'start'};
2121 4         12 my $process = $data->{'process'};
2122 4         8 my $finalize = $data->{'finalize'};
2123 4   50     5  
  4         98  
  4         11  
  4         14  
  4         14  
2124 4         21 my $thunk = $start->();
2125 4 50       11 foreach my $r (@$rows) {
2126 0         0 my $t = Attean::Plan::Extend->evaluate_expression($model, $e, $r);
2127             $process->($thunk, $t);
2128 4         8 }
2129 4         21 return $finalize->($thunk);
2130             }
2131             die "$op not implemented";
2132             }
2133 0     0 0  
2134 0           my $self = shift;
2135 0           my $model = shift;
2136 0           my %aggs = %{ $self->aggregates };
2137 0           my @groups = @{ $self->groups };
2138 0           my $iter_variables = $self->in_scope_variables;
  0            
2139              
2140             my $group_template_generator = sub {
2141 0 0         my $r = shift;
    0          
    0          
    0          
    0          
    0          
    0          
2142 0           my %components;
2143 0           foreach my $g (@groups) {
2144 0 0         if ($g->isa('Attean::ValueExpression')) {
2145 0           my $value = $g->value;
2146 0 0         if ($value->isa('Attean::Variable')) {
2147 0           my $var = $value->value;
2148             my $value = eval { Attean::Plan::Extend->evaluate_expression($model, $g, $r) };
2149             if (blessed($value)) {
2150             $components{$var} = $value;
2151 0           }
2152             }
2153             }
2154 0           }
2155             return %components;
2156 0           };
2157             my $group_key_generator = sub {
2158 0           my $r = shift;
2159 0           my @components;
2160 0 0         foreach my $g (@groups) {
2161 0           my $value = eval { Attean::Plan::Extend->evaluate_expression($model, $g, $r) };
2162             my $key = blessed($value) ? $value->as_string : '';
2163             push(@components, $key);
2164 0           }
2165 0           my $group = join('|', @components);
2166 0           return $group;
2167 0           };
  0            
2168 0          
2169             my $rank;
2170 0           while (my($var, $agg) = each(%aggs)) {
2171             if ($agg->operator eq 'RANK') {
2172 0           $rank = $var;
2173 0           }
2174 0           }
2175 0          
2176 0           my ($impl) = map { $_->impl($model) } @{ $self->children };
2177 0           my %row_groups;
2178 0 0         my %group_templates;
2179 0           return sub {
2180 0           my $iter = $impl->();
2181             while (my $r = $iter->next) {
2182 0           my $group_key = $group_key_generator->($r);
2183 0           push(@{ $row_groups{ $group_key } }, $r);
2184 0           unless (exists $group_templates{ $group_key }) {
2185 0           $group_templates{ $group_key } = { $group_template_generator->($r) };
  0            
2186 0           }
2187             }
2188             my @group_keys = keys %row_groups;
2189 0          
2190 0           # SPARQL evaluation of aggregates over an empty input sequence should
  0            
2191 0           # result in an empty result <http://answers.semanticweb.com/questions/17410/semantics-of-sparql-aggregates>
2192 0          
2193             my @results;
2194 0           if (scalar(@group_keys) == 0 and scalar(@groups) == 0) {
2195 0           push(@group_keys, '');
2196 0 0         $row_groups{''} = [];
2197             $group_templates{''} = {};
2198             }
2199 0           foreach my $group (@group_keys) {
2200 0           my %row = %{ $group_templates{ $group } };
2201 0           my $rows = $row_groups{$group};
2202 0           if (defined $rank) {
2203             my $agg = $aggs{$rank};
2204 0           my $ascending = $agg->scalar_vars->{ascending} // {};
  0            
2205 0 0         my $vars = [map { $_->value->value } @{ $agg->children }];
2206             # TODO: support ordering by complex expressions in $vars, not just ValueExpressions with variables
2207 0   0       my @sorted = Attean::Plan::OrderBy->sort_rows($vars, $ascending, $rows);
2208 0           my $ord = 0;
2209 0           foreach my $row (@sorted) {
2210 0           my %b = %{ $row->bindings };
2211 0           $b{ $rank } = Attean::Literal->integer($ord++);
2212             my $r = Attean::Result->new( bindings => \%b );
2213 0           push(@results, $r);
2214 0           }
2215             } else {
2216 0           foreach my $var (keys %aggs) {
2217 0           my $expr = $aggs{$var};
2218 0 0         my $value = eval { $self->evaluate_aggregate($model, $expr, $rows) };
2219 0           if ($value) {
2220             $row{$var} = $value;
2221 0           }
2222 0           }
2223 0           my $result = Attean::Result->new( bindings => \%row );
2224             push(@results, $result);
2225 0           }
2226 0           }
2227 0           return Attean::ListIterator->new(
2228 0           values => \@results,
2229             variables => $iter_variables,
2230 0           item_type => 'Attean::API::Result'
2231             );
2232 0           };
2233             }
2234             }
2235              
2236 0     0 0   use Moo;
2237 0           use Scalar::Util qw(blessed);
2238 0           use Types::Standard qw(ConsumerOf ArrayRef);
  0            
2239 0           use namespace::clean;
  0            
2240 0          
2241             with 'Attean::API::Plan', 'Attean::API::QueryTree';
2242             with 'Attean::API::UnionScopeVariablesPlan';
2243 0     0      
2244 0          
2245 0           my $self = shift;
2246 0 0         my $model = shift;
2247 0           my @children = map { $_->impl($model) } @{ $self->children };
2248 0 0         return sub {
2249 0           foreach my $child (@children) {
2250 0           my $iter = $child->();
  0            
2251 0 0         $iter->elements;
2252 0           }
2253             return Attean::ListIterator->new(values => [Attean::Literal->true], item_type => 'Attean::API::Term');
2254             };
2255             }
2256             }
2257 0            
2258 0           use Moo;
2259             use Scalar::Util qw(blessed);
2260 0     0     use Types::Standard qw(ConsumerOf ArrayRef);
2261 0           use namespace::clean;
2262 0          
2263 0           with 'Attean::API::Plan', 'Attean::API::NullaryQueryTree';
  0            
2264 0 0         with 'Attean::API::UnionScopeVariablesPlan';
2265 0            
2266             has 'graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Term']]);
2267 0            
2268 0           my $self = shift;
2269 0           my $level = shift;
2270             my $indent = ' ' x (1+$level);
2271 0           my $s = sprintf("Clear { %d graphs }", scalar(@{ $self->graphs }));
2272 0           foreach my $g (@{ $self->graphs }) {
2273 0 0         my $name = $g->as_sparql;
2274 0           chomp($name);
2275             $s .= "\n-${indent} $name";
2276             }
2277             return $s;
2278 0           }
  0            
  0            
2279 0          
2280             my $self = shift;
2281             my $model = shift;
2282 0     0     my $graphs = $self->graphs;
2283 0           return sub {
2284 0           foreach my $g (@$graphs) {
2285 0           $model->clear_graph($g);
  0            
2286 0 0         }
2287 0           return Attean::ListIterator->new(values => [Attean::Literal->true], item_type => 'Attean::API::Term');
2288             };
2289             }
2290 0           }
2291              
2292             use Moo;
2293             use Scalar::Util qw(blessed);
2294             use Types::Standard qw(ConsumerOf ArrayRef);
2295 0           use namespace::clean;
2296 0 0 0      
2297 0           with 'Attean::API::Plan', 'Attean::API::NullaryQueryTree';
2298 0           with 'Attean::API::UnionScopeVariablesPlan';
2299 0            
2300             has 'graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Term']]);
2301 0            
2302 0           my $self = shift;
  0            
2303 0           my $level = shift;
2304 0 0         my $indent = ' ' x (1+$level);
2305 0           my $s = sprintf("Drop { %d graphs }", scalar(@{ $self->graphs }));
2306 0   0       foreach my $g (@{ $self->graphs }) {
2307 0           $s .= "\n-${indent} " . $g->as_sparql;
  0            
  0            
2308             }
2309 0           return $s;
2310 0           }
2311 0          
2312 0           my $self = shift;
  0            
2313 0           my $model = shift;
2314 0           my $graphs = $self->graphs;
2315 0           return sub {
2316             foreach my $g (@$graphs) {
2317             $model->drop_graph($g);
2318 0           }
2319 0           return Attean::ListIterator->new(values => [Attean::Literal->true], item_type => 'Attean::API::Term');
2320 0           };
  0            
2321 0 0         }
2322 0           }
2323              
2324             use Moo;
2325 0           use Scalar::Util qw(blessed);
2326 0           use Types::Standard qw(ConsumerOf Str ArrayRef HashRef);
2327             use namespace::clean;
2328            
2329 0           with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree';
2330             with 'Attean::API::UnionScopeVariablesPlan';
2331              
2332             has 'order' => (is => 'ro', isa => ArrayRef[Str], required => 1);
2333             has 'patterns' => (is => 'ro', isa => HashRef[ArrayRef[ConsumerOf['Attean::API::TripleOrQuadPattern']]], required => 1);
2334 0           has 'graph' => (is => 'ro', isa => ConsumerOf['Attean::API::Term']);
2335              
2336             my $self = shift;
2337             my $level = shift;
2338             my $indent = ' ' x (1+$level);
2339 50     50   197702 my $s = sprintf("Template-to-Model { Default graph: %s }", $self->graph->as_string);
  50         130  
  50         281  
2340 50     50   16734 foreach my $method (@{ $self->order }) {
  50         133  
  50         2217  
2341 50     50   309 my $pattern = $self->patterns->{ $method };
  50         113  
  50         325  
2342 50     50   26977 $s .= "\n-${indent} Method: ${method}";
  50         146  
  50         246  
2343             foreach my $p (@$pattern) {
2344             $s .= "\n-${indent} " . $p->as_string;
2345             }
2346             }
2347 0     0 0   return $s;
2348             }
2349            
2350 0     0 0   my $self = shift;
2351 0           my $model = shift;
2352 0           my $child = $self->children->[0]->impl($model);
  0            
  0            
2353            
2354 0     0     my $graph = $self->graph;
2355 0           my @order = @{ $self->order };
2356 0           my $method = shift(@order);
2357             my $pattern = $self->patterns->{ $method };
2358 0            
2359 0           return sub {
2360             my $iter = $child->();
2361             my @results;
2362             while (my $t = $iter->next) {
2363             if (scalar(@order)) {
2364 50     50   36478 push(@results, $t);
  50         115  
  50         235  
2365 50     50   15590 }
  50         150  
  50         2374  
2366 50     50   340 foreach my $p (@$pattern) {
  50         106  
  50         307  
2367 50     50   26290 my $q = $p->apply_bindings($t);
  50         150  
  50         270  
2368             my $quad = $q->does('Attean::API::QuadPattern') ? $q : $q->as_quad_pattern($graph);
2369             if ($quad->is_ground) {
2370             # warn "# $method: " . $quad->as_string . "\n";
2371             $model->$method($quad->as_quad);
2372             } else {
2373             # warn "not ground: " . $quad->as_string;
2374             }
2375 0     0 0   }
2376 0           }
2377 0           foreach my $method (@order) {
2378 0           my $pattern = $self->patterns->{ $method };
  0            
2379 0           foreach my $t (@results) {
  0            
2380 0           foreach my $p (@$pattern) {
2381 0           my $q = $p->apply_bindings($t);
2382 0           my $quad = $q->does('Attean::API::QuadPattern') ? $q : $q->as_quad_pattern($graph);
2383             if ($quad->is_ground) {
2384 0           # warn "# $method: " . $quad->as_string . "\n";
2385             $model->$method($quad->as_quad);
2386             } else {
2387             # warn "not ground: " . $quad->as_string;
2388 0     0 0   }
2389 0           }
2390 0           }
2391             }
2392 0     0     return Attean::ListIterator->new(values => [Attean::Literal->integer($model->size)], item_type => 'Attean::API::Term');
2393 0           };
2394             }
2395 0           }
2396 0            
2397             use Moo;
2398             use Encode;
2399             use LWP::UserAgent;
2400             use Scalar::Util qw(blessed);
2401 50     50   41412 use Types::Standard qw(Bool Str);
  50         120  
  50         229  
2402 50     50   15336 use namespace::clean;
  50         155  
  50         2586  
2403 50     50   358
  50         123  
  50         272  
2404 50     50   25884 with 'Attean::API::Plan', 'Attean::API::NullaryQueryTree';
  50         124  
  50         266  
2405             with 'Attean::API::UnionScopeVariablesPlan';
2406              
2407             has 'silent' => (is => 'ro', isa => Bool, default => 0);
2408             has 'url' => (is => 'ro', isa => Str);
2409              
2410             my $self = shift;
2411             return sprintf("Load { %s }", $self->url);
2412 0     0 0   }
2413 0          
2414 0           my $self = shift;
2415 0           my $url = $self->url;
  0            
2416 0           my $ua = LWP::UserAgent->new();
  0            
2417 0           my $silent = $self->silent;
2418             my $accept = Attean->acceptable_parsers( handles => 'Attean::API::Triple' );
2419 0           $ua->default_headers->push_header( 'Accept' => $accept );
2420             return sub {
2421             my $resp = $ua->get( $url );
2422             if ($resp->is_success) {
2423 0     0 0   my $ct = $resp->header('Content-Type');
2424 0           if (my $pclass = Attean->get_parser( media_type => $ct )) {
2425 0           my $p = $pclass->new();
2426             my $str = $resp->decoded_content;
2427 0     0     my $bytes = encode('UTF-8', $str, Encode::FB_CROAK);
2428 0           my $iter = $p->parse_iter_from_bytes( $bytes );
2429             return $iter;
2430 0           }
2431 0           }
2432            
2433             if ($silent) {
2434             return Attean::ListIterator->new(values => [], item_type => 'Attean::API::Triple');
2435             } else {
2436 50     50   40295 die "Failed to load url: " . $resp->status_line;
  50         129  
  50         250  
2437 50     50   15644 }
  50         143  
  50         2536  
2438 50     50   317 };
  50         129  
  50         257  
2439 50     50   36492 }
  50         115  
  50         235  
2440             }
2441              
2442             # Create(iri)
2443              
2444             1;
2445              
2446              
2447             =back
2448              
2449 0     0 0   =head1 BUGS
2450 0            
2451 0           Please report any bugs or feature requests to through the GitHub web interface
2452 0           at L<https://github.com/kasei/attean/issues>.
2453 0            
  0            
2454 0           =head1 SEE ALSO
2455 0            
2456 0            
2457 0            
2458             =head1 AUTHOR
2459              
2460 0           Gregory Todd Williams C<< <gwilliams@cpan.org> >>
2461              
2462             =head1 COPYRIGHT
2463              
2464 0     0 0   Copyright (c) 2014--2022 Gregory Todd Williams.
2465 0           This program is free software; you can redistribute it and/or modify it under
2466 0           the same terms as Perl itself.
2467              
2468 0           =cut