view release on metacpan or  search on metacpan

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

	}
	
	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*)?)$/) {
				my $sign	= $1 || '';
				my $num		= $2;
				my $int		= $3;
				my $frac	= $4;
				$sign		= '' if ($sign eq '+');
				$num		=~ s/^0+(.)/$1/;
				$num		=~ s/[.](\d+)0+$/.$1/;
				if ($num =~ /^[.]/) {
					$num	= "0$num";
				}
				if ($num !~ /[.]/) {
					$num	= "${num}.0";
				}
				return Attean::Literal->decimal("${sign}${num}");
			} elsif ($value =~ m/^([-+])?([.]\d+)$/) {
				my $sign	= $1 || '';
				my $num		= $2;
				$sign		= '' if ($sign eq '+');
				$num		=~ s/^0+(.)/$1/;
				return Attean::Literal->decimal("${sign}${num}");
			} else {
				die "Bad lexical form for xsd:deciaml: '$value'" if ($strict);
				return $self;
			}
		} elsif ($type eq 'float') {
			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->float("${sign}$inf") if ($inf);
				return Attean::Literal->float($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->float("${sign}${num}${exp}");
			} 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);