File Coverage

blib/lib/RDF/Query/Functions/SPARQL.pm
Criterion Covered Total %
statement 402 835 48.1
branch 160 406 39.4
condition 15 266 5.6
subroutine 50 88 56.8
pod 1 1 100.0
total 628 1596 39.3


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             RDF::Query::Functions::SPARQL - SPARQL built-in functions
4              
5             =head1 VERSION
6              
7             This document describes RDF::Query::Functions::SPARQL version 2.915_01.
8              
9             =head1 DESCRIPTION
10              
11             Defines the following functions:
12              
13             =over 4
14              
15             =item * sparql:abs
16              
17             =item * sparql:bnode
18              
19             =item * sparql:bound
20              
21             =item * sparql:ceil
22              
23             =item * sparql:coalesce
24              
25             =item * sparql:concat
26              
27             =item * sparql:contains
28              
29             =item * sparql:datatype
30              
31             =item * sparql:ebv
32              
33             =item * sparql:strends
34              
35             =item * sparql:floor
36              
37             =item * sparql:encode_for_uri
38              
39             =item * sparql:exists
40              
41             =item * sparql:in
42              
43             =item * sparql:iri
44              
45             =item * sparql:isblank
46              
47             =item * sparql:isiri
48              
49             =item * sparql:isliteral
50              
51             =item * sparql:isuri
52              
53             =item * sparql:isNumeric
54              
55             =item * sparql:lang
56              
57             =item * sparql:langmatches
58              
59             =item * sparql:lcase
60              
61             =item * sparql:logical-and
62              
63             =item * sparql:logical-or
64              
65             =item * sparql:notin
66              
67             =item * sparql:rand
68              
69             =item * sparql:regex
70              
71             =item * sparql:round
72              
73             =item * sparql:sameterm
74              
75             =item * sparql:strstarts
76              
77             =item * sparql:str
78              
79             =item * sparql:strdt
80              
81             =item * sparql:strlang
82              
83             =item * sparql:strlen
84              
85             =item * sparql:substr
86              
87             =item * sparql:ucase
88              
89             =item * sparql:uri
90              
91             =item * sparql:uuid
92              
93             =item * sparql:struuid
94              
95             =cut
96              
97             package RDF::Query::Functions::SPARQL;
98              
99 35     35   53524 use strict;
  35         85  
  35         907  
100 35     35   228 use warnings;
  35         77  
  35         931  
101 35     35   178 use Log::Log4perl;
  35         75  
  35         250  
102             our ($VERSION, $l);
103             BEGIN {
104 35     35   2985 $l = Log::Log4perl->get_logger("rdf.query.functions.sparql");
105 35         14759 $VERSION = '2.915_01';
106             }
107              
108 35     35   230 use POSIX;
  35         109  
  35         361  
109 35     35   102456 use Encode;
  35         87  
  35         3313  
110 35     35   206 use URI::Escape;
  35         68  
  35         2085  
111 35     35   190 use Carp qw(carp croak confess);
  35         88  
  35         2100  
112 35     35   200 use Data::Dumper;
  35         102  
  35         1627  
113 35     35   199 use I18N::LangTags;
  35         72  
  35         1281  
114 35     35   193 use List::Util qw(sum);
  35         76  
  35         2271  
115 35     35   182 use Scalar::Util qw(blessed reftype refaddr looks_like_number);
  35         67  
  35         2127  
116 35     35   192 use DateTime::Format::W3CDTF;
  35         74  
  35         941  
117 35     35   197 use RDF::Trine::Namespace qw(rdf xsd);
  35         79  
  35         528  
118 35     35   4663 use Digest::MD5 qw(md5_hex);
  35         76  
  35         1741  
119 35     35   198 use Digest::SHA qw(sha1_hex sha224_hex sha256_hex sha384_hex sha512_hex);
  35         81  
  35         2365  
120 35     35   26192 use Data::UUID;
  35         27244  
  35         2482  
121              
122 35     35   241 use RDF::Query::Error qw(:try);
  35         80  
  35         353  
123 35     35   5449 use RDF::Query::Node qw(iri literal);
  35         80  
  35         353346  
