File Coverage

blib/lib/AtteanX/QueryPlanner/Cache.pm
Criterion Covered Total %
statement 67 70 95.7
branch 20 24 83.3
condition 1 3 33.3
subroutine 11 11 100.0
pod 0 2 0.0
total 99 110 90.0


line stmt bran cond sub pod time code
1 11     11   2103378 use 5.010001;
  11         28  
2 11     11   52 use strict;
  11         23  
  11         218  
3 11     11   36 use warnings;
  11         16  
  11         424  
4              
5              
6             package AtteanX::QueryPlanner::Cache;
7 11     11   39 use Class::Method::Modifiers;
  11         16  
  11         796  
8              
9             our $AUTHORITY = 'cpan:KJETILK';
10             our $VERSION = '0.001_04';
11              
12 11     11   58 use Moo;
  11         29  
  11         63  
13 11     11   8846 use Types::Standard qw(InstanceOf);
  11         13  
  11         99  
14 11     11   4428 use Attean::RDF qw(triplepattern variable iri);
  11         16  
  11         608  
15 11     11   47 use Carp;
  11         11  
  11         469  
16 11     11   5020 use AtteanX::Plan::SPARQLBGP;
  11         33895  
  11         7274  
17              
18             extends 'Attean::QueryPlanner';
19             with 'Attean::API::NaiveJoinPlanner', 'Attean::API::SimpleCostPlanner';
20              
21             with 'AtteanX::API::JoinRotatingPlanner', 'MooX::Log::Any';
22              
23             with 'AtteanX::Query::AccessPlan::SingleQuadBGP', 'AtteanX::Query::AccessPlan::Cache';
24              
25             # Only allow rotation on joins who have one child matching: - Either a
26             # Attean::Plan::Quad or AtteanX::Plan::SPARQLBGP and the
27             # other child being a join
28              
29             sub allow_join_rotation {
30 1256     1256 0 2144351 my $self = shift;
31 1256         1409 my $join = shift;
32 1256         1371 my $quads = 0;
33 1256         1065 my $joins = 0;
34 1256         1162 my @grandchildren;
35 1256         4014 $self->log->trace("Seeking to rotate:\n" . $join->as_string);
36 1256         1307815 foreach my $p (@{ $join->children }) {
  1256         3298  
37 2512 50       19383 $quads++ if ($p->isa('Attean::Plan::Quad'));
38 2512 100       6013 $quads++ if ($p->isa('AtteanX::Plan::SPARQLBGP'));
39 2512 100       5044 if ($p->does('Attean::API::Plan::Join')) {
40 1204         12967 $joins++;
41 1204         1176 push(@grandchildren, @{ $p->children });
  1204         2780  
42             }
43             }
44 1256 100       10805 return 0 unless ($joins == 1);
45 1204 100       2072 return 0 unless ($quads == 1);
46 1184         1292 foreach my $p (@grandchildren) {
47 2368 50       6169 $quads++ if ($p->isa('Attean::Plan::Quad'));
48 2368 100       5857 $quads++ if ($p->isa('AtteanX::Plan::SPARQLBGP'));
49             }
50            
51 1184 100       1950 if ($quads >= 2) {
52 1048         3499 $self->log->debug("Allowing rotation for $quads quads.");
53 1048         43184 return 1;
54             } else {
55 136         442 $self->log->debug("Disallowing rotation, just $quads quad.");
56 136         5268 return 0;
57             }
58             }
59              
60             sub coalesce_rotated_join {
61 4032     4032 0 7732821 my $self = shift;
62 4032         4446 my $p = shift;
63 4032         3685 my @quads;
64 4032         3529 my ($lhs, $rhs) = @{ $p->children };
  4032         9472  
65 4032         11225 my @join_vars = $self->_join_vars($lhs, $rhs);
66 4032 100       7664 if (scalar(@join_vars)) {
67 3872         4243 foreach my $q ($lhs, $rhs) {
68 6720 50       28901 if ($q->isa('Attean::Plan::Quad')) {
    100          
69 0         0 push(@quads, $q);
70             } elsif ($q->isa('AtteanX::Plan::SPARQLBGP')) {
71 4672         3698 push(@quads, @{ $q->children });
  4672         9433  
72             } else {
73 2048         8956 return $p; # bail-out
74             }
75             }
76 1824         1768 my $count = scalar(@quads);
77 1824         38855 my $c = AtteanX::Plan::SPARQLBGP->new(children => \@quads, distinct => 0);
78 1824 50 33     456143 if ($self->log->is_debug && $count >= 2) {
79 0         0 $self->log->debug("Coalescing $lhs and $rhs into BGP with $count quads");
80 0         0 $self->log->trace($c->as_string);
81             }
82 1824         62588 return $c;
83             }
84 160         557 return $p;
85             }
86              
87             # Gather patterns into larger BGPs
88             around 'join_plans' => sub {
89             my $orig = shift;
90             my @params = @_;
91             my $self = shift;
92             my $model = shift;
93             my $active_graphs = shift;
94             my $default_graphs = shift;
95             my $lplans = shift;
96             my $rplans = shift;
97             my @restargs = @_;
98             my @plans;
99             foreach my $lhs (@{ $lplans }) {
100             $self->log->trace("BGP Constructing Left:\n" . $lhs->as_string);
101             foreach my $rhs (@{ $rplans }) {
102             $self->log->trace("BGP Constructing Right:\n" . $rhs->as_string);
103             my @join_vars = $self->_join_vars($lhs, $rhs);
104              
105             if ($lhs->isa('Attean::Plan::Iterator') && ($rhs->isa('Attean::Plan::Iterator'))) {
106             # push(@plans, $orig->($self, $model, $active_graphs, $default_graphs, [$rhs], [$lhs], @restargs)); # Most general solution
107             # Best known solution for now:
108             if (scalar(@join_vars) > 0) {
109             return Attean::Plan::HashJoin->new(children => [$lhs, $rhs], join_variables => \@join_vars, distinct => 0, ordered => []);
110             } else {
111             return Attean::Plan::NestedLoopJoin->new(children => [$lhs, $rhs], join_variables => \@join_vars, distinct => 0, ordered => []);
112             }
113             } elsif ($rhs->isa('AtteanX::Plan::SPARQLBGP') &&
114             $lhs->isa('AtteanX::Plan::SPARQLBGP')) {
115             if (scalar(@join_vars)) {
116             push(@plans, AtteanX::Plan::SPARQLBGP->new(children => [@{ $lhs->children || []} , @{ $rhs->children || []} ], distinct => 0, ordered => []));
117             } else {
118             push(@plans, $orig->($self, $model, $active_graphs, $default_graphs, [$lhs], [$rhs], @restargs));
119             }
120             } else {
121             push(@plans, $orig->($self, $model, $active_graphs, $default_graphs, [$lhs], [$rhs], @restargs));
122             }
123              
124             }
125             }
126              
127             unless (@plans) {
128             @plans = $orig->(@params);
129             }
130             return @plans;
131             };
132              
133             1;
134              
135             __END__
136              
137             =pod
138              
139             =encoding utf-8
140              
141             =head1 NAME
142              
143             AtteanX::QueryPlanner::Cache - Extending the query planner with cache and SPARQL support
144              
145             =head1 SYNOPSIS
146              
147             =head1 DESCRIPTION
148              
149             =head1 SEE ALSO
150              
151             =head1 AUTHOR
152              
153             Kjetil Kjernsmo E<lt>kjetilk@cpan.orgE<gt>.
154              
155             =head1 COPYRIGHT AND LICENCE
156              
157             This software is copyright (c) 2015, 2016 by Kjetil Kjernsmo.
158              
159             This is free software; you can redistribute it and/or modify it under
160             the same terms as the Perl 5 programming language system itself.
161              
162              
163             =head1 DISCLAIMER OF WARRANTIES
164              
165             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
166             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
167             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
168