XML::Xerces::BagOfTricks - A library to make XML:Xerces easier and more perl-ish

  use XML::Xerces::BagOfTricks qw(:all);

  # get a nice (empty) DOM Document
  my $DOMDocument = getDocument($namespace,$root_tag);

  # get a DOM Document from an XML file
  my $DOMDocument = getDocumentFromXML (file=>$file);

  # get a DOM Document from an XML file
  my $DOMDocument = getDocumentFromXML(xml=>$xml);

  # get a nice Element containing a text node (i.e. <foo>bar</foo>)
  my $foo_elem = getTextElement($DOMDocument,'Foo','Bar');

  # get a nice element with attributes (i.e '<Foo isBar='0' isFoo='1'/>')
  my $foo_elem = getElement($DOMDocument,'Foo','isBar'=>0, 'isFoo'=>1);

  # get a nice element with attributes that contains a text node
  my $foo_elem = getElementwithText($DOMDocument,'Foo','Bar',isFoo=>1,isBar=>0);
  # (i.e. <Foo isFoo='1' isBar='0'>Bar</Foo>)

  # if node is not of type Element then append its data to $contents
  # based on examples in article by P T Darugar.
  if ( $NodeType[$node->getNodeType()] ne 'Element' ) {
	    $contents .= $node->getData();
  }
  # or the easier..
  my $content = getTextContents($node);

  # get the nice DOM Document as XML
  my $xml = getXML($DOMDocument);

    This function returns a nice XML::Xerces::DOMNode representing an element
    with an appended Text subnode, based on the arguments provided.

    In the example below $node would represent '<Foo>Bar</Foo>'

    my $node = getTextElement($doc,'Foo','Bar');

    More useful than a pocketful of bent drawing pins! If only the Chilli Peppers
    made music like they used to 'Zephyr' is no equal of 'Fight Like A Brave' or
    'Give it away'

    This function returns a nice XML::Xerces::DOMNode representing an element
    with an appended Text subnode, based on the arguments provided.

    In the example below $node would represent '<Foo isBar='0' isFoo='1'/>'

    my $node = getElement($doc,'Foo','isBar'=>0, 'isFoo'=>1);

  # get a nice element with attributes that contains a text node ( i.e. <Foo isFoo='1' isBar='0'>Bar</Foo> )
  my $foo_elem = getElementwithText($DOMDocument,'Foo','Bar',isFoo=>1,isBar=>0);

package XML::Xerces::BagOfTricks;

use strict;

