view release on metacpan or  search on metacpan

lib/Attean/API/Term.pm  view on Meta::CPAN

		} elsif ($self->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string') {
			foreach my $t (@terms) {
				return 0 unless ($t->does('Attean::API::Literal'));
				return 0 if ($t->language);
				return 0 unless (blessed($t->datatype));
				return 0 unless ($t->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string');
			}
			return 1;
		}
		
		return 0;
	}
	
	sub _ntriples_string {
		my $self	= shift;
		my $str		= sprintf('"%s"', $self->__ntriples_string);
		if (my $l = $self->language) {
			return join('@', $str, $l);
		} else {
			my $dt	= $self->datatype;
			if ($dt->value eq 'http://www.w3.org/2001/XMLSchema#string') {
				return $str;
			} else {
				return join('^^', $str, $dt->ntriples_string);
			}
		}
	}

	around as_sparql => sub {
		my $orig	= shift;
		my $self	= shift;
		my $s		= $self->$orig(@_);
		
		if ($s =~ m[^"(true|false)"\^\^<http://www[.]w3[.]org/2001/XMLSchema#boolean>$]) {
			return $1;
		}
		
		return $s;
	};
}

package Attean::API::DateTimeLiteral 0.035 {
	use DateTime::Format::W3CDTF;

	use Moo::Role;

	sub datetime {
		my $self	= shift;
		my $w3c	= DateTime::Format::W3CDTF->new;
		return $w3c->parse_datetime( $self->value );
	}
}

package Attean::API::CanonicalizingLiteral 0.035 {
	use Moo::Role;
	requires 'canonicalized_term';
	requires 'canonicalized_term_strict';
}

package Attean::API::BooleanLiteral 0.035 {
	use Scalar::Util qw(blessed looks_like_number);

	use Moo::Role;

	sub canonicalized_term_strict {
		my $self	= shift;
		my $value	= $self->value;
		if ($value =~ m/^(true|false|0|1)$/) {
			return ($value eq 'true' or $value eq '1')
				? Attean::Literal->true
				: Attean::Literal->false;
		} else {
			die "Bad lexical form for xsd:boolean: '$value'";
		}
	}

	sub canonicalized_term {
		my $self	= shift;
		my $value	= $self->value;
		if ($value =~ m/^(true|false|0|1)$/) {
			return ($value eq 'true' or $value eq '1')
				? Attean::Literal->true
				: Attean::Literal->false;
		} else {
			return $self;
		}
	}
	with 'Attean::API::Literal', 'Attean::API::CanonicalizingLiteral';
}

