package RDF::RDFa::Generator::HTML::Head;

use 5.008;
use base qw'RDF::RDFa::Generator';
use strict;
use Encode qw'encode_utf8';
use URI::NamespaceMap 1.05;
use RDF::NS::Curated 0.006;
use XML::LibXML qw':all';
use Carp;
use Scalar::Util qw(blessed);

use warnings;
use Data::Dumper;

our $VERSION = '0.199_05';

sub new
{
   my ($class, %opts) = @_;

	unless (blessed($opts{namespacemap}) && $opts{namespacemap}->isa('URI::NamespaceMap')) {
	  if (defined $opts{namespaces}) {
		 $opts{namespacemap} = URI::NamespaceMap->new($opts{namespaces});
	  } else {
		 my $curated = RDF::NS::Curated->new;
		 $opts{namespacemap} = URI::NamespaceMap->new($curated->all);
	  }
	  
	  # handle deprecated {ns}.
	  if (defined($opts{ns})) {
		 carp "ns option is deprecated by the RDFa serializer";
	  }
	  while (my ($u,$p) = each %{ $opts{ns} }) {
		 $opts{namespacemap}->add_mapping($p => $u);
	  }

	  delete $opts{ns};
	  delete $opts{namespaces}
	}
	$opts{namespacemap}->guess_and_add('rdfa', 'rdf', 'rdfs', 'xsd');
	bless \%opts, $class;
}

sub injection_site
{
	return '//xhtml:head';
}

sub inject_document
{
	my ($proto, $html, $model, %opts) = @_;
	my $dom   = $proto->_get_dom($html);
	my @nodes = $proto->nodes($model, %opts);
	
	my $xc = XML::LibXML::XPathContext->new($dom);
	$xc->registerNs('xhtml', 'http://www.w3.org/1999/xhtml');
	my @sites = $xc->findnodes($proto->injection_site);
	
	die "No suitable place to inject this document." unless @sites;
	
	$sites[0]->appendChild($_) foreach @nodes;
	return $dom;
}

sub create_document
{
	my ($proto, $model, %opts) = @_;
	my $self = (ref $proto) ? $proto : $proto->new;
	
	my $html = sprintf(<<HTML, ($self->{'version'}||'1.0'), ($self->{'title'} || 'RDFa Document'), ref $self);
<html xmlns="http://www.w3.org/1999/xhtml" version="XHTML+RDFa %1\$s">
<head profile="http://www.w3.org/1999/xhtml/vocab">
<title>%2\$s</title>
<meta name="generator" value="%3\$s" />
</head>
<body />
</html>
HTML

	return $proto->inject_document($html, $model, %opts);
}

sub _get_dom
{
	my ($proto, $html) = @_;
	
	return $html if UNIVERSAL::isa($html, 'XML::LibXML::Document');
	
	my $p = XML::LibXML->new;
	return $p->parse_string($html);
}

sub nodes
{
	my ($proto, $model) = @_;
	my $self = (ref $proto) ? $proto : $proto->new;
	
	my $stream = $self->_get_stream($model);
	my @nodes;
	
	while (my $st = $stream->next)
	{
		my $node = $st->object->is_literal ?
			XML::LibXML::Element->new('meta') :
			XML::LibXML::Element->new('link');
		$node->setNamespace('http://www.w3.org/1999/xhtml', undef, 1);
		
		$self->_process_subject($st, $node)
		     ->_process_predicate($st, $node)
		     ->_process_object($st, $node);
		
		if (defined($self->{'version'}) && $self->{'version'} == 1.1
		and $self->{'prefix_attr'})
		{
		  if (defined($self->{namespacemap}->rdfa)) {
			 $node->setAttribute('prefix', $self->{namespacemap}->rdfa->as_string)
		  }
		} else {
		  while (my ($prefix, $nsURI) = $self->{namespacemap}->each_map) {
			 $node->setNamespace($nsURI->as_string, $prefix, 0);
		  }
		}
		
		push @nodes, $node;
	}
	
	return @nodes if wantarray;
	
	my $nodelist = XML::LibXML::NodeList->new;
	$nodelist->push(@nodes);
	return $nodelist;
}

