# 
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
# 
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
# 
# The Original Code is the RDF::Core module
# 
# The Initial Developer of the Original Code is Ginger Alliance Ltd.
# Portions created by Ginger Alliance are 
# Copyright (C) 2001 Ginger Alliance Ltd.
# All Rights Reserved.
# 
# Contributor(s):
# 
# Alternatively, the contents of this file may be used under the
# terms of the GNU General Public License Version 2 or later (the
# "GPL"), in which case the provisions of the GPL are applicable 
# instead of those above.  If you wish to allow use of your 
# version of this file only under the terms of the GPL and not to
# allow others to use your version of this file under the MPL,
# indicate your decision by deleting the provisions above and
# replace them with the notice and other provisions required by
# the GPL.  If you do not delete the provisions above, a recipient
# may use your version of this file under either the MPL or the
# GPL.
# 

package RDF::Core::Serializer;

use strict;


use Carp;

require Exporter;
require RDF::Core::Statement;


sub new {
    my ($pkg,%options) = @_;
    $pkg = ref $pkg || $pkg;
    my $self = {};
    #Implemented options are:
    #getNamespaces, getSubjects, getStatements, existsStatement callback functions
    #output - output filehandle reference (a reference to a typeglob or FileHandle) or scalar variable reference (default \*STDOUT)
    $self->{_options} = \%options;
    $self->{_options}->{Output} = \*STDOUT
      unless defined $self->{_options}->{Output};
    $self->{_options}->{BaseURI};
    $self->{_options}->{InlineURI} = '_:'
      unless defined  $self->{_options}->{InlineURI};
    $self->{_options}->{InlinePrefix} ||= '_:a'
      unless defined $self->{_options}->{InlinePrefix};
    $self->{_descriptions} = undef;
    $self->{_namespaces} = undef;
    $self->{_recursionlvl} = 0;
    $self->{_idAttr} = 1;
    $self->{_anonym} = undef;
    bless $self, $pkg;
}
#  sub setOptions {
#      my ($self,$options) = @_;
#      $self->{_options} = $options;
#  }
  sub getOptions {
      my $self = shift;
      return $self->{_options};
  }