package Attean::API::NumericLiteral 0.035 {
	use Scalar::Util qw(blessed looks_like_number);

	use Moo::Role;

	sub equals {
		my ($a, $b)	= @_;
		return 0 unless ($b->does('Attean::API::NumericLiteral'));
		return $a->numeric_value == $b->numeric_value;
	}

	sub compare {
		my ($a, $b)	= @_;
		return 1 unless blessed($b);
		return 1 unless ($b->does('Attean::API::Literal') or $b->does('Attean::API::Binding'));
		return -1 if ($b->does('Attean::API::Binding'));
		if ($b->does('Attean::API::NumericLiteral')) {
			return $a->numeric_value <=> $b->numeric_value;
		} else {
			return 1;
# 			Attean::API::Literal::compare($a, $b);
		}
	}

	sub canonicalized_term_strict {
		my $self	= shift;
		return $self->_canonicalized_term(1, @_);
	}
	
	sub canonicalized_term {
		my $self	= shift;
		return $self->_canonicalized_term(0, @_);
	}
	
	sub _canonicalized_term {
		my $self	= shift;
		my $strict	= shift;
		my $value	= $self->value;
		my $type	= $self->datatype->value;
		$type		=~ s/^.*#//;
		if ($type eq 'integer') {
			if ($value =~ m/^([-+])?(\d+)$/) {
				my $sign	= $1 || '';
				my $num		= $2;
				$sign		= '' if ($sign eq '+');
				$num		=~ s/^0+(\d)/$1/;
				return Attean::Literal->integer("${sign}${num}");
			} else {
 				die "Bad lexical form for xsd:integer: '$value'" if ($strict);
				return $self;
			}
		} elsif ($type eq 'negativeInteger') {
			if ($value =~ m/^-(\d+)$/) {
				my $num		= $1;
				$num		=~ s/^0+(\d)/$1/;
				return Attean::Literal->new(value => "-${num}", datatype => 'http://www.w3.org/2001/XMLSchema#negativeInteger');
			} else {
				die "Bad lexical form for xsd:integer: '$value'" if ($strict);
				return $self;
			}
		} elsif ($type eq 'decimal') {
			if ($value =~ m/^([-+])?((\d+)([.]\d*)?)$/) {

lib/Attean/API/Term.pm  view on Meta::CPAN

			} else {
				die "Bad lexical form for xsd:float: '$value'" if ($strict);
				return $self;
			}
		} elsif ($type eq 'boolean') {
			if ($value =~ m/^(true|false|0|1)$/) {
				return ($value eq 'true' or $value eq '1')
					? Attean::Literal->true
					: Attean::Literal->false;
			} else {
				die "Bad lexical form for xsd:boolean: '$value'" if ($strict);
				return $self;
			}
		} elsif ($type eq 'double') {
			if ($value =~ m/^(?:([-+])?(?:(\d+(?:\.\d*)?|\.\d+)([Ee][-+]?\d+)?|(INF)))|(NaN)$/) {
				my $sign	= $1;
				my $inf		= $4;
				my $nan		= $5;
				no warnings 'uninitialized';
				$sign		= '' if ($sign eq '+');
				return Attean::Literal->double("${sign}$inf") if ($inf);
				return Attean::Literal->double($nan) if ($nan);

				$value		= sprintf('%E', $value);
				$value 		=~ m/^(?:([-+])?(?:(\d+(?:\.\d*)?|\.\d+)([Ee][-+]?\d+)?|(INF)))|(NaN)$/;
				$sign		= $1;
				$inf		= $4;
				$nan		= $5;
				my $num		= $2;
				my $exp		= $3;
				$num		=~ s/[.](\d+?)0+/.$1/;
				$exp	=~ tr/e/E/;
				$exp	=~ s/E[+]/E/;
				$exp	=~ s/E(-?)0+([1-9])$/E$1$2/;
				$exp	=~ s/E(-?)0+$/E${1}0/;
				return Attean::Literal->double("${sign}${num}${exp}");
			} else {
				die "Bad lexical form for xsd:double: '$value'" if ($strict);
				return $self;
			}
		} else {
			warn "No canonicalization for type $type";
		}
		return $self;
	}
	
	sub is_integer_type {
		my $self	= shift;
		my $type	= $self->datatype->value;
		return scalar($type =~ qr<^http://www[.]w3[.]org/2001/XMLSchema#(?:integer|non(?:Positive|Negative)Integer|(?:positive|negative)Integer|long|int|short|byte|unsigned(?:Long|Int|Short|Byte))$>);
	}
	
	sub ebv {
		my $self	= shift;
		return ($self->numeric_value != 0);
	}

	sub numeric_value {
		my $self	= shift;
		my $v		= $self->value;
		return (looks_like_number($v)) ? eval $v : undef;
	}

	{
		my %type_hierarchy	= (
			'integer'				=> 'decimal',
			'nonPositiveInteger'	=> 'integer',
			'negativeInteger'		=> 'nonPositiveInteger',
			'long'					=> 'integer',
			'int'					=> 'long',
			'short'					=> 'int',
			'byte'					=> 'short',
			'nonNegativeInteger'	=> 'integer',
			'unsignedLong'			=> 'nonNegativeInteger',
			'unsignedInt'			=> 'unsignedLong',
			'unsignedShort'			=> 'unsignedInt',
			'unsignedByte'			=> 'unsignedShort',
			'positiveInteger'		=> 'nonNegativeInteger',
		);
		sub _lca {
			my ($lhs, $rhs)	= @_;
			for ($lhs, $rhs) {
				s/^.*#//;
			}
			return "http://www.w3.org/2001/XMLSchema#$lhs" if ($lhs eq $rhs);
			my $cur	= $lhs;
			my %ancestors	= ($cur => 1);
			while ($cur = $type_hierarchy{$cur}) {
				$ancestors{$cur}++;
				return "http://www.w3.org/2001/XMLSchema#$cur" if ($cur eq $rhs);
			}
			$cur	= $rhs;
			while ($cur = $type_hierarchy{$cur}) {
				return "http://www.w3.org/2001/XMLSchema#$cur" if exists $ancestors{$cur};
			}
			return;
		}
		sub binary_promotion_type {
			my $self	= shift;
			my $rhs		= shift;
			my $op		= shift;
			
			if ($op =~ m<^[-+*]$>) {
				# return common numeric type
				if (my $type = _lca($self->datatype->value, $rhs->datatype->value)) {
					return $type;
				}
				return 'http://www.w3.org/2001/XMLSchema#double';
			} elsif ($op eq '/') {
				if ($self->is_integer_type and $rhs->is_integer_type) {
					# return xsd:decimal if both operands are integers
					return 'http://www.w3.org/2001/XMLSchema#decimal';
				}
				if (my $type = _lca($self->datatype->value, $rhs->datatype->value)) {
					return $type;
				}
				return 'http://www.w3.org/2001/XMLSchema#double';
			}
			die "Unexpected numeric operation in binary_promotion_type: $op";
		}
	}