--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Schema/Validator/Compare.pm	Tue May 11 02:42:59 2010 +0400
@@ -0,0 +1,237 @@
+package IMPL::DOM::Schema::Validator::Compare;
+use strict;
+
+use base qw(IMPL::DOM::Schema::Validator);
+
+use IMPL::Resources::Format qw(FormatMessage);
+use IMPL::Class::Property;
+
+BEGIN {
+	public property targetProperty => prop_all;
+	public property op => prop_all;
+	public property nodePath => prop_get | owner_set;
+	public property optional => prop_all;
+	private property _pathTranslated => prop_all;
+	private property _targetNode => prop_all;
+	public property message => prop_all;
+}
+
+our %CTOR = (
+	'IMPL::DOM::Schema::Validator' => sub {
+		my %args = @_;
+		$args{nodeName} ||= 'Compare';
+		%args;
+	}
+);
+
+our %Ops = (
+	'='  => \&_equals,
+	'eq' => \&_equalsString,
+	'!=' => \&_notEquals,
+	'ne' => \&_notEqualsString,
+	'=~' => \&_matchRx,
+	'!~' => \&_notMatchRx,
+	'<'  => \&_less,
+	'>'  => \&_greater,
+	'lt' => \&_lessString,
+	'gt' => \&_greaterString
+);
+
+my $rxOps = map qr/$_/, join( '|', keys %Ops );
+
+sub CTOR {
+	my ($this,%args) = @_;
+	
+	$this->targetProperty($args{targetProperty} || 'nodeValue');
+	$this->op( $Ops{ $args{op} || '=' } ) or die new IMPL::InvalidArgumentException("Invalid parameter value",'op',$args{op},$this->path);
+	$this->nodePath($args{nodePath}) or die new IMPL::InvalidArgumentException("The argument is required", 'nodePath', $this->path);
+	$this->message($args{message} || 'The value of %Node.path% %Source.op% %Value% (%Source.nodePath%)' );
+	$this->optional($args{optional}) if $args{optional};
+}
+
+sub TranslatePath {
+	my ($this,$path) = @_;
+	
+	$path ||= '';
+	
+	my @selectQuery;
+	
+	my $i = 0;
+	
+	foreach my $chunk (split /\//,$path) {
+		$chunk = 'document:*' if $i == 0 and not length $chunk;
+		next if not length $chunk;
+		
+		my $query;		
+		my ($axis,$filter) = ( $chunk =~ /^(?:(\w+):)?(.*)$/);
+		
+		if ($filter =~ /^\w+|\*$/ ) {
+			$query = $filter eq '*' ? undef : $filter;
+		} elsif ( $filter =~ /^(\w+|\*)\s*((?:\[\s*\w+\s*(?:=|!=|=~|!~|eq|ne|lt|gt|)\s*["'](?:[\\'"]|\\[\\"'])*["']\])+)$/) {
+			my ($nodeName,$filterArgs) = ($1,$2);
+			
+			my @parsedFilters = map {
+				my ($prop,$op,$value) = ($_ =~ /\s*(\w+)\s*(=|!=|=~|!~)\s*(["'](?:[\\'"]|\\[\\"'])*["'])/);
+				$value =~ s/\\[\\'"]/$1/g;
+				{
+					prop => $prop,
+					op => $Ops{$op},
+					value => $value
+				}
+			} grep ( $_, split ( /[\]\[]+/,$filterArgs ) );
+			
+			$query = sub {
+				my ($node) = shift;
+				
+				$node->nodeName eq $nodeName or return 0 if $nodeName ne '*';
+				$_->{op}->(
+						_resovleProperty($node,$_->{prop}),
+						FormatMessage($_->{value},{
+							Schema => $this->parentNode,
+							Node => $this->_targetNode
+						},\&_resovleProperty)
+					) or return 0 foreach @parsedFilters;
+				
+			};
+		} else {
+			die new IMPL::Exception("Invalid query syntax",$path,$chunk);
+		}
+		
+		push @selectQuery, $axis ? { $axis => $query } : $query;
+		
+		$i++;
+	}
+	
+	return \@selectQuery;
+}
+
+sub Validate {
+	my ($this,$node,$ctx) = @_;
+	
+	my @result;
+	
+	$this->_targetNode($node);
+	
+	my $query = $this->_pathTranslated() || $this->_pathTranslated($this->TranslatePath($this->nodePath));
+	
+	my ($foreignNode) = $node->selectPath($query);
+	
+	my $Source = $ctx && $ctx->{Source} || $this->parentNode;
+	
+	if ($foreignNode) {
+		my $value = $this->nodeValue;
+		
+		if ($value) {
+			$value = FormatMessage($value, { Schema => $this->parentNode, Node => $this->_targetNode, ForeignNode => $foreignNode },\&_resovleProperty);
+		} else {
+			$value = $foreignNode->nodeValue;
+		}
+		
+		push @result, new IMPL::DOM::Schema::ValidationError(
+			Node => $node,
+			ForeignNode => $foreignNode,
+			Value => $value,
+			Source => $Source,
+			Schema => $this->parentNode,
+			Message => $this->message
+		) unless $this->op->(_resovleProperty($node,$this->targetProperty),$value);
+	} elsif (not $this->optional) {
+		push @result,  new IMPL::DOM::Schema::ValidationError(
+			Node => $node,
+			Value => '',
+			Source => $Source,
+			Schema => $this->parentNode,
+			Message => $this->message
+		);
+	}
+	
+	$this->_targetNode(undef);
+	
+	return @result;
+}
+
+sub _resovleProperty {
+	my ($node,$prop) = @_;
+	
+	return $node->can($prop) ? $node->$prop() : $node->nodeProperty($prop);
+}
+
+sub _matchRx {
+	$_[0] =~ $_[1];
+}
+
+sub _notMatchRx {
+	$_[0] !~ $_[1];
+}
+
+sub _equals {
+	$_[0] == $_[1];
+}
+
+sub _notEquals {
+	$_[0] != $_[0];
+}
+
+sub _equalsString {
+	$_[0] eq $_[1];
+}
+
+sub _notEqualsString {
+	$_[0] ne $_[1];
+}
+
+sub _less {
+	$_[0] < $_[1];
+}
+
+sub _greater {
+	$_[0] > $_[1];
+}
+
+sub _lessString {
+	$_[0] lt $_[1];
+}
+
+sub _greaterString {
+	$_[0] gt $_[1];
+}
+
+sub _lessEq {
+	$_[0] <= $_[1];
+}
+
+sub _greaterEq {
+	$_[0] >= $_[1];
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::DOM::Schema::Validator::Compare> - ограничение на содержимое текущего узла,
+сравнивая его со значением другого узла.
+
+=head1 SYNOPSIS
+
+Пример типа описания поля с проверочным полем
+
+=begin code xml
+
+<schema>
+	<SimpleType type="retype_field">
+		<Property name="linkedNode" message="Для узла %Node.nodeName% необходимо задать свойство %Source.name%"/>
+		<Compare op="eq" nodePath="sibling:*[nodeName eq '%Node.linkedNode%']"/>
+	</SimpleType>
+</schema>
+
+=begin code xml
+
+=head1 DESCRIPTION
+
+Позволяет сравнивать значение текущего узла со значением другого узла. 
+
+=cut
\ No newline at end of file