File Coverage

lib/XML/Validate.pm

Criterion	Covered	Total	%
statement	24	56	42.8
branch	5	14	35.7
condition	0	3	0.0
subroutine	6	12	50.0
pod	5	7	71.4
total	40	92	43.4

# Factory class providing a common interface to different XML validators

package XML::Validate;

# Using XML::Validate::Base here is cheating somewhat. We do this because we're
# dynamically loading the validation module, but we still want to be able to
# use Log::Trace's deep import feature. Any better ideas welcomed.

use strict;
use XML::Validate::Base;
use vars qw($VERSION);

$VERSION = sprintf"%d.%03d", q$Revision: 1.25 $ =~ /: (\d+)\.(\d+)/;

# Xerces is preferred over MSXML as we've found in practice that MSXML4's schema validation occasionally
# lets through invalid documents which Xerces catches.
# At the time of writing, LibXML didn't have schema validation support.
my $DEFAULT_PRIORITISED_LIST = [ qw( Xerces MSXML LibXML ) ];

sub new {
	my $class = shift;
	my %args = @_;

	DUMP("Arguments", %args);

	my $self = {
		backend => undef,
	};

	bless($self,$class);

	if (!$args{Type}) {
		die "Required argument Type missing\n";
	}

	if ($args{Type} !~ /^\w+$/) {
		die "Validator type name '$args{Type}' should only contain word characters.\n";
	}

	my $backend_class;
	if ($args{Type} eq 'BestAvailable') {
		my $list = $args{PrioritisedList} || $DEFAULT_PRIORITISED_LIST;
		my $type = $self->_best_available($list) or die sprintf("None of the listed backends (%s) are available\n",join(", ",@$list));
		$backend_class = "XML::Validate::" . $type;
	} else {
		$backend_class = "XML::Validate::" . $args{Type};
	}
	eval "use $backend_class";
	die "Validator $backend_class not loadable: $@" if $@;

	my $options = $args{Options};
	$self->{backend} = new $backend_class(%{$options});

	return $self;
}

sub validate {
	my $self = shift;
	$self->{backend}->validate(@_);
}

sub last_error {
	my $self = shift;
	$self->{backend}->last_error(@_);
}

sub type {
	my $self = shift;
	my $class = ref($self->{backend});
	$class =~ m/XML::Validate::(.*)/;
	return $1;
}

sub version {
	my $self = shift;
	return unless $self->{backend}->can('version');
	return $self->{backend}->version;
}

sub _best_available {
	my $self = shift;
	my ($list) = @_;
	foreach my $backend (@{$list}) {
		TRACE("Attempting to load $backend");
		eval "use XML::Validate::$backend";
		next if $@;
		TRACE("Loading succeeded. Returning $backend");
		return $backend;
	}
	return;
}

sub TRACE {}
sub DUMP {}

1;

__END__