package IMPL::DOM::Schema::Validator::Compare;
use strict;

use IMPL::Const qw(:prop);
use IMPL::declare {
	require => {
		Label => 'IMPL::DOM::Schema::Label',
		ValidationError => 'IMPL::DOM::Schema::ValidationError'
	},
	base => [
		'IMPL::DOM::Schema::Validator' => sub {
	        my %args = @_;
	        $args{nodeName} ||= 'Compare';
	        delete @args{qw(targetProperty op nodePath optional message)};
	        %args;
	    }
	],
	props => [
		targetProperty => PROP_RW,
		op => PROP_RW,
		nodePath => PROP_RW,
		optional => PROP_RW,
		_pathTranslated => PROP_RW,
		_targetNode => PROP_RW,
		_schemaNode => PROP_RW,
		message => PROP_RW
	] 
};
use IMPL::Resources::Format qw(FormatMessage);

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% %schemaNode.op% %value% (%schemaNode.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*(=|!=|=~|!~|eq|ne|lt|gt)\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,
                            schema => $this->parentNode,
                            schemaType => $this->parentNode,
                            node => $this->_targetNode,
                            source => $this->_schemaNode,
                            schemaNode => $this->_schemaNode
                        },\&_resovleProperty)
                    ) or return 0 foreach @parsedFilters;
                return 1;
            };
        } 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;
    
    my $schemaNode = $ctx->{schemaNode};
    my $schemaType = $ctx->{schemaType};
    
    $this->_schemaNode($schemaNode);
    
    $this->_targetNode($node);
    
    my $query = $this->_pathTranslated() || $this->_pathTranslated($this->TranslatePath($this->nodePath));
    
    my ($foreignNode) = $node->selectNodes(@$query);
    
    
    
    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, ValidationError->new(
            node => $node,
            foreignNode => $foreignNode,
            value => $value,
            schemaNode => $schemaNode,
            schemaType => $schemaType,
            message => $this->_MakeLabel($this->message)
        ) unless $this->op->(_resovleProperty($node,$this->targetProperty),$value);
    } elsif (not $this->optional) {
        push @result, ValidationError->new(
            node => $node,
            value => '',
            schemaNode => $schemaNode,
            schemaType => $schemaType,
            message => $this->_MakeLabel( $this->message )
        );
    }
    
    $this->_targetNode(undef);
    $this->_schemaNode(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];
}

sub _MakeLabel {
	my ($this,$label) = @_;
	
	if ($label =~ /^ID:(\w+)$/) {
		return Label->new($this->document->stringMap, $1);
	} else {
		return $label;
	}
}

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% необходимо задать свойство %schemaNode.name%"/>
        <Compare op="eq" nodePath="sibling:*[nodeName eq '%node.linkedNode%']"/>
    </SimpleType>
</schema>

=begin code xml

=head1 DESCRIPTION

Позволяет сравнивать значение текущего узла со значением другого узла. 

=cut