#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

# $Id: N3Serializer.pm,v 1.30 2007-09-26 17:58:41 eric Exp $

use strict;
require Exporter;
#require AutoLoader;

use W3C::Rdf::EmitterInterface;

$W3C::Rdf::RdfDB::REVISION = '$Id: N3Serializer.pm,v 1.30 2007-09-26 17:58:41 eric Exp $ ';

package W3C::Rdf::N3Serializer;
use vars qw($VERSION $DSLI @ISA @TODO @EXPORT_OK);
@ISA = qw(W3C::Util::NamedParmObject Exporter); # AutoLoader);
@TODO = qw();
@EXPORT_OK = qw();
$VERSION = 0.95;
$DSLI = 'adpO';

use W3C::Util::Exception;
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI);
use W3C::Util::NamespaceHandler qw(&staticUnmapNamespace &staticMakeUpPrefix);

sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->{-rdfTag} = $self->{-atomDictionary}->getUri($RDF_SCHEMA_URI.'RDF')->getUri;
    if (!defined $self->{-depth}) {
	$self->{-depth} = 0;
    }
    if (!defined $self->{-namespaceHandler}) {
	$self->{-namespaceHandler} = new W3C::Util::NamespaceHandler(-importMap => $self->{-importMap}, 
								     -createNamespaces => $self->{-createNamespaces}, 
								     -namespaceCreativity => $self->{-namespaceCreativity});
    }
    $self->{NS_INVENTOR} = new W3C::Util::NamespaceInventor(-importMap => $self->{-importMap}, 
							    -namespaceCreativity => $self->{-namespaceCreativity});
    $self->{CURRENT_SUBJECT} = undef;
    $self->{PENDING_NAMESPACES} = {};
    $self->{PENDING_NAMESPACES_REVERSE} = {};
    if (!defined $self->{-text}) {
	$self->{-text} = [];
    }
    return $self;
}

sub getNamespaceHandler {
    my ($self) = @_;
    return $self->{-namespaceHandler};
}

sub nest {
    return 1;
}

sub collection {
    return 1;
}

sub getText {
    my ($self) = @_;
    return join ("\n", @{$self->{-text}}, undef);
}

use vars qw(%BNodesOut);
%BNodesOut = ();

sub showAtom {
    my ($self, $atom) = @_;
    if ($atom->isa('W3C::Rdf::String')) {
	my $dtStr = '';
	if (my $dt = $atom->getDatatype()) {
	    $dtStr = '^^<'.$dt->getUri().'>';
	}
	my $encodedLexical = $atom->getString();
	$encodedLexical =~ s/\\/\\\\/gsm;
	$encodedLexical =~ s/\"/\\\"/gsm;
	$encodedLexical =~ s/\n/\\n/gsm;
	return "\"$encodedLexical\"$dtStr";
    } elsif ($atom->isa('W3C::Rdf::BNode')) {
	my $outAtom = $BNodesOut{$atom};
	if (!$outAtom) {
	    $outAtom = $self->{-atomDictionary}->createBNode($self->{-resource});
	    $BNodesOut{$atom} = $outAtom;
	}
	return '_:_'.$outAtom->getId().'';
    } elsif ($atom->isa('W3C::Rdf::Uri')) {
	my $atomStr = $atom->getUri();
	return $self->unmap($atomStr);
    } else {
	&throw(new W3C::Util::ProgramFlowException());
    }
}

sub startDocument {
    my ($self) = @_;
}

sub endDocument {
    my ($self) = @_;
}