124              
125             =begin private
126              
127             =item C<< install >>
128              
129             Documented in L<RDF::Query::Functions>.
130              
131             =end private
132              
133             =cut
134              
135             sub install {
136             RDF::Query::Functions->install_function(
137             "http://www.w3.org/2001/XMLSchema#integer",
138             sub {
139 7     7   13 my $query = shift;
140 7         10 my $node = shift;
141 7         10 my $value;
142 7 100 66     73 if (blessed($node) and $node->isa('RDF::Trine::Node::Literal')) {
143 6   100     30 my $type = $node->literal_datatype || '';
144 6         215 $value = $node->literal_value;
145 6 100       55 if ($type eq 'http://www.w3.org/2001/XMLSchema#boolean') {
    100          
    50          
146 2 100       8 $value = ($value eq 'true') ? '1' : '0';
147             } elsif ($node->is_numeric_type) {
148 2 50       13 if ($type eq 'http://www.w3.org/2001/XMLSchema#double') {
    100          
149 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => "cannot cast to xsd:integer as precision would be lost" );
150             } elsif (int($value) != $value) {
151 1         14 throw RDF::Query::Error::FilterEvaluationError ( -text => "cannot cast to xsd:integer as precision would be lost" );
152             } else {
153 1         6 $value = $node->numeric_value;
154             }
155             } elsif (looks_like_number($value)) {
156 2 50       48 if ($value =~ /[eE]/) { # double
    50          
157 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => "cannot to xsd:integer as precision would be lost" );
158             } elsif (int($value) != $value) {
159 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => "cannot to xsd:integer as precision would be lost" );
160             }
161             } else {
162 0         0 throw RDF::Query::Error::TypeError ( -text => "cannot cast unrecognized value '$value' to xsd:integer" );
163             }
164 5         27 return RDF::Query::Node::Literal->new( "$value", undef, 'http://www.w3.org/2001/XMLSchema#integer' );
165             } else {
166 1         23 throw RDF::Query::Error::TypeError ( -text => "cannot cast node to xsd:integer" );
167             }
168             }
169 35     35 1 309 );
170            
171             RDF::Query::Functions->install_function(
172             "http://www.w3.org/2001/XMLSchema#decimal",
173             sub {
174 23     23   33 my $query = shift;
175 23         37 my $node = shift;
176 23         29 my $value;
177 23 100       85 if ($node->is_literal) {
178 22   100     204 my $type = $node->literal_datatype || '';
179 22         165 $value = $node->literal_value;
180 22 100       176 if ($type eq 'http://www.w3.org/2001/XMLSchema#boolean') {
    100          
    50          
181 2 100       8 $value = ($value eq 'true') ? '1' : '0';
182             } elsif ($node->is_numeric_type) {
183 1 50       4 if ($type eq 'http://www.w3.org/2001/XMLSchema#double') {
184 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => "cannot to xsd:decimal as precision would be lost" );
185             } else {
186 1         5 $value = $node->numeric_value;
187             }
188             } elsif (looks_like_number($value)) {
189 19 50       234 if ($value =~ /[eE]/) { # double
190 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => "cannot to xsd:decimal as precision would be lost" );
191             }
192             } else {
193 0         0 throw RDF::Query::Error::TypeError ( -text => "cannot cast unrecognized value '$value' to xsd:decimal" );
194             }
195 22         96 return RDF::Query::Node::Literal->new( "$value", undef, 'http://www.w3.org/2001/XMLSchema#decimal' );
196             } else {
197 1         15 throw RDF::Query::Error::TypeError ( -text => "cannot cast node to xsd:integer" );
198             }
199             }
200 35         270 );
201            
202             RDF::Query::Functions->install_function(
203             "http://www.w3.org/2001/XMLSchema#float",
204             sub {
205 30     30   51 my $query = shift;
206 30         38 my $node = shift;
207 30         40 my $value;
208 30 100       97 if ($node->is_literal) {
    50          
209 29         270 $value = $node->literal_value;
210 29   100     198 my $type = $node->literal_datatype || '';
211 29 100       248 if ($type eq 'http://www.w3.org/2001/XMLSchema#boolean') {
    100          
    100          
    50          
212 2 100       8 $value = ($value eq 'true') ? '1.0' : '0.0';
213             } elsif ($node->is_numeric_type) {
214             # noop
215             } elsif (not $node->has_datatype) {
216 7 50       122 if (looks_like_number($value)) {
217 7         12 $value = +$value;
218             } else {
219 0         0 throw RDF::Query::Error::TypeError ( -text => "cannot cast unrecognized value '$value' to xsd:float" );
220             }
221             } elsif (not $node->is_numeric_type) {
222 1         7 throw RDF::Query::Error::TypeError ( -text => "cannot cast unrecognized value '$value' to xsd:float" );
223             }
224             } elsif ($node->is_resource) {
225 1         31 throw RDF::Query::Error::TypeError ( -text => "cannot cast an IRI to xsd:integer" );
226             }
227            
228 28         254 my $num = sprintf("%e", $value);
229 28         96 return RDF::Query::Node::Literal->new( $num, undef, 'http://www.w3.org/2001/XMLSchema#float' );
230             }
231 35         292 );
232            
233             RDF::Query::Functions->install_function(
234             "http://www.w3.org/2001/XMLSchema#double",
235             sub {
236 5     5   7 my $query = shift;
237 5         9 my $node = shift;
238 5         7 my $value;
239 5 100       18 if ($node->is_literal) {
    50          
    0          
240 4         38 $value = $node->literal_value;
241 4   50     27 my $type = $node->literal_datatype || '';
242 4 100       30 if ($type eq 'http://www.w3.org/2001/XMLSchema#boolean') {
    100          
    50          
    50          
243 2 100       10 $value = ($value eq 'true') ? '1.0' : '0.0';
244             } elsif ($node->is_numeric_type) {
245             # noop
246             } elsif (not $node->has_datatype) {
247 0 0       0 if (looks_like_number($value)) {
248 0         0 $value = +$value;
249             } else {
250 0         0 throw RDF::Query::Error::TypeError ( -text => "cannot cast unrecognized value '$value' to xsd:double" );
251             }
252             } elsif (not $node->is_numeric_type) {
253 1         7 throw RDF::Query::Error::TypeError ( -text => "cannot cast unrecognized value '$value' to xsd:double" );
254             }
255             } elsif ($node->is_resource) {
256 1         25 throw RDF::Query::Error::TypeError ( -text => "cannot cast an IRI to xsd:double" );
257             } elsif ($node->is_blank) {
258 0         0 throw RDF::Query::Error::TypeError -text => "cannot cast bnode to xsd:double";
259             }
260            
261 3         28 my $num = sprintf("%e", $value);
262 3         11 return RDF::Query::Node::Literal->new( $num, undef, 'http://www.w3.org/2001/XMLSchema#double' );
263             }
264 35         362 );
265            
266             ### Effective Boolean Value
267             RDF::Query::Functions->install_function(
268             "sparql:ebv",
269             sub {
270 115     115   185 my $query = shift;
271 115         174 my $node = shift;
272            
273 115 50       408 if ($node->is_literal) {
    0          
274 115 50       1106 if ($node->is_numeric_type) {
    50          
275 0         0 my $value = $node->numeric_value;
276 0 0       0 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean') if ($value);
277 0 0       0 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean') if (not $value);
278             } elsif ($node->has_datatype) {
279 115         928 my $type = $node->literal_datatype;
280 115         596 my $value = $node->literal_value;
281 115 50       766 if ($type eq 'http://www.w3.org/2001/XMLSchema#boolean') {
282 115 100       484 return ($value eq 'true')
283             ? RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean')
284             : RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
285             } else {
286 0         0 throw RDF::Query::Error::TypeError -text => "Unusable type in EBV: " . Dumper($node);
287             }
288             } else {
289 0         0 my $value = $node->literal_value;
290 0 0       0 return (length($value))
291             ? RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean')
292             : RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
293             }
294 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => "'$node' cannot be cast to a boolean type (true or false)" );
295             } elsif ($node->is_resource) {
296 0         0 throw RDF::Query::Error::TypeError ( -text => "cannot cast an IRI to xsd:boolean" );
297             }
298             }
299 35         290 );
300            
301             RDF::Query::Functions->install_function(
302             "http://www.w3.org/2001/XMLSchema#boolean",
303             sub {
304 5     5   10 my $query = shift;
305 5         8 my $node = shift;
306            
307 5 100       17 if ($node->is_literal) {
308 4 100       38 if ($node->is_numeric_type) {
    50          
309 2         8 my $value = $node->numeric_value;
310 2 100       10 if ($value) {
311 1         4 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
312             } else {
313 1         5 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
314             }
315             } elsif ($node->has_datatype) {
316 2         17 my $type = $node->literal_datatype;
317 2         13 my $value = $node->literal_value;
318 2 100       16 if ($value eq 'true') {
    50          
319 1         5 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
320             } elsif ($value eq 'false') {
321 0         0 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
322             } else {
323 1         5 throw RDF::Query::Error::TypeError -text => "Unusable type in boolean cast: " . Dumper($node);
324             }
325             } else {
326 0         0 my $value = $node->literal_value;
327 0 0       0 if ($value eq 'true') {
    0          
328 0         0 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
329             } elsif ($value eq 'false') {
330 0         0 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
331             } else {
332 0         0 throw RDF::Query::Error::TypeError -text => "Cannot cast to xsd:boolean: " . Dumper($node);
333             }
334             }
335             } else {
336 1         16 throw RDF::Query::Error::TypeError -text => "Cannot cast to xsd:boolean: " . Dumper($node);
337             }
338             }
339 35         311 );
340            
341             RDF::Query::Functions->install_function(
342             "http://www.w3.org/2001/XMLSchema#string",
343             sub {
344 8     8   15 my $query = shift;
345 8         12 my $node = shift;
346 8 100       31 if ($node->is_literal) {
    50          
347 3         43 my $value = $node->literal_value;
348 3         22 return RDF::Query::Node::Literal->new($value, undef, 'http://www.w3.org/2001/XMLSchema#string');
349             } elsif ($node->is_resource) {
350 5         101 my $value = $node->uri_value;
351 5         31 return RDF::Query::Node::Literal->new($value, undef, 'http://www.w3.org/2001/XMLSchema#string');
352             } else {
353 0         0 throw RDF::Query::Error::TypeError ( -text => "cannot cast node to xsd:string: " . $node );
354             }
355             }
356 35         271 );
357            
358             RDF::Query::Functions->install_function(
359             "http://www.w3.org/2001/XMLSchema#dateTime",
360             sub {
361 5     5   13 my $query = shift;
362 5         8 my $node = shift;
363 5 100       36 my $f = ref($query) ? $query->dateparser : DateTime::Format::W3CDTF->new;
364 5         29 my $value = $node->literal_value;
365 5 100       85 unless ($value =~ m<-?\d{4}-\d\d-\d\dT\d\d:\d\d:\d\d([.]\d+)?(Z|[-+]\d\d:\d\d)?>) {
366 1         9 throw RDF::Query::Error::TypeError -text => "Not a valid lexical form for xsd:dateTime: '$value'";
367             }
368 4         8 my $dt = eval { $f->parse_datetime( $value ) };
  4         23  
369 4 50       2038 if ($dt) {
370 4         182 my $value = DateTime::Format::W3CDTF->new->format_datetime( $dt );
371 4         263 return RDF::Query::Node::Literal->new( $value, undef, 'http://www.w3.org/2001/XMLSchema#dateTime' );
372             } else {
373 0         0 throw RDF::Query::Error::TypeError -text => "Failed to parse lexical form as xsd:dateTime: '$value'";
374             }
375             }
376 35         280 );
377            
378            
379             RDF::Query::Functions->install_function(
380             "sparql:str",
381             sub {
382 16     16   35 my $query = shift;
383 16         25 my $node = shift;
384            
385 16 50       76 unless (blessed($node)) {
386 0         0 throw RDF::Query::Error::TypeError -text => "STR() must be called with either a literal or resource";
387             }
388            
389 16 100       97 if ($node->is_literal) {
    100          
390 6         57 my $value = $node->literal_value;
391 6         42 return RDF::Query::Node::Literal->new( $value );
392             } elsif ($node->is_resource) {
393 9         210 my $value = $node->uri_value;
394 9         80 return RDF::Query::Node::Literal->new( $value );
395             } else {
396 1         27 throw RDF::Query::Error::TypeError -text => "STR() must be called with either a literal or resource";
397             }
398             }
399 35         266 );
400            
401             RDF::Query::Functions->install_function(
402             ["http://www.w3.org/ns/sparql#strdt", "sparql:strdt"],
403             sub {
404 0     0   0 my $query = shift;
405 0         0 my $str = shift;
406 0         0 my $dt = shift;
407            
408 0 0 0     0 unless (blessed($str) and $str->isa('RDF::Query::Node::Literal') and blessed($dt) and $dt->isa('RDF::Query::Node::Resource')) {
      0        
      0        
409 0         0 throw RDF::Query::Error::TypeError -text => "STRDT() must be called with a plain literal and a datatype IRI";
410             }
411            
412 0 0       0 unless ($str->is_simple_literal) {
413 0         0 throw RDF::Query::Error::TypeError -text => "STRDT() not called with a simple literal";
414             }
415            
416 0         0 my $value = $str->literal_value;
417 0         0 my $uri = $dt->uri_value;
418 0         0 return RDF::Query::Node::Literal->new( $value, undef, $uri );
419             }
420 35         315 );
421            
422             RDF::Query::Functions->install_function(
423             ["http://www.w3.org/ns/sparql#strlang", "sparql:strlang"],
424             sub {
425 0     0   0 my $query = shift;
426 0         0 my $str = shift;
427 0         0 my $lang = shift;
428            
429 0 0 0     0 unless (blessed($str) and $str->isa('RDF::Query::Node::Literal') and blessed($lang) and $lang->isa('RDF::Query::Node::Literal')) {
      0        
      0        
430 0         0 throw RDF::Query::Error::TypeError -text => "STRLANG() must be called with two plain literals";
431             }
432            
433 0 0       0 unless ($str->is_simple_literal) {
434 0         0 throw RDF::Query::Error::TypeError -text => "STRLANG() not called with a simple literal";
435             }
436            
437 0         0 my $value = $str->literal_value;
438 0         0 my $langtag = $lang->literal_value;
439 0         0 return RDF::Query::Node::Literal->new( $value, $langtag );
440             }
441 35         387 );
442            
443             RDF::Query::Functions->install_function(
444             ["sparql:uri", "sparql:iri"],
445             sub {
446 1     1   3 my $query = shift;
447 1         2 my $node = shift;
448            
449 1 50       7 unless (blessed($node)) {
450 0         0 throw RDF::Query::Error::TypeError -text => "URI/IRI() must be called with either a literal or resource";
451             }
452            
453 1         4 my $base = $query->{parsed}{base};
454            
455 1 50       6 if ($node->is_literal) {
    0          
456 1         13 my $value = $node->literal_value;
457 1         9 return RDF::Query::Node::Resource->new( $value, $base );
458             } elsif ($node->is_resource) {
459 0         0 return $node;
460             } else {
461 0         0 throw RDF::Query::Error::TypeError -text => "URI/IRI() must be called with either a literal or resource";
462             }
463             }
464 35         317 );
465            
466             RDF::Query::Functions->install_function(
467             "sparql:bnode",
468             sub {
469 3     3   7 my $query = shift;
470 3 50       9 if (@_) {
471 3         5 my $node = shift;
472 3 50 33     26 unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
473 0         0 throw RDF::Query::Error::TypeError -text => "BNODE() must be called with either a literal or resource";
474             }
475 3         37 my $value = $node->literal_value;
476 3 100       29 if (my $bnode = $query->{_query_row_cache}{'sparql:bnode'}{$value}) {
477 1         10 return $bnode;
478             } else {
479 2         12 my $bnode = RDF::Query::Node::Blank->new();
480 2         17 $query->{_query_row_cache}{'sparql:bnode'}{$value} = $bnode;
481 2         7 return $bnode;
482             }
483             } else {
484 0         0 return RDF::Query::Node::Blank->new();
485             }
486             }
487 35         287 );
488            
489             RDF::Query::Functions->install_function(
490             "sparql:logical-or",
491             sub {
492 9     9   14 my $query = shift;
493             ### Arguments to sparql:logical-* functions are passed lazily via a closure
494             ### so that TypeErrors in arguments can be handled properly.
495 9         14 my $args = shift;
496            
497 9         27 my $l = Log::Log4perl->get_logger("rdf.query.functions.logicalor");
498 9         992 $l->trace('executing logical-or');
499 9         73 my $ebv = RDF::Query::Node::Resource->new( "sparql:ebv" );
500 9         119 my $arg;
501             my $error;
502            
503 9         13 while (1) {
504 19         21 my $bool;
505             try {
506 19         368 $l->trace('- getting logical-or operand...');
507 19         137 $arg = $args->();
508 19 100       391 if (defined($arg)) {
509 16         61 $l->trace("- logical-or operand: $arg");
510 16         454 my $func = RDF::Query::Expression::Function->new( $ebv, $arg );
511 16         62 my $value = $func->evaluate( $query, {} );
512 16 100       49 $bool = ($value->literal_value eq 'true') ? 1 : 0;
513             }
514             } otherwise {
515 0         0 my $e = shift;
516 0         0 $l->debug("error in lhs of logical-or: " . $e->text . " at " . $e->file . " line " . $e->line);
517 0   0     0 $error ||= $e;
518 19         138 };
519 19 100       317 last unless (defined($arg));
520 16 100       38 if ($bool) {
521 6         21 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
522             }
523             }
524 3 50       12 if ($error) {
525 0         0 $l->debug('logical-or error: ' . $error->text);
526 0         0 $error->throw;
527             } else {
528 3         13 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
529             }
530             }
531 35         308 );
532            
533             # sparql:logical-and
534             RDF::Query::Functions->install_function(
535             "sparql:logical-and",
536             sub {
537 7     7   12 my $query = shift;
538             ### Arguments to sparql:logical-* functions are passed lazily via a closure
539             ### so that TypeErrors in arguments can be handled properly.
540 7         14 my $args = shift;
541            
542 7         22 my $l = Log::Log4perl->get_logger("rdf.query.functions.logicaland");
543 7         975 $l->trace('executing logical-and');
544 7         59 my $ebv = RDF::Query::Node::Resource->new( "sparql:ebv" );
545 7         93 my $arg;
546             my $error;
547            
548 7         10 while (1) {
549 16         18 my $bool;
550             try {
551 16         306 $l->trace('- getting logical-and operand...');
552 16         123 $arg = $args->();
553 16 100       310 if (defined($arg)) {
554 13         50 $l->trace("- logical-and operand: $arg");
555 13         528 my $func = RDF::Query::Expression::Function->new( $ebv, $arg );
556 13         56 my $value = $func->evaluate( $query, {} );
557 13 100       48 $bool = ($value->literal_value eq 'true') ? 1 : 0;
558             }
559             } otherwise {
560 0         0 my $e = shift;
561 0         0 $l->debug("error in lhs of logical-and: " . $e->text);
562 0   0     0 $error ||= $e;
563 16         115 };
564 16 100       296 last unless (defined($arg));
565 13 100       38 unless ($bool) {
566 4         17 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
567             }
568             }
569 3 50       11 if ($error) {
570 0         0 $l->debug('logical-and error: ' . $error->text);
571 0         0 $error->throw;
572             } else {
573 3         14 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
574             }
575             }
576 35         297 );
577            
578             RDF::Query::Functions->install_function(
579             "sparql:in",
580             sub {
581 2     2   9 return __IN_FUNC('in', @_)
582             }
583 35         239 );
584            
585             RDF::Query::Functions->install_function(
586             "sparql:notin",
587             sub {
588 2     2   8 return __IN_FUNC('notin', @_)
589             }
590 35         243 );
591            
592             sub __IN_FUNC {
593 4     4   8 my $op = shift;
594 4         8 my $query = shift;
595 4         6 my $args = shift;
596 4         12 my $node = $args->();
597 4 50       104 unless (blessed($node)) {
598 0         0 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
599             }
600            
601 4         7 my $arg;
602             my $error;
603 4         6 while (1) {
604 8         14 my $bool;
605             try {
606 8     8   228 $l->trace("- getting $op operand...");
607 8         66 $arg = $args->();
608 8 100       129 if (defined($arg)) {
609 6         26 $l->trace("- $op operand: $arg");
610 6         154 my $expr = RDF::Query::Expression::Binary->new('==', $node, $arg);
611 6         23 my $value = $expr->evaluate( $query, {} );
612 5 100       136 $bool = ($value->literal_value eq 'true') ? 1 : 0;
613             }
614             } catch RDF::Query::Error with {
615 1     1   122 my $e = shift;
616 1         10 $l->debug("error in lhs of logical-and: " . $e->text);
617 1   33     18 $error ||= $e;
618 8     0   71 } otherwise {};
619 8 100       163 last unless (defined($arg));
620 6 100       17 if ($bool) {
621 2 100       6 if ($op eq 'notin') {
622 1         6 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
623             } else {
624 1         6 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
625             }
626             }
627             }
628 2 50       6 if ($error) {
629 0         0 $l->debug("$op error: " . $error->text);
630 0         0 $error->throw;
631             } else {
632 2 100       7 if ($op eq 'notin') {
633 1         5 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
634             } else {
635 1         6 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
636             }
637             }
638             }
639            
640             # sparql:bound
641             RDF::Query::Functions->install_function(
642             ["http://www.w3.org/ns/sparql#bound", "sparql:bound"],
643             sub {
644 3     3   7 my $query = shift;
645 3         7 my $node = shift;
646 3 100       13 if (blessed($node)) {
647 1         5 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
648             } else {
649 2         15 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
650             }
651             }
652 35         287 );
653            
654             RDF::Query::Functions->install_function(
655             ["sparql:isuri", "sparql:isiri"],
656             sub {
657 8     8   12 my $query = shift;
658 8         11 my $node = shift;
659 8 100       39 if ($node->isa('RDF::Trine::Node::Resource')) {
660 5         20 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
661             } else {
662 3         15 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
663             }
664             }
665 35         285 );
666            
667             # sparql:isblank
668             RDF::Query::Functions->install_function(
669             "sparql:isblank",
670             sub {
671 7     7   12 my $query = shift;
672 7         13 my $node = shift;
673 7 100       35 if ($node->isa('RDF::Trine::Node::Blank')) {
674 2         11 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
675             } else {
676 5         19 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
677             }
678             }
679 35         248 );
680            
681             # sparql:isliteral
682             RDF::Query::Functions->install_function(
683             "sparql:isliteral",
684             sub {
685 3     3   7 my $query = shift;
686 3         7 my $node = shift;
687 3 100       20 if ($node->isa('RDF::Trine::Node::Literal')) {
688 1         6 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
689             } else {
690 2         8 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
691             }
692             }
693 35         242 );
694            
695            
696             RDF::Query::Functions->install_function(
697             "sparql:lang",
698             sub {
699 19     19   31 my $query = shift;
700 19         29 my $node = shift;
701 19 100       75 if ($node->is_literal) {
702 18 100       180 my $lang = ($node->has_language) ? $node->literal_value_language : '';
703 18         198 return RDF::Query::Node::Literal->new( $lang );
704             } else {
705 1         14 throw RDF::Query::Error::TypeError ( -text => "cannot call lang() on a non-literal value" );
706             }
707             }
708 35         271 );
709            
710             RDF::Query::Functions->install_function(
711             "sparql:langmatches",
712             sub {
713 6     6   13 my $query = shift;
714 6         11 my $l = shift;
715 6         10 my $m = shift;
716            
717 6         23 my $lang = $l->literal_value;
718 6         45 my $match = $m->literal_value;
719            
720 6         46 my $true = RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
721 6         150 my $false = RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
722            
723 6 50       139 if ($match eq '*') {
724             # """A language-range of "*" matches any non-empty language-tag string."""
725 0 0       0 return ($lang ? $true : $false);
726             } else {
727 6 100       24 return (I18N::LangTags::is_dialect_of( $lang, $match )) ? $true : $false;
728             }
729             }
730 35         272 );
731            
732             RDF::Query::Functions->install_function(
733             "sparql:sameterm",
734             sub {
735 3     3   9 my $query = shift;
736 3         8 my $nodea = shift;
737 3         7 my $nodeb = shift;
738            
739 3         8 my $bool = 0;
740 3 50 33     77 if ($nodea->isa('RDF::Trine::Node::Resource')) {
    50          
    50          
741 0         0 $bool = $nodea->equal( $nodeb );
742             } elsif ($nodea->isa('RDF::Trine::Node::Blank')) {
743 0         0 $bool = $nodea->equal( $nodeb );
744             } elsif ($nodea->isa('RDF::Trine::Node::Literal') and $nodeb->isa('RDF::Trine::Node::Literal')) {
745 3 100 33     16 if ($nodea->literal_value ne $nodeb->literal_value) {
    50 0        
    50          
    50          
    0          
746 1         14 $bool = 0;
747             } elsif (not($nodea->has_language == $nodeb->has_language)) {
748 0         0 $bool = 0;
749             } elsif (not $nodea->has_datatype == $nodeb->has_datatype) {
750 0         0 $bool = 0;
751             } elsif ($nodea->has_datatype or $nodeb->has_datatype) {
752 2 100       118 if ($nodea->literal_datatype ne $nodeb->literal_datatype) {
753 1         9 $bool = 0;
754             } else {
755 1         14 $bool = 1;
756             }
757             } elsif ($nodea->has_language or $nodeb->has_language) {
758 0 0       0 if ($nodea->literal_value_language ne $nodeb->literal_value_language) {
759 0         0 $bool = 0;
760             } else {
761 0         0 $bool = 1;
762             }
763             } else {
764 0         0 $bool = 1;
765             }
766             }
767            
768 3 100       23 return ($bool)
769             ? RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean')
770             : RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
771             }
772 35         259 );
773            
774             RDF::Query::Functions->install_function(
775             "sparql:datatype",
776             sub {
777             # """Returns the datatype IRI of typedLit; returns xsd:string if the parameter is a simple literal."""
778 8     8   18 my $query = shift;
779 8         16 my $node = shift;
780 8 50 33     87 unless (blessed($node) and $node->isa('RDF::Query::Node')) {
781 0         0 throw RDF::Query::Error::MethodInvocationError -text => "DATATYPE() called without a valid RDF Term";
782             }
783 8 50       46 if ($node->is_literal) {
784 8 50       101 if ($node->has_language) {
    100          
785 0         0 return $rdf->langString;
786             } elsif ($node->has_datatype) {
787 5         106 my $type = $node->literal_datatype;
788 5         47 $l->debug("datatype => $type");
789 5         111 return RDF::Query::Node::Resource->new($type);
790             } else {
791 3         149 $l->debug('datatype => string');
792 3         30 return RDF::Query::Node::Resource->new('http://www.w3.org/2001/XMLSchema#string');
793             }
794             } else {
795 0         0 throw RDF::Query::Error::TypeError ( -text => "cannot call datatype() on a non datatyped node" );
796             }
797             }
798 35         274 );
799            
800             RDF::Query::Functions->install_function(
801             "sparql:regex",
802             sub {
803 13     13   25 my $query = shift;
804 13         26 my $node = shift;
805 13         25 my $match = shift;
806            
807 13 50       54 unless ($node->is_literal) {
808 0         0 throw RDF::Query::Error::TypeError ( -text => 'REGEX() called with non-string data' );
809             }
810            
811 13         145 my $text = $node->literal_value;
812 13         103 my $pattern = $match->literal_value;
813 13 50 33     182 if (index($pattern, '(?{') != -1 or index($pattern, '(??{') != -1) {
814 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => 'REGEX() called with unsafe ?{} pattern' );
815             }
816 13 100       46 if (@_) {
817 1         4 my $data = shift;
818 1         4 my $flags = $data->literal_value;
819 1 50       10 if ($flags !~ /^[smix]*$/) {
820 0         0 throw RDF::Query::Error::FilterEvaluationError ( -text => 'REGEX() called with unrecognized flags' );
821             }
822 1         4 $pattern = qq[(?${flags}:$pattern)];
823             }
824            
825 13 100       240 return ($text =~ /$pattern/)
826             ? RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean')
827             : RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
828             }
829 35         285 );
830            
831             RDF::Query::Functions->install_function(
832             "sparql:exists",
833             sub {
834 4     4   6 my $query = shift;
835 4         8 my $context = shift;
836 4         6 my $bound = shift;
837 4         6 my $ggp = shift;
838 4         6 my $graph = shift;
839 4         24 my ($plan) = RDF::Query::Plan->generate_plans( $ggp, $context, active_graph => $graph );
840            
841 4 50       17 Carp::confess "No execution contexted passed to sparql:exists" unless (blessed($context));
842            
843 4         19 my $l = Log::Log4perl->get_logger("rdf.query.functions.exists");
844 4         478 my $copy = $context->copy( bound => $bound );
845 4         14 $plan->execute( $copy );
846 4 100       15 if (my $row = $plan->next) {
847 1         4 $l->trace("got EXISTS row: $row");
848 1         44 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
849             } else {
850 3         10 $l->trace("didn't find EXISTS row");
851 3         26 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
852             }
853             }
854 35         278 );
855            
856             RDF::Query::Functions->install_function(
857             "sparql:coalesce",
858             sub {
859 8     8   12 my $query = shift;
860 8         11 my $args = shift;
861 8         24 while (defined(my $node = $args->())) {
862 11 100       147 if (blessed($node)) {
863 5         16 return $node;
864             }
865             }
866             }
867 35         246 );
868            
869             # sparql:isNumeric
870             RDF::Query::Functions->install_function(
871             "sparql:isnumeric",
872             sub {
873 0     0   0 my $query = shift;
874 0         0 my $node = shift;
875 0 0 0     0 if ($node->isa('RDF::Query::Node::Literal') and $node->is_numeric_type and $node->is_valid_lexical_form) {
      0        
876 0         0 return RDF::Query::Node::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
877             }
878 0         0 return RDF::Query::Node::Literal->new('false', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
879             }
880 35         241 );
881            
882             # sparql:abs
883             RDF::Query::Functions->install_function(
884             "sparql:abs",
885             sub {
886 0     0   0 my $query = shift;
887 0         0 my $node = shift;
888 0 0 0     0 if (blessed($node) and $node->isa('RDF::Query::Node::Literal') and $node->is_numeric_type) {
      0        
889 0         0 my $value = $node->numeric_value;
890 0         0 return RDF::Query::Node::Literal->new( abs($value), undef, $node->literal_datatype );
891             } else {
892 0         0 throw RDF::Query::Error::TypeError -text => "sparql:abs called without a numeric literal";
893             }
894             }
895 35         260 );
896            
897              
898             # sparql:ceil
899             RDF::Query::Functions->install_function(
900             "sparql:ceil",
901             sub {
902 0     0   0 my $query = shift;
903 0         0 my $node = shift;
904 0 0 0     0 if (blessed($node) and $node->isa('RDF::Query::Node::Literal') and $node->is_numeric_type) {
      0        
905 0         0 my $value = $node->numeric_value;
906 0         0 return RDF::Query::Node::Literal->new( ceil($value), undef, $node->literal_datatype );
907             } else {
908 0         0 throw RDF::Query::Error::TypeError -text => "sparql:ceil called without a numeric literal";
909             }
910             }
911 35         276 );
912            
913              
914             # sparql:floor
915             RDF::Query::Functions->install_function(
916             "sparql:floor",
917             sub {
918 0     0   0 my $query = shift;
919 0         0 my $node = shift;
920 0 0 0     0 if (blessed($node) and $node->isa('RDF::Query::Node::Literal') and $node->is_numeric_type) {
      0        
921 0         0 my $value = $node->numeric_value;
922 0         0 return RDF::Query::Node::Literal->new( floor($value), undef, $node->literal_datatype );
923             } else {
924 0         0 throw RDF::Query::Error::TypeError -text => "sparql:floor called without a numeric literal";
925             }
926             }
927 35         318 );
928            
929              
930             # sparql:round
931             RDF::Query::Functions->install_function(
932             "sparql:round",
933             sub {
934 0     0   0 my $query = shift;
935 0         0 my $node = shift;
936 0 0 0     0 if (blessed($node) and $node->isa('RDF::Query::Node::Literal') and $node->is_numeric_type) {
      0        
937 0         0 my $value = $node->numeric_value;
938 0         0 my $mult = 1;
939 0 0       0 if ($value < 0) {
940 0         0 $mult = -1;
941 0         0 $value = -$value;
942             }
943 0         0 my $round = $mult * POSIX::floor($value + 0.50000000000008);
944 0         0 return RDF::Query::Node::Literal->new( $round, undef, $node->literal_datatype );
945             } else {
946 0         0 throw RDF::Query::Error::TypeError -text => "sparql:round called without a numeric literal";
947             }
948             }
949 35         275 );
950            
951              
952             # sparql:concat
953             RDF::Query::Functions->install_function(
954             "sparql:concat",
955             sub {
956 0     0   0 my $query = shift;
957 0         0 my @nodes = @_;
958            
959 0         0 my $lang;
960 0         0 my $all_lang = 1;
961 0         0 my $all_str = 1;
962 0         0 foreach my $n (@nodes) {
963 0 0       0 unless ($n->isa('RDF::Query::Node::Literal')) {
964 0         0 throw RDF::Query::Error::TypeError -text => "sparql:concat called with a non-literal argument";
965             }
966 0 0       0 if ($n->has_datatype) {
    0          
967 0         0 $all_lang = 0;
968 0         0 my $dt = $n->literal_datatype;
969 0 0       0 if ($dt ne 'http://www.w3.org/2001/XMLSchema#string') {
970 0         0 throw RDF::Query::Error::TypeError -text => "sparql:concat called with a datatyped-literal other than xsd:string";
971             }
972             } elsif ($n->has_language) {
973 0         0 $all_str = 0;
974 0 0 0     0 if (defined($lang) and $lang ne $n->literal_value_language) {
975 0         0 $all_lang = 0;
976             } else {
977 0         0 $lang = $n->literal_value_language;
978             }
979             } else {
980 0         0 $all_lang = 0;
981 0         0 $all_str = 0;
982             }
983             }
984            
985 0         0 my @strtype;
986 0 0       0 if ($all_lang) {
    0          
987 0         0 $strtype[0] = $lang;
988             } elsif ($all_str) {
989 0         0 $strtype[1] = 'http://www.w3.org/2001/XMLSchema#string'
990             }
991 0         0 my $value = join('', map { $_->literal_value } @nodes);
  0         0  
992 0         0 return RDF::Query::Node::Literal->new($value, @strtype);
993             }
994 35         492 );
995            
996              
997             # sparql:substr
998             RDF::Query::Functions->install_function(
999             "sparql:substr",
1000             sub {
1001 0     0   0 my $query = shift;
1002 0         0 my $node = shift;
1003 0         0 my @args = @_;
1004 0 0 0     0 unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1005 0         0 throw RDF::Query::Error::TypeError -text => "sparql:substr called without a literal arg1 term";
1006             }
1007 0         0 my $value = $node->literal_value;
1008 0         0 my @nums;
1009 0         0 foreach my $i (0 .. $#args) {
1010 0         0 my $argnum = $i + 2;
1011 0         0 my $arg = $args[ $i ];
1012 0 0 0     0 unless (blessed($arg) and $arg->isa('RDF::Query::Node::Literal') and $arg->is_numeric_type) {
      0        
1013 0         0 throw RDF::Query::Error::TypeError -text => "sparql:substr called without a numeric literal arg${argnum} term";
1014             }
1015 0         0 push(@nums, $arg->numeric_value);
1016             }
1017            
1018 0         0 $nums[0]--;
1019 0 0       0 my $substring = (scalar(@nums) > 1) ? substr($value, $nums[0], $nums[1]) : substr($value, $nums[0]);
1020 0         0 return RDF::Query::Node::Literal->new($substring, $node->type_list);
1021             }
1022 35         279 );
1023            
1024              
1025             # sparql:strlen
1026             RDF::Query::Functions->install_function(
1027             "sparql:strlen",
1028             sub {
1029 0     0   0 my $query = shift;
1030 0         0 my $node = shift;
1031 0 0 0     0 if (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1032 0         0 my $value = $node->literal_value;
1033 0         0 return RDF::Query::Node::Literal->new( length($value), undef, $xsd->integer );
1034             } else {
1035 0         0 throw RDF::Query::Error::TypeError -text => "sparql:strlen called without a literal term";
1036             }
1037             }
1038 35         254 );
1039            
1040              
1041             # sparql:ucase
1042             RDF::Query::Functions->install_function(
1043             "sparql:ucase",
1044             sub {
1045 0     0   0 my $query = shift;
1046 0         0 my $node = shift;
1047 0 0 0     0 if (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1048 0         0 my $value = $node->literal_value;
1049 0         0 return RDF::Query::Node::Literal->new( uc($value), $node->type_list );
1050             } else {
1051 0         0 throw RDF::Query::Error::TypeError -text => "sparql:ucase called without a literal term";
1052             }
1053             }
1054 35         239 );
1055            
1056              
1057             # sparql:lcase
1058             RDF::Query::Functions->install_function(
1059             "sparql:lcase",
1060             sub {
1061 0     0   0 my $query = shift;
1062 0         0 my $node = shift;
1063 0 0 0     0 if (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1064 0         0 my $value = $node->literal_value;
1065 0         0 return RDF::Query::Node::Literal->new( lc($value), $node->type_list );
1066             } else {
1067 0         0 throw RDF::Query::Error::TypeError -text => "sparql:lcase called without a literal term";
1068             }
1069             }
1070 35         233 );
1071            
1072 35         174 RDF::Query::Functions->install_function("sparql:encode_for_uri", \&_encode_for_uri);
1073 35         165 RDF::Query::Functions->install_function("sparql:contains", \&_contains);
1074 35         179 RDF::Query::Functions->install_function("sparql:strstarts", \&_strstarts);
1075 35         164 RDF::Query::Functions->install_function("sparql:strends", \&_strends);
1076 35         169 RDF::Query::Functions->install_function("sparql:rand", \&_rand);
1077            
1078 35         175 RDF::Query::Functions->install_function("sparql:md5", \&_md5);
1079 35         175 RDF::Query::Functions->install_function("sparql:sha1", \&_sha1);
1080 35         164 RDF::Query::Functions->install_function("sparql:sha224", \&_sha224);
1081 35         158 RDF::Query::Functions->install_function("sparql:sha256", \&_sha256);
1082 35         162 RDF::Query::Functions->install_function("sparql:sha384", \&_sha384);
1083 35         163 RDF::Query::Functions->install_function("sparql:sha512", \&_sha512);
1084            
1085 35         171 RDF::Query::Functions->install_function("sparql:year", \&_year);
1086 35         167 RDF::Query::Functions->install_function("sparql:month", \&_month);
1087 35         175 RDF::Query::Functions->install_function("sparql:day", \&_day);
1088 35         157 RDF::Query::Functions->install_function("sparql:hours", \&_hours);
1089 35         183 RDF::Query::Functions->install_function("sparql:minutes", \&_minutes);
1090 35         165 RDF::Query::Functions->install_function("sparql:seconds", \&_seconds);
1091 35         162 RDF::Query::Functions->install_function("sparql:timezone", \&_timezone);
1092 35         179 RDF::Query::Functions->install_function("sparql:tz", \&_tz);
1093 35         174 RDF::Query::Functions->install_function("sparql:now", \&_now);
1094              
1095 35         164 RDF::Query::Functions->install_function("sparql:strbefore", \&_strbefore);
1096 35         180 RDF::Query::Functions->install_function("sparql:strafter", \&_strafter);
1097 35         175 RDF::Query::Functions->install_function("sparql:replace", \&_replace);
1098              
1099 35         180 RDF::Query::Functions->install_function("sparql:uuid", \&_uuid);
1100 35         162 RDF::Query::Functions->install_function("sparql:struuid", \&_struuid);
1101             }
1102              
1103             =item * sparql:encode_for_uri
1104              
1105             =cut
1106              
1107             sub _encode_for_uri {
1108 0     0     my $query = shift;
1109 0           my $node = shift;
1110 0 0 0       if (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1111 0           my $value = $node->literal_value;
1112 0           return RDF::Query::Node::Literal->new( uri_escape_utf8($value) );
1113             } else {
1114 0           throw RDF::Query::Error::TypeError -text => "sparql:encode_for_uri called without a literal term";
1115             }
1116             }
1117              
1118             =item * sparql:contains
1119              
1120             =cut
1121              
1122             sub _contains {
1123 0     0     my $query = shift;
1124 0           my $node = shift;
1125 0           my $pat = shift;
1126 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1127 0           throw RDF::Query::Error::TypeError -text => "sparql:contains called without a literal arg1 term";
1128             }
1129 0 0 0       unless (blessed($pat) and $pat->isa('RDF::Query::Node::Literal')) {
1130 0           throw RDF::Query::Error::TypeError -text => "sparql:contains called without a literal arg2 term";
1131             }
1132            
1133             # TODO: what should be returned if one or both arguments are typed as xsd:string?
1134 0 0 0       if ($node->has_language and $pat->has_language) {
1135 0 0         if ($node->literal_value_language ne $pat->literal_value_language) {
1136 0           throw RDF::Query::Error::TypeError -text => "sparql:contains called with literals of different languages";
1137             }
1138             }
1139            
1140 0           my $lit = $node->literal_value;
1141 0           my $plit = $pat->literal_value;
1142 0           my $pos = index($lit, $plit);
1143 0 0         if ($pos >= 0) {
1144 0           return RDF::Query::Node::Literal->new('true', undef, $xsd->boolean);
1145             } else {
1146 0           return RDF::Query::Node::Literal->new('false', undef, $xsd->boolean);
1147             }
1148             }
1149              
1150             =item * sparql:strstarts
1151              
1152             =cut
1153              
1154             sub _strstarts {
1155 0     0     my $query = shift;
1156 0           my $node = shift;
1157 0           my $pat = shift;
1158 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1159 0           throw RDF::Query::Error::TypeError -text => "sparql:strstarts called without a literal arg1 term";
1160             }
1161 0 0 0       unless (blessed($pat) and $pat->isa('RDF::Query::Node::Literal')) {
1162 0           throw RDF::Query::Error::TypeError -text => "sparql:strstarts called without a literal arg2 term";
1163             }
1164              
1165             # TODO: what should be returned if one or both arguments are typed as xsd:string?
1166 0 0 0       if ($node->has_language and $pat->has_language) {
1167             # TODO: if the language tags are different, does this error, or just return false?
1168 0 0         if ($node->literal_value_language ne $pat->literal_value_language) {
1169 0           return RDF::Query::Node::Literal->new('false', undef, $xsd->boolean);
1170             }
1171             }
1172            
1173 0 0         if (index($node->literal_value, $pat->literal_value) == 0) {
1174 0           return RDF::Query::Node::Literal->new('true', undef, $xsd->boolean);
1175             } else {
1176 0           return RDF::Query::Node::Literal->new('false', undef, $xsd->boolean);
1177             }
1178             }
1179              
1180             =item * sparql:strends
1181              
1182             =cut
1183              
1184             sub _strends {
1185 0     0     my $query = shift;
1186 0           my $node = shift;
1187 0           my $pat = shift;
1188 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1189 0           throw RDF::Query::Error::TypeError -text => "sparql:strends called without a literal arg1 term";
1190             }
1191 0 0 0       unless (blessed($pat) and $pat->isa('RDF::Query::Node::Literal')) {
1192 0           throw RDF::Query::Error::TypeError -text => "sparql:strends called without a literal arg2 term";
1193             }
1194            
1195             # TODO: what should be returned if one or both arguments are typed as xsd:string?
1196 0 0 0       if ($node->has_language and $pat->has_language) {
1197             # TODO: if the language tags are different, does this error, or just return false?
1198 0 0         if ($node->literal_value_language ne $pat->literal_value_language) {
1199 0           return RDF::Query::Node::Literal->new('false', undef, $xsd->boolean);
1200             }
1201             }
1202            
1203 0           my $lit = $node->literal_value;
1204 0           my $plit = $pat->literal_value;
1205 0           my $pos = length($lit) - length($plit);
1206 0 0         if (rindex($lit, $plit) == $pos) {
1207 0           return RDF::Query::Node::Literal->new('true', undef, $xsd->boolean);
1208             } else {
1209 0           return RDF::Query::Node::Literal->new('false', undef, $xsd->boolean);
1210             }
1211             }
1212              
1213             =item * sparql:rand
1214              
1215             =cut
1216              
1217             sub _rand {
1218 0     0     my $query = shift;
1219 0           my $r = rand();
1220 0           my $value = RDF::Trine::Node::Literal->canonicalize_literal_value( $r, $xsd->double->as_string );
1221 0           return RDF::Query::Node::Literal->new($value, undef, $xsd->double);
1222             }
1223              
1224             =item * sparql:md5
1225              
1226             =cut
1227              
1228             sub _md5 {
1229 0     0     my $query = shift;
1230 0           my $node = shift;
1231 0           return literal( md5_hex(encode_utf8($node->literal_value)) );
1232             }
1233              
1234             =item * sparql:sha1
1235              
1236             =cut
1237              
1238             sub _sha1 {
1239 0     0     my $query = shift;
1240 0           my $node = shift;
1241 0           return literal( sha1_hex(encode_utf8($node->literal_value)) );
1242             }
1243              
1244             =item * sparql:sha224
1245              
1246             =cut
1247              
1248             sub _sha224 {
1249 0     0     my $query = shift;
1250 0           my $node = shift;
1251 0           return literal( sha224_hex(encode_utf8($node->literal_value)) );
1252             }
1253              
1254             =item * sparql:sha256
1255              
1256             =cut
1257              
1258             sub _sha256 {
1259 0     0     my $query = shift;
1260 0           my $node = shift;
1261 0           return literal( sha256_hex(encode_utf8($node->literal_value)) );
1262             }
1263              
1264             =item * sparql:sha384
1265              
1266             =cut
1267              
1268             sub _sha384 {
1269 0     0     my $query = shift;
1270 0           my $node = shift;
1271 0           return literal( sha384_hex(encode_utf8($node->literal_value)) );
1272             }
1273              
1274             =item * sparql:sha512
1275              
1276             =cut
1277              
1278             sub _sha512 {
1279 0     0     my $query = shift;
1280 0           my $node = shift;
1281 0           return literal( sha512_hex(encode_utf8($node->literal_value)) );
1282             }
1283              
1284             =item * sparql:year
1285              
1286             =cut
1287              
1288             sub _year {
1289 0     0     my $query = shift;
1290 0           my $node = shift;
1291 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1292 0           throw RDF::Query::Error::TypeError -text => "sparql:year called without a literal term";
1293             }
1294 0           my $dt = $node->datetime;
1295 0 0         if ($dt) {
1296 0           return RDF::Query::Node::Literal->new($dt->year, undef, $xsd->integer);
1297             } else {
1298 0           throw RDF::Query::Error::TypeError -text => "sparql:year called without a valid dateTime";
1299             }
1300             }
1301              
1302             =item * sparql:month
1303              
1304             =cut
1305              
1306             sub _month {
1307 0     0     my $query = shift;
1308 0           my $node = shift;
1309 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1310 0           throw RDF::Query::Error::TypeError -text => "sparql:month called without a literal term";
1311             }
1312 0           my $dt = $node->datetime;
1313 0 0         if ($dt) {
1314 0           return RDF::Query::Node::Literal->new($dt->month, undef, $xsd->integer);
1315             } else {
1316 0           throw RDF::Query::Error::TypeError -text => "sparql:month called without a valid dateTime";
1317             }
1318             }
1319              
1320             =item * sparql:day
1321              
1322             =cut
1323              
1324             sub _day {
1325 0     0     my $query = shift;
1326 0           my $node = shift;
1327 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1328 0           throw RDF::Query::Error::TypeError -text => "sparql:day called without a literal term";
1329             }
1330 0           my $dt = $node->datetime;
1331 0 0         if ($dt) {
1332 0           return RDF::Query::Node::Literal->new($dt->day, undef, $xsd->integer);
1333             } else {
1334 0           throw RDF::Query::Error::TypeError -text => "sparql:day called without a valid dateTime";
1335             }
1336             }
1337              
1338             =item * sparql:hours
1339              
1340             =cut
1341              
1342             sub _hours {
1343 0     0     my $query = shift;
1344 0           my $node = shift;
1345 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1346 0           throw RDF::Query::Error::TypeError -text => "sparql:hours called without a literal term";
1347             }
1348 0           my $dt = $node->datetime;
1349 0 0         if ($dt) {
1350 0           return RDF::Query::Node::Literal->new($dt->hour, undef, $xsd->integer);
1351             } else {
1352 0           throw RDF::Query::Error::TypeError -text => "sparql:hours called without a valid dateTime";
1353             }
1354             }
1355              
1356             =item * sparql:minutes
1357              
1358             =cut
1359              
1360             sub _minutes {
1361 0     0     my $query = shift;
1362 0           my $node = shift;
1363 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1364 0           throw RDF::Query::Error::TypeError -text => "sparql:minutes called without a literal term";
1365             }
1366 0           my $dt = $node->datetime;
1367 0 0         if ($dt) {
1368 0           return RDF::Query::Node::Literal->new($dt->minute, undef, $xsd->integer);
1369             } else {
1370 0           throw RDF::Query::Error::TypeError -text => "sparql:minutes called without a valid dateTime";
1371             }
1372             }
1373              
1374             =item * sparql:seconds
1375              
1376             =cut
1377              
1378             sub _seconds {
1379 0     0     my $query = shift;
1380 0           my $node = shift;
1381 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1382 0           throw RDF::Query::Error::TypeError -text => "sparql:seconds called without a literal term";
1383             }
1384 0           my $dt = $node->datetime;
1385 0 0         if ($dt) {
1386 0           return RDF::Query::Node::Literal->new($dt->second, undef, $xsd->decimal);
1387             } else {
1388 0           throw RDF::Query::Error::TypeError -text => "sparql:seconds called without a valid dateTime";
1389             }
1390             }
1391              
1392             =item * sparql:timezone
1393              
1394             =cut
1395              
1396             sub _timezone {
1397 0     0     my $query = shift;
1398 0           my $node = shift;
1399 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1400 0           throw RDF::Query::Error::TypeError -text => "sparql:timezone called without a literal term";
1401             }
1402 0           my $dt = $node->datetime;
1403 0 0         if ($dt) {
1404 0           my $tz = $dt->time_zone;
1405 0 0         if ($tz->is_floating) {
1406 0           throw RDF::Query::Error::TypeError -text => "sparql:timezone called with a dateTime without a timezone";
1407             }
1408 0 0         if ($tz) {
1409 0           my $offset = $tz->offset_for_datetime( $dt );
1410 0           my $minus = '';
1411 0 0         if ($offset < 0) {
1412 0           $minus = '-';
1413 0           $offset = -$offset;
1414             }
1415              
1416 0           my $duration = "${minus}PT";
1417 0 0         if ($offset >= 60*60) {
1418 0           my $h = int($offset / (60*60));
1419 0 0         $duration .= "${h}H" if ($h > 0);
1420 0           $offset = $offset % (60*60);
1421             }
1422 0 0         if ($offset >= 60) {
1423 0           my $m = int($offset / 60);
1424 0 0         $duration .= "${m}M" if ($m > 0);
1425 0           $offset = $offset % 60;
1426             }
1427 0           my $s = int($offset);
1428 0 0 0       $duration .= "${s}S" if ($s > 0 or $duration eq 'PT');
1429            
1430 0           return RDF::Query::Node::Literal->new($duration, undef, $xsd->dayTimeDuration);
1431             }
1432             }
1433 0           throw RDF::Query::Error::TypeError -text => "sparql:timezone called without a valid dateTime";
1434             }
1435              
1436             =item * sparql:tz
1437              
1438             =cut
1439              
1440             sub _tz {
1441 0     0     my $query = shift;
1442 0           my $node = shift;
1443 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1444 0           throw RDF::Query::Error::TypeError -text => "sparql:tz called without a literal term";
1445             }
1446 0           my $dt = $node->datetime;
1447 0 0         if ($dt) {
1448 0           my $tz = $dt->time_zone;
1449 0 0         if ($tz->is_floating) {
1450 0           return RDF::Query::Node::Literal->new('');
1451             }
1452 0 0         if ($tz->is_utc) {
1453 0           return RDF::Query::Node::Literal->new('Z');
1454             }
1455 0 0         if ($tz) {
1456 0           my $offset = $tz->offset_for_datetime( $dt );
1457 0           my $hours = 0;
1458 0           my $minutes = 0;
1459 0           my $minus = '+';
1460 0 0         if ($offset < 0) {
1461 0           $minus = '-';
1462 0           $offset = -$offset;
1463             }
1464              
1465 0 0         if ($offset >= 60*60) {
1466 0           $hours = int($offset / (60*60));
1467 0           $offset = $offset % (60*60);
1468             }
1469 0 0         if ($offset >= 60) {
1470 0           $minutes = int($offset / 60);
1471 0           $offset = $offset % 60;
1472             }
1473 0           my $seconds = int($offset);
1474            
1475 0           my $tz = sprintf('%s%02d:%02d', $minus, $hours, $minutes);
1476 0           return RDF::Query::Node::Literal->new($tz);
1477             } else {
1478 0           return RDF::Query::Node::Literal->new('');
1479             }
1480             }
1481 0           throw RDF::Query::Error::TypeError -text => "sparql:tz called without a valid dateTime";
1482             }
1483              
1484             =item * sparql:now
1485              
1486             =cut
1487              
1488             sub _now {
1489 0     0     my $query = shift;
1490 0           my $dt = DateTime->now;
1491 0           my $value = DateTime::Format::W3CDTF->new->format_datetime( $dt );
1492 0           return RDF::Query::Node::Literal->new( $value, undef, 'http://www.w3.org/2001/XMLSchema#dateTime' );
1493             }
1494              
1495             =item * sparql:strbefore
1496              
1497             =cut
1498              
1499             sub _strbefore {
1500 0     0     my $query = shift;
1501 0           my $node = shift;
1502 0           my $substr = shift;
1503 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1504 0           throw RDF::Query::Error::TypeError -text => "sparql:strbefore called without a literal arg1 term";
1505             }
1506 0 0 0       unless (blessed($substr) and $substr->isa('RDF::Query::Node::Literal')) {
1507 0           throw RDF::Query::Error::TypeError -text => "sparql:strbefore called without a literal arg2 term";
1508             }
1509 0 0 0       if ($node->has_datatype and $node->literal_datatype ne 'http://www.w3.org/2001/XMLSchema#string') {
1510 0           throw RDF::Query::Error::TypeError -text => "sparql:strbefore called with a datatyped (non-xsd:string) literal";
1511             }
1512            
1513 0   0       my $lhs_simple = not($node->has_language or $node->has_datatype);
1514 0   0       my $lhs_xsd = ($node->has_datatype and $node->literal_datatype eq 'http://www.w3.org/2001/XMLSchema#string');
1515 0   0       my $rhs_simple = not($substr->has_language or $substr->has_datatype);
1516 0   0       my $rhs_xsd = ($substr->has_datatype and $substr->literal_datatype eq 'http://www.w3.org/2001/XMLSchema#string');
1517 0 0 0       if (($lhs_simple or $lhs_xsd) and ($rhs_simple or $rhs_xsd)) {
    0 0        
    0 0        
      0        
      0        
      0        
      0        
1518             # ok
1519             } elsif ($node->has_language and $substr->has_language and $node->literal_value_language eq $substr->literal_value_language) {
1520             # ok
1521             } elsif ($node->has_language and ($rhs_simple or $rhs_xsd)) {
1522             # ok
1523             } else {
1524 0           throw RDF::Query::Error::TypeError -text => "sparql:strbefore called with literals that are not argument compatible";
1525             }
1526            
1527 0           my $value = $node->literal_value;
1528 0           my $match = $substr->literal_value;
1529 0           my $i = index($value, $match, 0);
1530 0 0         if ($i < 0) {
1531 0           return RDF::Query::Node::Literal->new('');
1532             } else {
1533 0           return RDF::Query::Node::Literal->new(substr($value, 0, $i), $node->type_list);
1534             }
1535             }
1536              
1537             =item * sparql:strafter
1538              
1539             =cut
1540              
1541             sub _strafter {
1542 0     0     my $query = shift;
1543 0           my $node = shift;
1544 0           my $substr = shift;
1545 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1546 0           throw RDF::Query::Error::TypeError -text => "sparql:strafter called without a literal arg1 term";
1547             }
1548 0 0 0       unless (blessed($substr) and $substr->isa('RDF::Query::Node::Literal')) {
1549 0           throw RDF::Query::Error::TypeError -text => "sparql:strafter called without a literal arg2 term";
1550             }
1551 0 0 0       if ($node->has_datatype and $node->literal_datatype ne 'http://www.w3.org/2001/XMLSchema#string') {
1552 0           throw RDF::Query::Error::TypeError -text => "sparql:strafter called with a datatyped (non-xsd:string) literal";
1553             }
1554            
1555 0   0       my $lhs_simple = not($node->has_language or $node->has_datatype);
1556 0   0       my $lhs_xsd = ($node->has_datatype and $node->literal_datatype eq 'http://www.w3.org/2001/XMLSchema#string');
1557 0   0       my $rhs_simple = not($substr->has_language or $substr->has_datatype);
1558 0   0       my $rhs_xsd = ($substr->has_datatype and $substr->literal_datatype eq 'http://www.w3.org/2001/XMLSchema#string');
1559 0 0 0       if (($lhs_simple or $lhs_xsd) and ($rhs_simple or $rhs_xsd)) {
    0 0        
    0 0        
      0        
      0        
      0        
      0        
1560             # ok
1561             } elsif ($node->has_language and $substr->has_language and $node->literal_value_language eq $substr->literal_value_language) {
1562             # ok
1563             } elsif ($node->has_language and ($rhs_simple or $rhs_xsd)) {
1564             # ok
1565             } else {
1566 0           throw RDF::Query::Error::TypeError -text => "sparql:strafter called with literals that are not argument compatible";
1567             }
1568            
1569 0           my $value = $node->literal_value;
1570 0           my $match = $substr->literal_value;
1571 0           my $i = index($value, $match, 0);
1572 0 0         if ($i < 0) {
1573 0           return RDF::Query::Node::Literal->new('');
1574             } else {
1575 0           return RDF::Query::Node::Literal->new(substr($value, $i+length($match)), $node->type_list);
1576             }
1577             }
1578              
1579             =item * sparql:replace
1580              
1581             =cut
1582              
1583             sub _replace {
1584 0     0     my $query = shift;
1585 0           my $node = shift;
1586 0           my $pat = shift;
1587 0           my $rep = shift;
1588 0 0 0       unless (blessed($node) and $node->isa('RDF::Query::Node::Literal')) {
1589 0           throw RDF::Query::Error::TypeError -text => "sparql:replace called without a literal arg1 term";
1590             }
1591 0 0 0       unless (blessed($pat) and $pat->isa('RDF::Query::Node::Literal')) {
1592 0           throw RDF::Query::Error::TypeError -text => "sparql:replace called without a literal arg2 term";
1593             }
1594 0 0 0       unless (blessed($rep) and $rep->isa('RDF::Query::Node::Literal')) {
1595 0           throw RDF::Query::Error::TypeError -text => "sparql:replace called without a literal arg3 term";
1596             }
1597 0 0 0       if ($node->has_datatype and $node->literal_datatype ne 'http://www.w3.org/2001/XMLSchema#string') {
1598 0           throw RDF::Query::Error::TypeError -text => "sparql:replace called with a datatyped (non-xsd:string) literal";
1599             }
1600 0           my $value = $node->literal_value;
1601 0           my $pattern = $pat->literal_value;
1602 0           my $replace = $rep->literal_value;
1603 0 0 0       if (index($pattern, '(?{') != -1 or index($pattern, '(??{') != -1) {
1604 0           throw RDF::Query::Error::FilterEvaluationError ( -text => 'REPLACE() called with unsafe ?{} match pattern' );
1605             }
1606 0 0 0       if (index($replace, '(?{') != -1 or index($replace, '(??{') != -1) {
1607 0           throw RDF::Query::Error::FilterEvaluationError ( -text => 'REPLACE() called with unsafe ?{} replace pattern' );
1608             }
1609            
1610 0           $replace =~ s/\\/\\\\/g;
1611 0           $replace =~ s/\$(\d+)/\$$1/g;
1612 0           $replace =~ s/"/\\"/g;
1613 0           $replace = qq["$replace"];
1614 35     35   341 no warnings 'uninitialized';
  35         87  
  35         9488  
1615 0           $value =~ s/$pattern/"$replace"/eeg;
  0            
1616             # warn "==> " . Dumper($value);
1617 0           return RDF::Query::Node::Literal->new($value, $node->type_list);
1618             }
1619              
1620             sub _uuid {
1621 0     0     my $query = shift;
1622 0           my $u = Data::UUID->new();
1623 0           return iri('urn:uuid:' . $u->to_string( $u->create() ));
1624             }
1625              
1626             sub _struuid {
1627 0     0     my $query = shift;
1628 0           my $u = Data::UUID->new();
1629 0           return literal($u->to_string( $u->create() ));
1630             }
1631              
1632              
1633             1;
1634              
1635             __END__
1636              
1637             =item * http://www.w3.org/2001/XMLSchema#boolean
1638              
1639             =item * http://www.w3.org/2001/XMLSchema#dateTime
1640              
1641             =item * http://www.w3.org/2001/XMLSchema#decimal
1642              
1643             =item * http://www.w3.org/2001/XMLSchema#double
1644              
1645             =item * http://www.w3.org/2001/XMLSchema#float
1646              
1647             =item * http://www.w3.org/2001/XMLSchema#integer
1648              
1649             =item * http://www.w3.org/2001/XMLSchema#string
1650              
1651             =back
1652              
1653             =head1 AUTHOR
1654              
1655             Gregory Williams <gwilliams@cpan.org>.
1656              
1657             =cut