XML::Validate::MSXML - Interface to MSXML validator

  my $validator = new XML::Validate::MSXML(%options);
  if ($doc = $validator->validate($xml)) {
    ... Do stuff with $doc ...
  } else {
    print "Document is invalid\n";
  }

# XML::Validate::MSXML

package XML::Validate::MSXML;

use strict;
use Win32::OLE;
use XML::Validate::Base;
use vars qw( $VERSION @ISA $MSXML_VERSION);

@ISA = qw( XML::Validate::Base );
$VERSION = sprintf'%d.%03d', q$Revision: 1.18 $ =~ /: (\d+)\.(\d+)/;

use constant XSI_NS => 'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"';

my $VALID_OPTIONS = { strict_validation => 1 };

sub new {
	my $class = shift;
	my %options = @_;
	my $self = {};
	bless ($self, $class);
	
	$self->clear_errors();
	$self->set_options(\%options,$VALID_OPTIONS);
	
	DUMP("Instantiating XML::Validate::MSXML", $self);
	
	return $self;
}

sub version {
	eval {create_doc_and_cache()};
	return $MSXML_VERSION;
}

sub validate {
	my ($self, $xml) = @_;
	
	$self->clear_errors();
	$self->{dom} = undef;
	
	die "validate called with no data to validate\n" unless defined $xml and length $xml > 0;

	DUMP("the xml to validate : $xml ", $self);

	my ($msxml,$msxmlcache) = create_doc_and_cache();

	$msxml->{async} = 0;
	$msxml->{validateOnParse} = 0;
	$msxml->{resolveExternals} = 1;
	
	TRACE("Starting to parse");
	$msxml->LoadXML($xml);
	TRACE("Parsed the document");
	
	my $xmlroot = $msxml->{documentElement};
	
	if ($msxml->parseError()->{errorCode} != 0) {
		TRACE("XML Parse Error (not syntactically valid)");
		my $error = $msxml->parseError();
		DUMP("Error", $error);
		$self->add_error({
			message => $error->{reason},
			line    => $error->{line},
			column  => $error->{linepos}
		});
		return;
	}
	
	if ($self->options->{strict_validation}) {
		TRACE("XML Syntactically valid");
		load_schemas($msxml, $msxmlcache);
		TRACE("Validate against schema/DTD ");
		if ($msxml->{doctype} || $msxml->{schemas}) {
			#DUMP($msxml->{doctype}, $msxml->{schemas});
			$msxml->{validateOnParse} = 1;
			$msxml->LoadXML($xml);
			my $error = $msxml->parseError();
			if ($error->{errorCode} != 0) {
				$self->add_error({
					message => $error->{reason},
					line    => $error->{line},
					column  => $error->{linepos}
				});
				return;
			}
			$error = $msxml->validate();
			if ($error->{errorCode} != 0) {
				$self->add_error({
					message => $error->{reason},
					line    => $error->{line},
					column  => $error->{linepos}
				});
				return;
			}
		} else {
			# If there is nothing to validate against, treat it as valid.
			TRACE("No doctype or schema");
		}
	}

	#Valid
	$self->{dom} = $msxml;
	return 1;
}

sub last_dom {
	my $self = shift;
	return $self->{dom};
}

sub load_schemas {
	my ($xml, $schema_cache) = @_;
	
	my %schemas;
	
	$xml->setProperty('SelectionNamespaces', XSI_NS);
	my $no_ns_schema_xpath = q[//*/@xsi:noNamespaceSchemaLocation];
	my $no_ns_schema_nodes = $xml->{documentElement}->selectNodes($no_ns_schema_xpath);
	
	for (my $i=0; $i < $no_ns_schema_nodes->{length}; $i++){
		my $schema_txt = $no_ns_schema_nodes->item($i)->{text};
		my %add_schemas = ('', $schema_txt);
		%schemas = (%schemas, %add_schemas);
	}
	
	my $schema_xpath = q[//*/@xsi:schemaLocation];
	my $schema_location_nodes = $xml->{documentElement}->selectNodes($schema_xpath);

	for (my $i=0; $i < $schema_location_nodes->{length}; $i++){
		my $schema_txt = $schema_location_nodes->item($i)->{text};
		my %add_schemas = split ' ', $schema_txt;
		%schemas = (%schemas, %add_schemas);
	}
	
	while (my ($ns, $schema) = each %schemas) {
		TRACE("Loading schema [$ns] -> $schema");
		$schema_cache->add($ns, $schema);
		if (my $schema_error = Win32::OLE::LastError()) {
			$schema_error =~ s/OLE exception .*\n\n//m;
			$schema_error =~ s/Win32::OLE.*//s;
			die $schema_error;
		}
	}
	$xml->{schemas} = $schema_cache if %schemas;
	return;
}

sub dependencies_available {
	create_doc_and_cache();
	return 1;
}

sub create_doc_and_cache {
	# Stop Win32::OLE from being noisy
	my $warn_level = Win32::OLE->Option('Warn');
	Win32::OLE->Option(Warn => 0);

	foreach my $version ('5.0', '4.0') {
		my $doc   = Win32::OLE->new('MSXML2.DOMDocument.' . $version) or next;
		my $cache = Win32::OLE->new('MSXML2.XMLSchemaCache.' . $version) or next;
		$MSXML_VERSION = $version;
		Win32::OLE->Option(Warn => $warn_level); # restore warn level
		return ($doc,$cache);
	}
	die "Unable to instantiate MSXML DOMDocument and SchemaCache. (Do you have a compatible version of MSXML installed?)";
}

# Note: Our use of TRACE and DUMP here is a bit weird. We explicitly pass to
# the TRACE and DUMP in the superclass (XML::Validate::Base) because we expect
# to be dynamically loaded and we assume that the calling class will have dealt
# with Base but not this module. (Note that Log::Trace now has some support for
# dynamic loading. It doesn't play well with some modules in 5.6.1, but it seems
# fine in 5.8. So someday this won't be necessary.)

sub TRACE { XML::Validate::Base::TRACE(@_) }
sub DUMP  { XML::Validate::Base::DUMP(@_)  }

dependencies_available();

__END__