use XML::Xerces;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our $VERSION = '0.03';
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(
				   %NodeType @NodeType $schemaparser $dtdparser $plainparser
				   &getTextContents &getDocument &getDocumentFromXML &getXML &getTextElement
				   &getElement &getElementwithText
				   ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

# Xerces implementation and writer
my $impl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
my $writer = $impl->createDOMWriter();
if ($writer->canSetFeature('format-pretty-print',1)) {
    $writer->setFeature('format-pretty-print',1);
}

# Xerces parsers (one for Schema, DTD and neither)
my $validate = $XML::Xerces::AbstractDOMParser::Val_Auto;
my $schemaparser = XML::Xerces::XercesDOMParser->new();
my $dtdparser = XML::Xerces::XercesDOMParser->new();
my $plainparser = XML::Xerces::XercesDOMParser->new();
my $error_handler = XML::Xerces::PerlErrorHandler->new();
my $c = 0;
foreach ( $schemaparser, $dtdparser, $plainparser) {
  $_->setValidationScheme ($validate);
  $_->setDoNamespaces (1);
  $_->setCreateEntityReferenceNodes(1);
  $_->setErrorHandler($error_handler);
}
$schemaparser->setDoSchema (1);

my $parser = $plainparser;

our %NodeType;
our @NodeType = qw(ERROR ELEMENT_NODE ATTRIBUTE_NODE TEXT_NODE CDATA_SECTION_NODE ENTITY_REFERENCE_NODE ENTITY_NODE PROCESSING_INSTRUCTION_NODE COMMENT_NODE DOCUMENT_NODE DOCUMENT_TYPE_NODE DOCUMENT_FRAGMENT_NODE NOTATION_NODE );
@NodeType{@NodeType} = ( 0 .. 13 );

# Preloaded methods go here.

# Based on example in 'Effective XML processing with DOM and XPath in Perl'
# by Parand Tony Darugar, IBM Developerworks Oct 1st 2001

sub getTextContents {
    my ($node, $strip)= @_;
    my $contents;

    if (! $node ) {
	return;
    }
    for my $child ($node->getChildNodes()) {
	if ( $NodeType[$child->getNodeType()] =~ /(?:TEXT|CDATA_SECTION)_NODE/ ) {
	    $contents .= $child->getData();
	}
    }

    if ($strip) {
	$contents =~ s/^\s+//;
	$contents =~ s/\s+$//;
    }

    return $contents;
}

sub getTextElement {
    my ($doc, $name, $value) = @_;
    warn "D'oh! it would be a good idea to provide a value to getTextElement : ", caller() unless $value;
    my $field = $doc->createElement($name);
    my $fieldvalue = $doc->createTextNode($value);
    $field->appendChild($fieldvalue);
    return $field;
}

sub getElement {
    my ($doc, $name, %attributes) = @_;
    my $node = $doc->createElement($name);
    foreach my $attr_name (keys %attributes) {
	if (defined $attributes{$attr_name}) {
	    $node->setAttribute($attr_name,$attributes{$attr_name});
	}
    }
    return $node;
}

sub getElementwithText {
    my ($doc, $nodename, $textvalue, %attributes) = @_;
    my $node = $doc->createElement($nodename);
    if ($textvalue) {
	my $text = $doc->createTextNode($textvalue);
	$node->appendChild($text);
    }
    foreach my $attr_name (keys %attributes) {
	$node->setAttribute($attr_name,$attributes{$attr_name}) if (defined $attributes{$attr_name});
    }
    return $node;
}

# maybe we should memoize this later

sub getDocument {
    my ($ns,$root_tag,@tags) = @_;
    my $docroot = (ref $root_tag) ? $root_tag->{name} : $root_tag;
    my $doc = eval{$impl->createDocument($ns, $docroot, undef)};
    XML::Xerces::error($@) if $@;
    my $root = $doc->getDocumentElement();
    if (ref $root_tag) {
	foreach (keys %$root_tag) {
	    next if /name/;
	    $root->setAttribute($_,$root_tag->{$_});
	}
    }
    foreach my $tag ( @tags ) {
	my $element_tag = (ref $tag) ? $tag->{name} : $tag;
	my $element = $doc->createElement ($element_tag);
	if (ref $tag) {
	    foreach (keys %$tag) {
		next if /name/;
		$element->setAttribute($_,$tag->{$_});
	    }
	}
	$root->appendChild($element);
    }
    return $doc;

}

sub getDocumentFromXML {
    my $key = shift;
    my $value = shift;
    my $mode;

    if ( lc($key) eq 'xml') {
	$mode = 'xml';
    } elsif (lc $key eq 'file') {
	$mode = 'file';
    } else {
	$mode = ($key =~ /^</) ? 'xml' : 'file' ;
	$value = $key;
    }

    my $parser = $plainparser;

    my $input;
    if ($mode eq 'xml') {
	eval { $input =  XML::Xerces::MemBufInputSource->new($value); };
	XML::Xerces::error($@) if ($@);
#	warn "got buffer : $input \n";
    } else {
	$input = $value;
    }

    eval { $parser->parse ($input);  };
    XML::Xerces::error($@) if ($@);

    my $doc;
    if ($@) {
	if ($@->isa("XML::Xerces::XMLException")) {
	    warn("XML Exception: type = ".$@->getType.", "
		 ."code = ".$@->getCode.", message = "
		 .$@->getMessage.", src=".$@->getSrcFile." line "
		 .$@->getSrcLine);
	} else {
	    warn "XML Problem - Got a ".ref($@)." back! we were expecting an XML::Xerces:DOMDocument";
	    XML::Xerces::error($@);
	}
    } else {
	$doc =  $parser->getDocument;
#	warn "XML validated successfully\n";
    }
    return $doc;
}

sub getXML {
    my $doc = shift;
    my $target = XML::Xerces::MemBufFormatTarget->new();
    $writer->writeNode($target,$doc);
    my $xml = $target->getRawBuffer;
    return $xml;
}


################################################################

1;

__END__