sub serialize {
    my $self = shift;
    #get options if passed
    $self->{_options} = $_[0]
      if (@_ gt 0);
    $self->_rdfOpen;
    my $description = $self->_descriptionNext;
    while (defined $description) {
	$self->_descriptionProcess($description);
	$description = $self->_descriptionNext;
    }
    $self->_rdfClose;
}
#callback functions
sub getNamespaces {
    my $self = shift;
    $self->{_namespaces} ||= &{$self->getOptions->{getNamespaces}}(@_);
    return $self->{_namespaces};
}
sub getSubjects {
    #Subjects are stored with 2 flags that say that corresponding description item was open/closed.
    #Array ($subject, openedFlag, closedFlag) will be called description not to mess with $subject itself (RDF::Core::Resource instance)
    my $self = shift;
    $self->{_descriptions} ||= &{$self->getOptions->{getSubjects}}(@_);
    return $self->{_descriptions};
}
sub getStatements {
    my $self = shift;
    return &{$self->getOptions->{getStatements}}(@_);
}
sub existsStatement {
    my $self = shift;
    return &{$self->getOptions->{existsStatement}}(@_);
}
sub _rdfOpen {
    my $self = shift;
    my $namespaces = '';
    foreach (keys %{$self->getNamespaces()}) {
	$namespaces .= "xmlns:".$self->getNamespaces->{$_}."=\"$_\"\n";
    }
    $self->_print ("<rdf:RDF\n$namespaces>\n");
}
sub _rdfClose {
    my $self = shift;
    $self->_print ("</rdf:RDF>\n");
}
#get next description to be processed
sub _descriptionNext {
    my $self = shift;
    my $retval = undef;
    my %searched = undef;
    #first, look for subjects that are not objects of any statement
    foreach (values %{$self->getSubjects}) {
	unless ($_->[1]) {	#search in not yet opened descriptions
	    unless ($self->existsStatement(undef,undef,$_->[0])) {
		$retval = $_;
		last;
	    }
	}
    }
    #then look for subjects that are objects of a statement already serialized
    unless ($retval) {
	foreach (values %{$self->getSubjects}) {
	    unless ($_->[1]) {	#search in not yet opened descriptions
		my $enum = $self->getStatements(undef,undef,$_->[0]);
		my $stmt = $enum->getNext;
		while (defined $stmt) {
		    if ($self->getSubjects->{$stmt->getSubject->getURI}->[2]) {
			$retval = $_;
			last;
		    }
		    $stmt = $enum->getNext;
		}
		$enum->close;
	    }
	    last if $retval;
	}
    }
    #at last, return any subject not serialized yet
    unless ($retval) {
	foreach (values %{$self->getSubjects}) {
	    unless ($_->[1]) {	#search in not yet opened descriptions
		$retval = $_;
		last;
	    }
	}
    }
    return $retval;
}
sub _descriptionProcess {
    my ($self, $description) = @_;
    $self->_descriptionOpen($description);
    my $enumerator = $self->getStatements($description->[0],undef,undef);
    my $statement = $enumerator->getNext;
    while (defined $statement) {
	$self->_descriptionData($statement);
	$statement = $enumerator->getNext;
    }
    $enumerator->close;
    $self->_descriptionClose($description);
}
sub _descriptionOpen {
    my ($self,$description) = @_;
    my $subjectID = $description->[0]->getURI;
    my $idAboutAttr;
    #Anonymous subject can be serialized as anonymous if it's an object of one or zero statements
    #and the referencing statement's subject has already been opened
    my $InlineURI = $self->getOptions->{InlineURI};
    my $baseURI = $self->getOptions->{BaseURI};
    if ($InlineURI && $subjectID =~ /^$InlineURI/i) {
	if ($self->{_recursionlvl} || !$self->existsStatement(undef,undef,$description->[0])) {
	    $idAboutAttr = ''
	} else {
	    #deanonymize resource
	    my $idNew = $self->getOptions->{InlinePrefix}.$self->{idAttr}++;
	    $idAboutAttr = " ID=\"$idNew\"";
	    #store its ID to reference it in other statements
	    $self->{_anonym}->{$subjectID} = '#'.$idNew;
	}
    } elsif ($baseURI && $subjectID =~ /^$baseURI/i) {
	#relative URI - choose whether idAttr or aboutAttr should be produced
	#suggestion - produce aboutAttr every time
	#TODO - synchronize this with isuue rdfms-difference-between-ID-and-about
	my $id = $';
#	$id =~ s/^#//
#	  if $baseURI !~ /#$/;
	$idAboutAttr = " about=\"$'\"";
    } else {
	#absolute URI - produce aboutAttr
	$idAboutAttr = " about=\"$subjectID\"";
    }
    $self->_print ("<rdf:Description$idAboutAttr>\n");
    $self->{_recursionlvl}++;
    $description->[1] = 1;
}
sub _descriptionClose {
    my ($self,$description) = @_;
    $self->{_recursionlvl}--;
    $self->_print ("</rdf:Description>\n");
    $description->[2] = 1;
}
sub _predicateOpen {
    my ($self,$statement,$inline) = @_; #inline says that nested resource should be scripted inline, not referenced
    my $prefix = $self->{_namespaces}->{$statement->getPredicate->getNamespace};
    my $propName = $prefix . ":".$statement->getPredicate->getLocalValue;
    my $propertyElt;
    if ($statement->getObject->isLiteral) {
	$propertyElt="<$propName>";
    } else {
	if ($inline) {
	    $propertyElt="<$propName>\n";
	} else {
	    my $objectURI = $statement->getObject->getURI;
	    $objectURI = $self->{_anonym}->{$objectURI}
	      if exists  $self->{_anonym}->{$objectURI};
	    $propertyElt="<$propName rdf:resource=\"".$self->_cutBaseURI($objectURI)."\"/>\n";
	}
    }
    $self->_print ($propertyElt);
}
sub _predicateClose {
    my ($self,$statement,$inline) = @_;
    my $prefix = $self->{_namespaces}->{$statement->getPredicate->getNamespace};
    my $propName = $prefix . ":".$statement->getPredicate->getLocalValue;
    my $propertyElt;
    if ($inline || $statement->getObject->isLiteral) {
	$propertyElt="</$propName>\n";
    } else {
	$propertyElt="";
    }
    $self->_print ($propertyElt);
}
sub _descriptionData {
    my ($self,$statement) = @_;
    if (!$statement->getObject->isLiteral && #object is resource
	defined $self->getSubjects->{$statement->getObject->getURI} && #and statement about the resource exists
	!$self->getSubjects->{$statement->getObject->getURI}->[1]) { #and is opened not yet
        $self->_predicateOpen($statement,1);
	$self->_descriptionProcess($self->getSubjects->{$statement->getObject->getURI});
	$self->_predicateClose($statement,1);
    } else {
	$self->_predicateOpen($statement,0);
	if ($statement->getObject->isLiteral) {
	    my $literal = $statement->getObject->getValue;
	    $literal =~ s/\&/\&amp;/g;
	    $literal =~ s/\</\&lt;/g;
	    $self->_print($literal);
	}
	$self->_predicateClose($statement,0);

    }
}
sub _print {
    my ($self,@params) = @_;
    if (ref($self->{_options}->{Output}) eq 'SCALAR') {
	foreach (@params) {
	    ${$self->getOptions->{Output}} .= $_;
	}
    } elsif (ref($self->{_options}->{Output}) =~ /^GLOB|^FileHandle/) {
	print {$self->getOptions->{Output}} @params;
    }

}
sub _cutBaseURI {
    my ($self, $uriRef) = @_;
    my $baseURI = $self->getOptions->{BaseURI};
    if ($baseURI) {
	$uriRef =~ s/^$baseURI//i;
    }
    return $uriRef;
}