sub _get_stream
{
	my ($self, $model) = @_;
	
	my $data_context = undef;
	if (defined($self->{'data_context'})) {
	  if (! blessed($self->{'data_context'})) {
		 croak "data_context can't be a string anymore, must be a Attean blank or IRI or an RDF::Trine::Node";
	  } elsif ($self->{'data_context'}->does('Attean::API::BlankOrIRI')
				  || $self->{'data_context'}->isa('RDF::Trine::Node')) {
		 croak "data_context must be a Attean blank or IRI or an RDF::Trine::Node, not " . ref($self->{'data_context'});
	  }
	}
	
	return $model->get_quads(undef, undef, undef, $data_context);
}

sub _process_subject
{
	my ($self, $st, $node) = @_;
	
	if (defined $self->{'base'} 
	and $st->subject->is_resource
	and $st->subject->abs eq $self->{'base'})
	{
		return $self;
	}
	
	if ($st->subject->is_resource) 
		{ $node->setAttribute('about', $st->subject->abs); }
	else
		{ $node->setAttribute('about', '[_:'.$st->subject->value.']'); }
	
	return $self;
}

sub _process_predicate
{
	my ($self, $st, $node) = @_;

	my $attr = $st->object->is_literal ? 'property' : 'rel';

	if ($attr eq 'rel'
	and $st->predicate->abs =~ m'^http://www\.w3\.org/1999/xhtml/vocab\#
										(alternate|appendix|bookmark|cite|
										chapter|contents|copyright|first|glossary|help|icon|
										index|last|license|meta|next|p3pv1|prev|role|section|
										stylesheet|subsection|start|top|up)$'x)
	{
		$node->setAttribute($attr, $1);
		return $self;
	}
	elsif ($attr eq 'rel'
	and $st->predicate->abs =~ m'^http://www\.w3\.org/1999/xhtml/vocab#(.*)$')
	{
		$node->setAttribute($attr, ':'.$1);
		return $self;
	}
	elsif (defined($self->{'version'}) && $self->{'version'} == 1.1)
	{
		$node->setAttribute($attr, $st->predicate->abs);
		return $self;
	}
	
	$node->setAttribute($attr, $self->_make_curie($st->predicate));
	
	return $self;
}

sub _process_object
{
	my ($self, $st, $node) = @_;
	
	if (defined $self->{'base'} 
	and $st->subject->is_resource
	and $st->subject->abs eq $self->{'base'}
	and $st->object->is_resource)
	{
		$node->setAttribute('href', $st->object->abs);
		return $self;
	}
	elsif (defined $self->{'base'} 
	and $st->object->is_resource
	and $st->object->abs eq $self->{'base'})
	{
		$node->setAttribute('resource', '');
		return $self;
	}
	elsif ($st->object->is_resource)
	{
		$node->setAttribute('resource', $st->object->abs);
		return $self;
	}
	elsif ($st->object->is_blank)
	{
		$node->setAttribute('resource', '[_:'.$st->object->value.']');
		return $self;
	}
	
	$node->setAttribute('content',  encode_utf8($st->object->value));
	
	if (defined $st->object->datatype)
	{
		$node->setAttribute('datatype', $self->_make_curie($st->object->datatype));
	}
	else
	{
		$node->setAttribute('xml:lang', ''.$st->object->language);
	}
	
	return $self;
}

sub _make_curie {
  my ($self, $uri) = @_;
  my $curie = $self->{namespacemap}->abbreviate($uri);
  unless (defined($curie)) {
	 $uri->value =~ m!(.*)(\#|/)(.*?)$!;
	 my $trim = $1.$2;
	 $self->{namespacemap}->guess_and_add($trim);
	 $curie = $self->{namespacemap}->abbreviate($uri);
  }
  unless (defined($curie)) {
	 $curie = $uri->value;
  }
  return $curie;
}

1;
