File Coverage

blib/lib/RDF/Query/Algebra/Quad.pm
Criterion Covered Total %
statement 57 107 53.2
branch 7 28 25.0
condition 6 14 42.8
subroutine 14 18 77.7
pod 8 8 100.0
total 92 175 52.5


line stmt bran cond sub pod time code
1             # RDF::Query::Algebra::Quad
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Algebra::Quad - Algebra class for Quad patterns
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Algebra::Quad version 2.916.
11              
12             =cut
13              
14             package RDF::Query::Algebra::Quad;
15              
16 36     36   174 use strict;
  36         68  
  36         898  
17 36     36   175 use warnings;
  36         61  
  36         977  
18 36     36   172 no warnings 'redefine';
  36         69  
  36         1316  
19 36     36   174 use base qw(RDF::Query::Algebra RDF::Trine::Statement::Quad);
  36         69  
  36         3841  
20              
21 36     36   190 use Data::Dumper;
  36         73  
  36         1777  
22 36     36   252 use Carp qw(carp croak confess);
  36         63  
  36         2098  
23 36     36   179 use Scalar::Util qw(blessed reftype refaddr);
  36         62  
  36         2140  
24 36     36   203 use RDF::Trine::Iterator qw(smap sgrep swatch);
  36         67  
  36         2715  