sub serializeStatements {
    my ($self, $withThisSubject, $iterator, $forceAbout) = @_;
    my $subjectNode = $withThisSubject->[0]->getSubject;
    my %attrs;

    my $subjectSerialization = undef;
    my $closeFrame = 0;
    if (defined $self->{CURRENT_SUBJECT}) {
	if ($self->{CURRENT_SUBJECT} != $subjectNode) {
	    &throw(new W3C::Util::ProgramFlowException());
	}
	# $subjectSerialization remaines undef;
    } elsif ($subjectNode->isa('W3C::Rdf::Uri')) {
	$subjectSerialization = $self->showAtom($subjectNode);
    } elsif ($subjectNode->isa('W3C::Rdf::BNode')) {
	my $referrers = $iterator->byObject($subjectNode);
	if ($referrers && @$referrers > 0) {
	    $self->{NEEDS_LABEL}{$subjectNode} = $subjectNode;
	}
	if (exists $self->{NEEDS_LABEL}{$subjectNode}) {
	    $subjectSerialization = $self->showAtom($subjectNode);
	} else {
	    my @line = (' ' x ($self->{-depth} * $self->{-indent}));
	    push (@line, '[');
	    push (@{$self->{-text}}, join ('', @line));
	    $closeFrame = 1;
	    $self->{-depth} += 1;
	}	
    } else {
	&throw(new W3C::Util::Exception(-message => "$subjectNode is not a valid subject"));
    }

    $withThisSubject = [@$withThisSubject];
    #$withThisSubject = [sort {&main::PredicateSorter($a, $b)} @$withThisSubject];

    # serialize the element
    $self->sortTypeStatement("$subjectNode", $withThisSubject);

    # any nested statements
    for (my $iStatement = 0; $iStatement < @$withThisSubject; $iStatement++) {
	my $statement = $withThisSubject->[$iStatement];

	# First check for Collections - they're handled differently.
	if ($statement->isa('W3C::Rdf::ListStatement')) {
	    my @line = (' ' x ($self->{-depth} * $self->{-indent}));
	    if ($subjectSerialization) {
		push (@line, $subjectSerialization);
		push (@line, ' ');
	    }
	    push (@line, scalar $self->showAtom($statement->getPredicate()));
	    push (@line, ' (');
	    my $objects = $statement->getObjects;
	    my @obs;
	    foreach my $object (@$objects) {
		#$self->{-depth} += 1;
		#$self->{CURRENT_SUBJECT} = $object;
		#$iterator->handleNestedStatements($object, 1);
		#$self->{-depth} -= 1;
		#$self->{CURRENT_SUBJECT} = undef;
		push (@obs, $self->showAtom($object));
	    }
	    push (@line, join (', ', @obs));
	    push (@line, ') .');
	    push (@{$self->{-text}}, join ('', @line));
	    next;
	}

	# Not a Collection...

	my $object = $statement->getObject();
	my $terminator = $closeFrame || $self->{CURRENT_SUBJECT} ? '' : '.';

	if ($self->_nestable($object, $iterator)) {
	    # Currently, the only nestables are BNodes.

	    my @line = (' ' x ($self->{-depth} * $self->{-indent}));
	    if ($subjectSerialization) {
		push (@line, $subjectSerialization);
		push (@line, ' ');
	    }
	    push (@line, scalar $self->showAtom($statement->getPredicate()));
	    push (@line, ' [');
	    push (@{$self->{-text}}, join ('', @line));

	    $self->{-depth} += 1;
	    $self->{CURRENT_SUBJECT} = $object; # !!! this probably doesn't work
	    $iterator->handleNestedStatements($object, 1);
	    $self->{-depth} -= 1;
	    $self->{CURRENT_SUBJECT} = undef;

	    @line = (' ' x ($self->{-depth} * $self->{-indent}));
	    push (@line, ']');
	    push (@line, ' ');
	    push (@line, $iStatement < @$withThisSubject-1 ? ';' : $terminator);
	    push (@{$self->{-text}}, join ('', @line));
	} else {
	    my @extraObjs;

	    # Look for repeated properties (same predicate, different objects)
	    # so we can make a ','-separated list. They must be contiguous in
	    # the @$withThisSubject list or we will not notice them -- implies
	    # at least predicte sorting.

	    for (; $iStatement < @$withThisSubject - 1 && 
		 $withThisSubject->[$iStatement + 1]->getPredicate == $statement->getPredicate && 
		 !$self->_nestable($withThisSubject->[$iStatement + 1]->getObject(), $iterator); 
		 $iStatement++) {
		push (@extraObjs, $withThisSubject->[$iStatement+1]->getObject);
	    }
	    $self->queue($subjectSerialization, $statement, $iStatement < @$withThisSubject-1 ? ';' : $terminator, \@extraObjs);
	    $iterator->remove($statement);
	}
	if ($subjectSerialization) {
	    $subjectSerialization = ' ' x length ($subjectSerialization);
	}
    }
    if ($closeFrame) {
	$self->{-depth} -= 1;
	my @line = (' ' x ($self->{-depth} * $self->{-indent}));
	push (@line, ']');
	push (@line, ' ');
	push (@line, $self->{CURRENT_SUBJECT} ? '' : '.'); # there can be no more with this subject
	push (@{$self->{-text}}, join ('', @line));
    }
}

sub _nestable {
    my ($self, $node, $iterator) = @_;
    if ($node->isa('W3C::Rdf::BNode') && 
	!$self->{-serializeNoNesting} && 
	$iterator->bySubject($node) && 
	! exists $self->{NEEDS_LABEL}{$node} && 
	@{$iterator->bySubject($node)} > 0) {
	if (@{$iterator->byObject($node)} < 2) {
	    return 1;
	} else {
	    $self->{NEEDS_LABEL}{$node} = $node;
	}

# Removing support for 'is' keyword made it useless to nest nodes
# identified by URI.

#    } elsif ($node->isa('W3C::Rdf::Uri') && 
#	     !$self->{-serializeNoNesting} && 
#	     $iterator->bySubject($node) && 
#	     @{$iterator->bySubject($node)}) {
#	return 1;
    }
    return 0;
}

sub pendNamespace {
    my ($self, $prefix, $ns) = @_;
    unshift (@{$self->{-text}}, "\@prefix $prefix: <$ns> .");
}

