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

use parent 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