view release on metacpan or  search on metacpan

lib/MOSES/MOBY/Data/Object.pm  view on Meta::CPAN

=cut

sub toXML {
    my ($self, $articleName) = @_;
    $self->increaseXMLCounter;

    my $moby_name = $self->mobyname;
    unless ($moby_name) {  # backup plan
	$moby_name = ref $self;
	$moby_name =~ s/.*:://;
    }

    my $root = XML::LibXML::Element->new ($moby_name);
    $root->setNamespace (MOBY_XML_NS, MOBY_XML_NS_PREFIX);

    $root->setAttributeNS (MOBY_XML_NS, OBJ_ID, $self->id);
    $root->setAttributeNS (MOBY_XML_NS, OBJ_NAMESPACE, $self->namespace);
    $root->setAttributeNS (MOBY_XML_NS, ARTICLENAME, $articleName)
	if $articleName;

    $root->appendChild ($self->provision->toXML)
	if $self->provision;
    
    # cross-references
    if ($self->xrefs and @{ $self->xrefs } > 0) {
	my $crElem = $root->addNewChild (MOBY_XML_NS, CROSSREFERENCE);
	$crElem->setNamespace (MOBY_XML_NS, MOBY_XML_NS_PREFIX);
	foreach my $xref (@{ $self->xrefs }) {
	    $crElem->appendChild ($xref->toXML);
	}
    }

    # iterate over all members
    my ($key, $value);
    while (($key, $value) = each %$self) {
	if (ref ($value) eq 'ARRAY') {
	    foreach my $elem (@{ $value }) {
		$self->_add_XML_element ($key, $elem, $root);
	    }
	} else {
	    $self->_add_XML_element ($key, $value, $root);
	}
    }

    # return it  (TBD: cleaning namespaces happens several times...)
    return $self->closeXML ($root);
}

# create an XML element, add it to the $root; ignore some priviledged
# names (such as 'xrefs'), and most (except 'value' for primitive
# types) of the names whose values are not object references

sub _add_XML_element {
    my ($self, $name, $value, $root) = @_;
    my (%special_names) =
	(xrefs     => 1,
	 provision => 1,
	 );
    if ($name eq 'value' and $self->primitive) {
	if (defined $value) {
	    if ($self->{cdata}) {  # don't use: $self->cdata because not everybody has it
		$root->appendChild (XML::LibXML::CDATASection->new ($self->_express_value ($value)));
	    } else {
		$root->appendText ($self->_express_value ($value));
	    }
	}
	return;
    }
    if (ref ($value)) {
	if ($special_names{$name}) {
	    return;
	}
	my $xmlElem = $value->toXML ($name);
	$root->appendChild ($xmlElem) if $xmlElem;
    }
}

# return the same value as given (but others may override it - eg,
# Boolean changes here 1 to 'true'

sub _express_value {
    shift;
    shift;
}


1;
__END__