sub unmap {
    my ($self, $atomStr) = @_;
    my ($prefix, $remainder);
    my $ret;
    eval {
	my ($ns, $new);
	($ns, $prefix, $remainder, $new) = 
	    $self->{NS_INVENTOR}->unmapNamespace($atomStr, undef, undef, 
						 $self->{-namespaceHandler}, 
						 $self->{-createNamespaces});

	if ($new) {
	    # Note that we will have to write a decl for it.
	    $self->pendNamespace($prefix, $ns);
	}
	$ret = $prefix ? "${prefix}:$remainder" : $remainder;
    }; if ($@) {if (my $ex = &catch('W3C::Util::NoViableLocalnameException')) {
	$ret = "<$atomStr>";
    } elsif ($ex = &catch('W3C::Util::Exception')) {
	&throw($ex);
    } else {
	&throw();
    }}
    return $ret;
}

sub queue {
    my ($self, $subjectSerialization, $statement, $punctuation, $extraObjs) = @_;
    my @line = (' ' x ($self->{-depth} * $self->{-indent}));
    if ($subjectSerialization) {
	push (@line, $subjectSerialization);
	push (@line, ' ');
    }
    push (@line, scalar $self->showAtom($statement->getPredicate()));
    push (@line, ' ');
    push (@line, scalar $self->showAtom($statement->getObject()));
    push (@line, ' ');
    if ($extraObjs && @$extraObjs) {
	push (@line, ', ');
	push (@line, join (' , ', map {$self->showAtom($_)} @$extraObjs));
	push (@line, ' ');
    }
    push (@line, $punctuation);
    push (@{$self->{-text}}, join ('', @line));
}

sub sortTypeStatement {
    my ($self, $node, $withThisSubject) = @_;
    if (!$self->{-serializeTypelessNodes}) {
	# look for type
#	if (defined $withThisSubject) {
	    for (my $i = 0; $i < @$withThisSubject; $i++) {
		my $statement = $withThisSubject->[$i];
		if ($statement->getPredicate == $self->{-atomDictionary}->getUri($RDF_SCHEMA_URI.'type')) {
		    splice (@$withThisSubject, $i, 1); # eliminate type entry
		    unshift(@$withThisSubject, $statement);
		    last;
		}
	    }
#	}
    }
}

sub getTypeStatement {
    my ($self, $node, $withThisSubject) = @_;
    my $ret = undef;
    if (!$self->{-serializeTypelessNodes}) {
	# look for type
#	if (defined $withThisSubject) {
	    for (my $i = 0; $i < @$withThisSubject; $i++) {
		my $statement = $withThisSubject->[$i];
		if ($statement->getPredicate == $self->{-atomDictionary}->getUri($RDF_SCHEMA_URI.'type')) {
		    splice (@$withThisSubject, $i, 1); # eliminate type entry
		    $ret = $statement;
		    last;
		}
	    }
#	}
    }
    return $ret;
}

1;

__END__

=head1 NAME

W3C::Rdf::N3Serializer - serialize RDF graphs in Notation 3 format

=head1 SYNOPSIS

  use W3C::Rdf::Atoms;
  use W3C::Rdf::RdfDB;
  require W3C::Rdf::N3Serializer;
  my $atoms = new W3C::Rdf::Atoms();
  my $rdfDB = new W3C::Rdf::RdfDB(-atomDictionary => $atoms);
  my $algae2 = new W3C::Rdf::Algae2(-atomDictionary => $atoms);
  my $serializer = new W3C::Rdf::N3Serializer(-atomDictionary => $atoms);
  my $iterator = $rdfDB->makeSerializerIterator(undef, $algae2); # $statements, $algae2, %flags
  $iterator->iterate($serializer);
  print $serializer->getText();

=head1 DESCRIPTION

C<W3C::Rdf::RdfDB>'s C<W3C::Rdf::RdfDB::SerializerIterator> calls
C<W3C::Rdf::N3Serializer> to generate Notation 3.

This module is part of the W3C::Rdf CPAN module.

=head1 CONSTRUCTOR

=over 4

=item new ( ATOMS [, FLAGS] )

Creates an C<W3C::Rdf::N3Serializer>.  This must be passed an Atoms dictionary.
Attitional flags:

=back

=head1 METHODS

=over 4

=item collection()

Return whether this serializer has special code for collections. If so,
C<serializeStatements> may be called with a C<W3C::Rdf::Atoms::ListStatement>.

=item nest()

Return whether this serializer can express nested descriptions.

=item startDocument()

Follow SAX convention except there is no document locator (the serializer is
the actual owner of the document).

=item endDocument()

Follow SAX convention.

=item serializeStatements( STATEMENTS, [ ITERATOR ] )

Take a set of statements to be serialized. The C<ITERATOR> is only used if the
serializer attempts to serialize nested (statements with a subject of the
current object). The C<STATENTS> may also be ListStatemens, in which case
special code serializes a collection.

=item getText()

Return a scalar with the serialized RDF. The caller will likely write this to
a file or to a network stream in response to an HTTP GET of some virtual document.

=back

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

L<W3C::Rdf::RdfDB>

=cut