1;
__END__

=head1 NAME

RDF::Core::Serializer - produce XML code for RDF model

=head1 SYNOPSIS

  use RDF::Core::Serializer;

  my %options = (getSubjects => \&getSubjectsHandler,
                 getNamespaces => \&getNamespacesHandler,
                 getStatements => \&getStatementsHandler,
                 existsStatement => \&existsStatementHandler,
                 BaseURI => 'http://www.foo.com/',
                );
  my $serializer = new RDF::Core::Serializer(%options);
  $serializer->serialize;

=head1 DESCRIPTION

Serializer takes RDF data provided by handlers and generates a XML document. Besides the trivial job of generating one description for one statement the serializer attempts to group statements with common subject into one description and makes referenced descriptions nested into referencing ones. Using baseURI and InlineURI options helps to keep relative and anonymous resources instead of making them absolute and persistent.

=head2 Interface

=over 4

=item * new(%options)

Available options are:

=over 4

=item * getSubjects

A reference to a subroutine that provides all distinct subjects in serialized model.

=item * getNamespaces

A reference to a subroutine that provides all predicates' namespaces.

=item * getStatements($subject, $predicate, $object)

A reference to a subroutine that provides all statements conforming given mask.

=item * existsStatement($subject, $predicate, $object)

A reference to a subroutine that returns true if a statement exists conforming the mask.

=item * Output

Output can be assigned a filehandle reference (a reference to a typeglob or FileHandle object), or a reference to a scalar variable. If a filehendle is set, serializer assumes it's open and valid, just prints there and doesn't close it. If a variable is set, XML is appended to it.
Serializer writes to STDOUT with default settings.

=item * BaseURI

A base URI of a document that is created. If a subject of a statement matches the URI, about attribute with relative URI is generated. No ID attributes are produced until corresponding RDF issue is closed. (See rdfms-difference-between-ID-and-about at http://www.w3.org/2000/03/rdf-tracking/)

=item * InlineURI

If a subject matches an InlineURI option, serializer attempts to generate an anonymous description. (The description has not about neither ID attribute.) If it's not possible (imagine an anonymous resource which points to itself, or some circularly dependent anonymous resources etc.), an ID attribute is generated using InlinePrefix and a counter. The default value is '_:'.

=item * InlinePrefix

If an anonymous description is to be generated and need is to give it ID attribute (see InlineURI), the attribute will be InlinePrefix concatenated with unique number. Unique is ment in the scope of the document. Default prefix is '_:a'.

=back

=item * serialize

Does the job.

=back

=head2 Handlers

B<getSubjects> should return an array of references, each reference pointing to an array of one item ($subject), where $subject is a reference to RDF::Core::Resource. (I.e. C<$subject = $returnValue-E<gt>[$someElementOfArray]-E<gt>[0]>)

B<getNamespaces> should return a hash reference where keys are namespaces and values are namespace prefixes. There must be a rdf namespace present with value 'rdf'

B<getStatements($subject, $predicate, $object)> should return all statements that match given mask. That is the statements' subject is equal to $subject or $subject is not defined and the same for predicate and subject. Return value is a reference to RDF::Core::Enumerator object.

B<existsStatement($subject, $predicate, $object)> should return true if exists statement that matches given mask and false otherwise.

=head1 LICENSE

This package is subject to the MPL (or the GPL alternatively).

=head1 AUTHOR

Ginger Alliance, rdf@gingerall.cz

=head1 SEE ALSO

 FileHandle, RDF::Core::Model::Serializer, RDF::Core::Enumerator

=cut
