1# RDF::Query::Node::Literal
2# -----------------------------------------------------------------------------
3
4=head1 NAME
5
6RDF::Query::Node::Literal - RDF Node class for literals
7
8=head1 VERSION
9
10This document describes RDF::Query::Node::Literal version 2.918.
11
12=cut
13
14package RDF::Query::Node::Literal;
15
16use strict;
17use warnings;
18no warnings 'redefine';
19use base qw(RDF::Query::Node RDF::Trine::Node::Literal);
20
21use DateTime;
22use DateTime::Format::W3CDTF;
23use RDF::Query::Error;
24use Data::Dumper;
25use Log::Log4perl;
26use Scalar::Util qw(blessed refaddr looks_like_number);
27use Carp qw(carp croak confess);
28
29######################################################################
30
31our ($VERSION, $LAZY_COMPARISONS);
32BEGIN {
33	$VERSION	= '2.918';
34}
35
36######################################################################
37
38use overload	'<=>'	=> \&_cmp,
39				'cmp'	=> \&_cmp,
40				'<'		=> sub { _cmp(@_[0,1], '<') == -1 },
41				'>'		=> sub { _cmp(@_[0,1], '>') == 1 },
42				'!='	=> sub { _cmp(@_[0,1], '!=') != 0 },
43				'=='	=> sub { _cmp(@_[0,1], '==') == 0 },
44				'+'		=> sub { $_[0] },
45				'""'	=> sub { $_[0]->sse },
46			;
47
48my %INSIDE_OUT_DATES;
49
50=head1 METHODS
51
52Beyond the methods documented below, this class inherits methods from the
53L<RDF::Query::Node> and L<RDF::Trine::Node::Literal> classes.
54
55=over 4
56
57=cut
58
59sub _cmp {
60	my $nodea	= shift;
61	my $nodeb	= shift;
62	my $op		= shift;
63
64	my $l		= Log::Log4perl->get_logger("rdf.query.node.literal");
65	$l->debug('literal comparison: ' . Dumper($nodea, $nodeb));
66
67	return 1 unless blessed($nodeb);
68	return -1 if ($nodeb->isa('RDF::Trine::Node::Nil'));
69	return 1 if ($nodeb->isa('RDF::Query::Node::Blank'));
70	return 1 if ($nodeb->isa('RDF::Query::Node::Resource'));
71	return 1 unless ($nodeb->isa('RDF::Query::Node::Literal'));
72
73	my $dta			= $nodea->literal_datatype || '';
74	my $dtb			= $nodeb->literal_datatype || '';
75	my $datetype	= '^http://www.w3.org/2001/XMLSchema#dateTime';
76	my $datecmp		= ($dta =~ $datetype and $dtb =~ $datetype);
77	my $numericcmp	= ($nodea->is_numeric_type and $nodeb->is_numeric_type);
78
79	if ($datecmp) {
80		$l->trace('datecmp');
81		my $datea	= $nodea->datetime;
82		my $dateb	= $nodeb->datetime;
83		if ($datea and $dateb) {
84			my $cmp		= eval { DateTime->compare_ignore_floating( $datea, $dateb ) };
85			return $cmp unless ($@);
86		}
87	}
88
89	if ($numericcmp) {
90		$l->trace('both numeric cmp');
91		return 0 if ($nodea->equal( $nodeb ));	# if the nodes are identical, return true (even if the lexical values don't appear to be numeric). i.e., "xyz"^^xsd:integer should equal itself, even though it's not a valid integer.
92		return $nodea->numeric_value <=> $nodeb->numeric_value;
93	}
94
95	{
96		$l->trace('other cmp');
97
98		if ($nodea->has_language and $nodeb->has_language) {
99			$l->trace('both have language');
100			my $lc	= lc($nodea->literal_value_language) cmp lc($nodeb->literal_value_language);
101			my $vc	= $nodea->literal_value cmp $nodeb->literal_value;
102			my $c;
103			if ($LAZY_COMPARISONS and ($lc != 0)) {
104				$c	= ($vc || $lc);
105			} elsif ($lc == 0) {
106				$c	= $vc;
107			} else {
108				$l->debug("Attempt to compare literals with differing languages.");
109				throw RDF::Query::Error::TypeError -text => "Attempt to compare literals with differing languages.";
110			}
111			$l->trace("-> $c");
112			return $c;
113		} elsif (($nodea->has_datatype and $dta eq 'http://www.w3.org/2001/XMLSchema#string') or ($nodeb->has_datatype and $dtb eq 'http://www.w3.org/2001/XMLSchema#string')) {
114			$l->trace("one is xsd:string");
115			no warnings 'uninitialized';
116			my ($na, $nb)	= sort {
117								(blessed($b) and $b->isa('RDF::Query::Node::Literal'))
118									? $b->literal_datatype eq 'http://www.w3.org/2001/XMLSchema#string'
119									: ($LAZY_COMPARISONS)
120										? refaddr($a) <=> refaddr($b)
121										: throw RDF::Query::Error::TypeError -text => "Attempt to compare xsd:string with non-literal";
122							} ($nodea, $nodeb);
123
124			my $c;
125			if ($nb->has_language) {
126				$c	= -1;
127			} elsif (not($nb->has_datatype) or $nb->literal_datatype eq 'http://www.w3.org/2001/XMLSchema#string') {
128				$c	= $nodea->literal_value cmp $nodeb->literal_value;
129			} elsif ($LAZY_COMPARISONS) {
130				return $nodea->as_string cmp $nodeb->as_string;
131			} else {
132				throw RDF::Query::Error::TypeError -text => "Attempt to compare typed-literal with xsd:string.";
133			}
134			$l->trace("-> $c");
135			return $c;
136		} elsif ($nodea->has_datatype and $nodeb->has_datatype) {
137			$l->trace("both have datatype");
138			my $dc	= $nodea->literal_datatype cmp $nodeb->literal_datatype;
139			my $vc	= $nodea->literal_value cmp $nodeb->literal_value;
140			my $c;
141
142			if ($op eq '!=') {
143				throw RDF::Query::Error::TypeError -text => "Attempt to compare (neq) literals with unrecognized datatypes.";
144			} else {
145				if ($LAZY_COMPARISONS) {
146					$c	= ($vc || $dc);
147				} elsif ($dc == 0) {
148					$c	= $vc;
149				} else {
150					$l->debug("Attempt to compare literals with different datatypes.");
151					throw RDF::Query::Error::TypeError -text => "Attempt to compare literals with differing datatypes.";
152				}
153				$l->trace("-> $c");
154				return $c;
155			}
156		} elsif ($nodea->has_language or $nodeb->has_language) {
157			$l->trace("one has language");
158			my $c	= ($nodea->has_language) ? 1 : -1;
159			$l->trace("-> $c");
160			return $c;
161		} elsif ($nodea->has_datatype or $nodeb->has_datatype) {
162			$l->trace("one has datatype");
163			if ($LAZY_COMPARISONS) {
164				my $c	= ($nodea->has_datatype) ? 1 : -1;
165				$l->trace("-> $c");
166				return $c;
167			} else {
168				$l->debug("Attempt to compare typed-literal with plain-literal");
169				throw RDF::Query::Error::TypeError -text => "Attempt to compare typed-literal with plain-literal";
170			}
171		} else {
172			$l->trace("something else");
173			my $vcmp	= $nodea->literal_value cmp $nodeb->literal_value;
174			$l->trace("-> $vcmp");
175			return $vcmp;
176		}
177	}
178}
179
180=item C<< datetime >>
181
182Returns a DateTime object from the literal if the literal value is in W3CDTF format.
183
184=cut
185
186sub datetime {
187	my $self	= shift;
188	my $addr	= refaddr( $self );
189	if (exists($INSIDE_OUT_DATES{ $addr })) {
190		return $INSIDE_OUT_DATES{ $addr };
191	} else {
192		my $value	= $self->literal_value;
193		my $f		= DateTime::Format::W3CDTF->new;
194		my $dt		= eval { $f->parse_datetime( $value ) };
195		$INSIDE_OUT_DATES{ $addr }	= $dt;
196		return $dt;
197	}
198}
199
200=item C<< as_sparql >>
201
202Returns the SPARQL string for this node.
203
204=cut
205
206sub as_sparql {
207	my $self	= shift;
208	if ($self->is_numeric_type) {
209		return $self->literal_value;
210	} else {
211		return $self->sse;
212	}
213}
214
215=item C<< as_hash >>
216
217Returns the query as a nested set of plain data structures (no objects).
218
219=cut
220
221sub as_hash {
222	my $self	= shift;
223	my $context	= shift;
224	my $hash	= {
225		type 		=> 'node',
226		literal		=> $self->literal_value,
227	};
228	$hash->{ language }	= $self->literal_value_language if ($self->has_language);
229	$hash->{ datatype }	= $self->literal_datatype if ($self->has_datatype);
230	return $hash;
231}
232
233=item C<< is_simple_literal >>
234
235Returns true if the literal is "simple" -- is a literal without datatype or language.
236
237=cut
238
239sub is_simple_literal {
240	my $self	= shift;
241	return not($self->has_language or $self->has_datatype);
242}
243
244=item C<< is_numeric_type >>
245
246Returns true if the literal is a known (xsd) numeric type.
247
248=cut
249
250sub is_numeric_type {
251	my $self	= shift;
252	return 0 unless ($self->has_datatype);
253	my $type	= $self->literal_datatype;
254	if ($type =~ qr<^http://www.w3.org/2001/XMLSchema#(integer|decimal|float|double|non(Positive|Negative)Integer|(positive|negative)Integer|long|int|short|byte|unsigned(Long|Int|Short|Byte))>) {
255		return 1;
256	} else {
257		return 0;
258	}
259}
260
261=item C<< numeric_value >>
262
263Returns the numeric value of the literal (even if the literal isn't a known numeric type.
264
265=cut
266
267sub numeric_value {
268	my $self	= shift;
269	if ($self->is_numeric_type) {
270		my $value	= $self->literal_value;
271		if (looks_like_number($value)) {
272			my $v	= 0 + eval "$value";
273			return $v;
274		} else {
275			throw RDF::Query::Error::TypeError -text => "Literal with numeric type does not appear to have numeric value.";
276		}
277	} elsif (not $self->has_datatype) {
278		if (looks_like_number($self->literal_value)) {
279			return 0+$self->literal_value;
280		} else {
281			return;
282		}
283	} elsif ($self->literal_datatype eq 'http://www.w3.org/2001/XMLSchema#boolean') {
284		return ($self->literal_value eq 'true') ? 1 : 0;
285	} else {
286		return;
287	}
288}
289
290=item C<< type_list >>
291
292Returns a two-item list suitable for use as the second and third arguments to
293RDF::Query::Node::Literal constructor. The two returned values correspond to
294literal language tag and literal datatype URI, respectively.
295
296=cut
297
298sub type_list {
299	my $self	= shift;
300	return ($self->literal_value_language, $self->literal_datatype);
301}
302
303sub DESTROY {
304	my $self	= shift;
305	my $addr	= refaddr($self);
306	delete $INSIDE_OUT_DATES{ $addr };
307}
308
309
3101;
311
312__END__
313
314=back
315
316=head1 AUTHOR
317
318 Gregory Todd Williams <gwilliams@cpan.org>
319
320=cut
321