view Lib/IMPL/DOM/Schema/Validator/RegExp.pm @ 165:76515373dac0

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents e6447ad85cb4
children d1676be8afcc
line wrap: on
line source

package IMPL::DOM::Schema::Validator::RegExp;

use parent qw(IMPL::DOM::Schema::Validator);

our %CTOR = (
	'IMPL::DOM::Schema::Validator' => sub {
		my %args = @_;
		$args{nodeName} ||= 'RegExp';
		%args;
	}
);

use IMPL::Class::Property;

BEGIN {
	public property message => prop_all;
	public property launder => prop_all;
	private property _rx => prop_all;
}

sub CTOR {
	my ($this,%args) = @_;
	
	$this->message($args{message} || "A %Node.nodeName% doesn't match to the format %Schema.display%");
}

sub Validate {
	my ($this,$node,$ctx) = @_;
	
	my $rx = $this->_rx() || $this->_rx( map qr{$_}, $this->nodeValue );
	
	return new IMPL::DOM::Schema::ValidationError(
		Node => $node,
		Source => $ctx && $ctx->{Source} || $this->parentNode,
		Schema => $this->parentNode,
		Message => $this->message
	) unless (not $node->isComplex) and $node->nodeValue =~ /($rx)/;
	
	$node->nodeValue($1) if $this->launder;
	
	return ();
}

1;