25              
26             ######################################################################
27              
28             my %QUAD_LABELS;
29             our ($VERSION);
30             BEGIN {
31 36     36   40600 $VERSION = '2.916';
32             }
33              
34             ######################################################################
35              
36             =head1 METHODS
37              
38             Beyond the methods documented below, this class inherits methods from the
39             L<RDF::Query::Algebra> class.
40              
41             =over 4
42              
43             =cut
44              
45             =item C<new ( $s, $p, $o, $g )>
46              
47             Returns a new Quad structure.
48              
49             =cut
50              
51             sub new {
52 426     426 1 1056 my $class = shift;
53 426         935 my @nodes = @_;
54 426 50       1095 unless (scalar(@nodes) == 4) {
55 0         0 throw RDF::Query::Error::MethodInvocationError -text => "Quad constructor must have four node arguments";
56             }
57 426         1137 my @names = qw(subject predicate object context);
58 426         950 foreach my $i (0 .. 3) {
59 1704 50 33     9077 unless (defined($nodes[ $i ]) and blessed($nodes[ $i ])) {
60 0         0 $nodes[ $i ] = RDF::Query::Node::Variable->new($names[ $i ]);
61             }
62 1704 100       6794 unless ($nodes[ $i ]->isa('RDF::Query::Node')) {
63 358         1531 $nodes[ $i ] = RDF::Query::Node->from_trine( $nodes[ $i ] );
64             }
65             }
66            
67 426         1952 return $class->SUPER::new( @nodes );
68             }
69              
70             =item C<< as_sparql >>
71              
72             Returns the SPARQL string for this algebra expression.
73              
74             =cut
75              
76             sub as_sparql {
77 110     110 1 177 my $self = shift;
78 110   100     527 my $context = shift || {};
79 110         172 my $indent = shift;
80            
81 110         318 my $pred = $self->predicate;
82 110 100 100     1173 if ($pred->isa('RDF::Trine::Node::Resource') and $pred->uri_value eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type') {
83 8         65 $pred = 'a';
84             } else {
85 102         986 $pred = $pred->as_sparql( $context );
86             }
87            
88 110         563 my $string = sprintf(
89             "%s %s %s .",
90             $self->subject->as_sparql( $context ),
91             $pred,
92             $self->object->as_sparql( $context ),
93             );
94 110         2077 return $string;
95             }
96              
97             =item C<< as_hash >>
98              
99             Returns the query as a nested set of plain data structures (no objects).
100              
101             =cut
102              
103             sub as_hash {
104 0     0 1 0 my $self = shift;
105 0         0 my $context = shift;
106             return {
107             type => lc($self->type),
108 0         0 nodes => [ map { $_->as_hash } $self->nodes ],
  0         0  
109             };
110             }
111              
112             =item C<< referenced_blanks >>
113              
114             Returns a list of the blank node names used in this algebra expression.
115              
116             =cut
117              
118             sub referenced_blanks {
119 10     10 1 18 my $self = shift;
120 10         43 my @nodes = $self->nodes;
121 10         64 my @blanks = grep { $_->isa('RDF::Trine::Node::Blank') } @nodes;
  40         164  
122 10         35 return map { $_->blank_identifier } @blanks;
  0         0  
123             }
124              
125             =item C<< qualify_uris ( \%namespaces, $base_uri ) >>
126              
127             Returns a new algebra pattern where all referenced Resource nodes representing
128             QNames (ns:local) are qualified using the supplied %namespaces.
129              
130             =cut
131              
132             sub qualify_uris {
133 0     0 1 0 my $self = shift;
134 0         0 my $class = ref($self);
135 0         0 my $ns = shift;
136 0         0 my $base_uri = shift;
137 0         0 my @nodes;
138 0         0 foreach my $n ($self->nodes) {
139 0         0 my $blessed = blessed($n);
140 0 0 0     0 if ($blessed and $n->isa('RDF::Query::Node::Resource')) {
    0 0        
141 0         0 my $uri = $n->uri;
142 0 0       0 if (ref($uri)) {
143 0         0 my ($n,$l) = @$uri;
144 0 0       0 unless (exists($ns->{ $n })) {
145 0         0 throw RDF::Query::Error::QuerySyntaxError -text => "Namespace $n is not defined";
146             }
147 0         0 my $resolved = RDF::Query::Node::Resource->new( join('', $ns->{ $n }, $l), $base_uri );
148 0         0 push(@nodes, $resolved);
149             } else {
150 0         0 push(@nodes, $n);
151             }
152             } elsif ($blessed and $n->isa('RDF::Query::Node::Literal')) {
153 0         0 my $node = $n;
154 0         0 my $dt = $node->literal_datatype;
155 0 0       0 if (ref($dt)) {
156 0         0 my ($n,$l) = @$dt;
157 0 0       0 unless (exists($ns->{ $n })) {
158 0         0 throw RDF::Query::Error::QuerySyntaxError -text => "Namespace $n is not defined";
159             }
160 0         0 my $resolved = RDF::Query::Node::Resource->new( join('', $ns->{ $n }, $l), $base_uri );
161 0         0 my $lit = RDF::Query::Node::Literal->new( $node->literal_value, undef, $resolved->uri_value );
162 0         0 push(@nodes, $lit);
163             } else {
164 0         0 push(@nodes, $node);
165             }
166             } else {
167 0         0 push(@nodes, $n);
168             }
169             }
170 0         0 return $class->new( @nodes );
171             }
172              
173             =item C<< bf () >>
174              
175             Returns a string representing the state of the nodes of the triple (bound or free).
176              
177             =cut
178              
179             sub bf {
180 0     0 1 0 my $self = shift;
181 0         0 my $bf = '';
182 0         0 foreach my $n ($self->nodes) {
183 0 0       0 $bf .= ($n->isa('RDF::Query::Node::Variable'))
184             ? 'f'
185             : 'b';
186             }
187 0         0 return $bf;
188             }
189              
190             =item C<< distinguish_bnode_variables >>
191              
192             Returns a new Quad object with blank nodes replaced by distinguished variables.
193              
194             =cut
195              
196             sub distinguish_bnode_variables {
197 80     80 1 145 my $self = shift;
198 80         157 my $class = ref($self);
199 80         286 my @nodes = $self->nodes;
200 80         531 foreach my $i (0 .. $#nodes) {
201 320 50       1584 if ($nodes[$i]->isa('RDF::Query::Node::Blank')) {
202 0         0 $nodes[$i] = $nodes[$i]->make_distinguished_variable;
203             }
204             }
205 80         300 return $class->new( @nodes );
206             }
207              
208             =item C<< label ( $label => $value ) >>
209              
210             Sets the named C<< $label >> to C<< $value >> for this quad object.
211             If no C<< $value >> is given, returns the current label value, or undef if none
212             exists.
213              
214             =cut
215              
216             sub label {
217 0     0 1 0 my $self = shift;
218 0         0 my $addr = refaddr($self);
219 0         0 my $label = shift;
220 0 0       0 if (@_) {
221 0         0 my $value = shift;
222 0         0 $QUAD_LABELS{ $addr }{ $label } = $value;
223             }
224 0 0       0 if (exists $QUAD_LABELS{ $addr }) {
225 0         0 return $QUAD_LABELS{ $addr }{ $label };
226             } else {
227 0         0 return;
228             }
229             }
230              
231             sub DESTROY {
232 426     426   646 my $self = shift;
233 426         970 my $addr = refaddr( $self );
234 426         1824 delete $QUAD_LABELS{ $addr };
235             }
236              
237              
238             1;
239              
240             __END__
241              
242             =back
243              
244             =head1 AUTHOR
245              
246             Gregory Todd Williams <gwilliams@cpan.org>
247              
248             =cut