view release on metacpan or  search on metacpan

lib/XML/DOM2.pm  view on Meta::CPAN

		namespace => $self->{'-namespace'},
		seperator => $sep,
		indent	=> $self->{'-indent'},
	);
	# Return xml string
	return $xml;
}
*render=\&xmlify;
*to_xml=\&xmlify;
*serialise=\&xmlify;
*serialize=\&xmlify;

=head2 I<$class>->adaptation( $name, $structure )

  Convert a perl structure and create a new xml document of it:

	$class->adaptation('xml', { foo => [ 'A', 'B', 'C' ], bar => 'D', kou => { 'A' => 1, 'B' => 2 } });

  Will convert to:

	"<xml><foo>A</foo><foo>B</foo><foo>C</foo><bar>D</bar><kou><A>1</A><B>2</B></xml>"

	$class->adaptation('xml', { 'foo' => [ { '+' => 'A', '_Letter' => '1' }, { '+' => 'B', '_Letter' => 2 } ] });

	Will convert to:

	"<xml><foo Letter="1">A</foo><foo Letter="2">B</foo></xml>"

=cut
sub adaptation
{
	my ($class, $baseTag, $structure) = @_;
	my $self = $class->new( baseTag => $baseTag );
	my $root = $self->documentElement();
	$class->_adapt_hash( $root, $structure );
	return $self;
}

# Adapt any kind of child object / data type
sub _adapt_child
{
	my ($class, $element, $data, $parent) = @_;
	if(UNIVERSAL::isa($data, 'HASH')) {
		return $class->_adapt_hash( $element, $data, $parent );
	} elsif(UNIVERSAL::isa($data, 'ARRAY')) {
		return $class->_adapt_array( $element, $data, $parent );
	} else {
		return $class->_adapt_scalar( $element, scalar($data) );
	}
}

# Adapt a HASH ref into XML
sub _adapt_hash
{
	my ($class, $element, $hash) = @_;

	foreach my $name (keys(%{$hash})) {
		my $data  = $hash->{$name};

		if($name eq '+') {
			$element->cdata($data)
		} elsif($name =~ /^_(.+)$/) {
			$element->setAttribute($1, $data);
		} else {
		  my $isa = UNIVERSAL::isa($data, 'ARRAY');
			my $child = $isa ? $name : $element->createElement( $name );
			$class->_adapt_child( $child, $data, $element );
		}
	}
	return $element;
}

# Adapt an ARRAY ref into XML
sub _adapt_array
{
	my ($class, $name, $array, $parent) = @_;

	foreach my $data (@{$array}) {
		my $isa = UNIVERSAL::isa($data, 'ARRAY');
		my $child = $isa ? $name : $parent->createElement( $name );
		$class->_adapt_child( $child, $data, $parent );
	}
	return $parent;
}

# Adapt a SCALAR into XML
sub _adapt_scalar
{
	my ($self, $element, $scalar) = @_;
	if(defined($scalar)) {
		my $result = $element->createElement( '#cdata-entity', text => scalar( $scalar ) );
	}
	return $element;
}

=head2 $object->extension()
	
  $extention = $xml->extention();

  Does not work, legacy option maybe enabled in later versions.

=cut
sub extension
{
	my ($self) = @_;
	return $self->{'-extension'};
}


=head1 OPTIONS

=head2 $object->namespace( $set )

  Default document name space

=cut
sub namespace  { shift->_option('namespace',  @_); }

=head2 $object->name( $set )

  Document localName

=cut
sub name	   { shift->_option('name',	   @_); }

=head2 $object->doctype()

  Document Type object

=cut
sub doctype	{ shift->_option('doctype',	@_); }

=head2 $object->version()

  XML Version

=cut
sub version	{ shift->_option('version',	@_); }

=head2 $object->encoding()

  XML Encoding

=cut
sub encoding   { shift->_option('encoding',   @_); }

=head2 $object->standalone()

 XML Standalone

=cut

lib/XML/DOM2.pm  view on Meta::CPAN

	my $extension = $self->_serialise_extension( seperator => $sep );
	$type = $type->name;
	warn "no TYPE defined!" if not defined($type);
	warn "no id!" if not defined($id);
	return $sep."<!DOCTYPE $type $id$extension>";
}

=head2 _serialise_extention

$xml->_serialise_extention( seperator => "\n" );

Returns the document extentions.

=cut
sub _serialise_extension
{
	my ($self, %p) = @_;
	my $sep = $p{'seperator'};
	my $ex = '';
	if ($self->extension) {
		$ex .= $sep.$self->extension.$sep;
		$ex = " [".$sep.$ex."]";
	}
	return $ex;
}

=head2 _serialise_header

$xml->_serialise_header( );

The XML header, with version, encoding and standalone options.

=cut
sub _serialise_header
{
	my ($self, %p) = @_;

	my $version= $self->{'version'} || '1.0';
	my $encoding = $self->{'encoding'} || 'UTF-8';
	my $standalone = $self->{'stand_alone'} ||'yes';

	return '<?xml version="'.$version.'" encoding="'.$encoding.'" standalone="'.$standalone.'"?>';
}

=head2 _element_handle

$xml->_element_handle( $type, %element-options );

Returns an XML element based on $type, use to extentd element capabilties.

=cut
sub _element_handle
{
	my ($self, $type, %opts) = @_;
	confess "Element handler with no bleedin type!!" if not $type;
	if($type eq '#document' or $type eq $self->_document_name) {
		$opts{'documentTag'} = $type if $type ne '#document';
		return XML::DOM2::Element::Document->new(%opts);
	} elsif($type eq '#comment') {
		return XML::DOM2::Element::Comment->new( delete($opts{'text'}), %opts);
	} elsif($type eq '#cdata-entity') {
		return XML::DOM2::Element::CDATA->new(delete($opts{'text'}), %opts);
	}
	return XML::DOM2::Element->new( $type, %opts );
}

=head2 $object->_option( $name[, $data] )

  Set or get the required option.

=cut
sub _option
{
	my ($self, $option, $set) = @_;
	if(defined($set)) {
		$self->{$option} = $set;
	}
	return $self->{$option};
}

=head2 $object->_can_contain_element()

  Does this node support element children.

=cut
sub _can_contain_element { 1 }


=head2 $object->_document_name()

  Returns the doctype name or 'xml' as default, can be extended.

=cut
sub _document_name {
	my ($self) = @_;
	if($self->{'baseTag'}) {
		return $self->{'baseTag'};
	}
	return $self->doctype()->name() || 'xml';
}

=head2 $object->_credit_comment()

  Returns the comment credit used in the output

=cut
sub _credit_comment { "\nGenerated using the Perl XML::DOM2 Module V$VERSION\nWritten by Martin Owens\n" }


=head1 COPYRIGHT

Martin Owens, doctormo@cpan.org

=head1 CREDITS

Based on SVG.pm by Ronan Oger, ronan@roasp.com

=head1 SEE ALSO

perl(1),L<XML::DOM2>,L<XML::DOM2::Parser>