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_all;
	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';
		delete @args{qw(targetProperty op nodePath optional message)};
		%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->selectNodes(@$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