RDF::Trine::Node::Resource - RDF Node class for resources

# RDF::Trine::Node::Resource
# -----------------------------------------------------------------------------

package RDF::Trine::Node::Resource;

use strict;
use warnings;
no warnings 'redefine';
use base qw(RDF::Trine::Node);

use URI 1.52;
use Encode;
use Data::Dumper;
use Scalar::Util qw(blessed reftype refaddr);
use Carp qw(carp croak confess);

######################################################################

our ($VERSION, %sse, %ntriples);
BEGIN {
	$VERSION	= '0.135';
}

######################################################################

use overload	'""'	=> sub { $_[0]->sse },
			;

sub new {
	my $class	= shift;
	my $uri		= shift;
	my $base_uri	= shift;
	
	if (defined($base_uri)) {
		$base_uri	= (blessed($base_uri) and $base_uri->isa('RDF::Trine::Node::Resource')) ? $base_uri->uri_value : "$base_uri";
		$uri	= URI->new_abs($uri, $base_uri)->as_iri;
	}
# 	my @uni;
# 	my $count	= 0;
# 	
# 	my $buri;
# 	if (defined($base_uri)) {
# 		$buri	= (blessed($base_uri) and $base_uri->isa('RDF::Trine::Node::Resource')) ? $base_uri->uri_value : "$base_uri";
# 		while ($buri =~ /([\x{00C0}-\x{EFFFF}]+)/) {
# 			my $text	= $1;
# 			push(@uni, $text);
# 			$buri		=~ s/$1/',____rq' . $count . '____,'/e;
# 			$count++;
# 		}
# 	}
# 	
# 	while ($uri =~ /([\x{00C0}-\x{EFFFF}]+)/) {
# 		my $text	= $1;
# 		push(@uni, $text);
# 		$uri		=~ s/$1/',____rq' . $count . '____,'/e;
# 		$count++;
# 	}
# 	
# 	if (defined($base_uri)) {
# 		### We have to work around the URI module not accepting IRIs. If there's
# 		### Unicode in the IRI, pull it out, leaving behind a breadcrumb. Turn
# 		### the URI into an absolute URI, and then replace the breadcrumbs with
# 		### the Unicode.
# 		
# 		my $abs			= URI->new_abs( $uri, $buri );
# 		$uri			= $abs->as_string;
# 	}
# 
# 	while ($uri =~ /,____rq(\d+)____,/) {
# 		my $num	= $1;
# 		my $i	= index($uri, ",____rq${num}____,");
# 		my $len	= 12 + length($num);
# 		substr($uri, $i, $len)	= shift(@uni);
# 	}
# 	
	return bless( [ 'URI', $uri ], $class );
}

sub uri_value {
	my $self	= shift;
	return $self->[1];
}

sub value {
	my $self	= shift;
	return $self->uri_value;
}

sub uri {
	my $self	= shift;
	if (@_) {
		$self->[1]	= shift;
		delete $sse{ refaddr($self) };
		delete $ntriples{ refaddr($self) };
	}
	return $self->[1];
}

sub sse {
	my $self	= shift;
	my $context	= shift;
	
	if ($context) {
		my $uri		= $self->uri_value;
		my $ns		= $context->{namespaces} || {};
		my %ns		= %$ns;
		foreach my $k (keys %ns) {
			my $v	= $ns{ $k };
			if (index($uri, $v) == 0) {
				my $qname	= join(':', $k, substr($uri, length($v)));
				return $qname;
			}
		}
	}
	
	my $ra	= refaddr($self);
	if ($sse{ $ra }) {
		return $sse{ $ra };
	} else {
		my $string	= URI->new( encode_utf8($self->uri_value) )->canonical;
		my $sse		= '<' . $string . '>';
		$sse{ $ra }	= $sse;
		return $sse;
	}
	
# 	my $string	= $uri;
# 	my $escaped	= $self->_unicode_escape( $string );
# 	return '<' . $escaped . '>';
}

sub as_string {
	my $self	= shift;
	return '<' . $self->uri_value . '>';
}

sub as_ntriples {
	my $self	= shift;
	my $context	= shift;
	my $ra		= refaddr($self);
	if ($ntriples{ $ra }) {
		return $ntriples{ $ra };
	} else {
		my $string		= URI->new( encode_utf8($self->uri_value) )->canonical;
		my $ntriples	= '<' . $string . '>';
		$ntriples{ $ra }	= $ntriples;
		return $ntriples;
	}
	
# 	my $uri		= $self->uri_value;
# 	my $string	= $uri;
# 	$string	=~ s/\\/\\\\/g;
# 	my $escaped	= $self->_unicode_escape( $string );
# 	$escaped	=~ s/"/\\"/g;
# 	$escaped	=~ s/\n/\\n/g;
# 	$escaped	=~ s/\r/\\r/g;
# 	$escaped	=~ s/\t/\\t/g;
# 	return '<' . $escaped . '>';
}

sub type {
	return 'URI';
}

sub equal {
	my $self	= shift;
	my $node	= shift;
	return 0 unless defined($node);
	return 1 if (refaddr($self) == refaddr($node));
	return 0 unless (blessed($node) and $node->isa('RDF::Trine::Node::Resource'));
	return ($self->[1] eq $node->[1]);
}

# called to compare two nodes of the same type
sub _compare {
	my $a	= shift;
	my $b	= shift;
	return ($a->uri_value cmp $b->uri_value);
}

sub qname {
	my $p		= shift;
	my $uri		= $p->uri_value;

	our $r_PN_CHARS_BASE	||= qr/([A-Z]|[a-z]|[\x{00C0}-\x{00D6}]|[\x{00D8}-\x{00F6}]|[\x{00F8}-\x{02FF}]|[\x{0370}-\x{037D}]|[\x{037F}-\x{1FFF}]|[\x{200C}-\x{200D}]|[\x{2070}-\x{218F}]|[\x{2C00}-\x{2FEF}]|[\x{3001}-\x{D7FF}]|[\x{F900}-\x{FDCF}]|[\x{FDF0}-\x{FFFD}]|[\x{10000}-\x{EFFFF}])/;
	our $r_PN_CHARS_U		||= qr/(_|${r_PN_CHARS_BASE})/;
	our $r_PN_CHARS			||= qr/${r_PN_CHARS_U}|-|[0-9]|\x{00B7}|[\x{0300}-\x{036F}]|[\x{203F}-\x{2040}]/;
	our $r_PN_LOCAL			||= qr/((${r_PN_CHARS_U})((${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/;
	if ($uri =~ m/${r_PN_LOCAL}$/) {
		my $ln	= $1;
		my $ns	= substr($uri, 0, length($uri)-length($ln));
		return ($ns, $ln);
	} else {
		throw RDF::Trine::Error -text => "Can't turn IRI $uri into a QName.";
	}
}

sub DESTROY {
	my $self	= shift;
	delete $sse{ refaddr($self) };
	delete $ntriples{ refaddr($self) };
}

1;

__END__