package Data::xPathLike;
use utf8;
use open ":std", ":encoding(UTF-8)";
use 5.006;
use strict;
use Carp;
#use warnings FATAL => 'all';
use warnings;
use Marpa::R2;
use Data::Dumper;
use Scalar::Util qw{looks_like_number weaken};

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw();

our $VERSION = '0.1';

my $grammar = Marpa::R2::Scanless::G->new({
    #default_action => '::first',
    action_object    => __PACKAGE__,
    source => \(<<'END_OF_SOURCE'),

:default ::= action => ::array
:start ::= Start

Start    ::= 
    WS OperExp WS                                      action => _do_arg2

OperExp ::=
    PathExpr                                           action => _do_path
    |Function                                          action => _do_arg1

Function ::=
    NumericFunction                                    action => _do_arg1
    | StringFunction                                   action => _do_arg1
    | ListFunction                                     action => _do_arg1

PathExpr ::=
    absolutePath                                       action => _do_absolutePath
    | relativePath                                     action => _do_relativePath
    | PathExpr '|' PathExpr                            action => _do_pushArgs2array

PredPathExpr ::=
    absolutePath                                       action => _do_absolutePath
    | stepPathNoDigitStart                             action => _do_relativePath
    | './' stepPath                                    action => _do_relativePath2
    | PredPathExpr '|' PredPathExpr                    action => _do_pushArgs2array

relativePath ::=    
    stepPath                                           action => _do_arg1

absolutePath ::=    
    subPath                                            action => _do_arg1

subPath ::=    
    '/' stepPath                                       action => _do_arg2
    | '//' stepPath                                    action => _do_vlen

stepPath ::=
    step Filter subPath                                action => _do_stepFilterSubpath
    | step Filter                                      action => _do_stepFilter
    | step subPath                                     action => _do_stepSubpath
    | step                                             action => _do_arg1


step ::= 
    keyOrAxis                                          action => _do_arg1            
    |index                                             action => _do_arg1

index ::=
    UINT                                               action => _do_array_hash_index

stepPathNoDigitStart ::=     
    keyOrAxis Filter subPath                           action => _do_stepFilterSubpath
    | keyOrAxis Filter                                 action => _do_stepFilter
    | keyOrAxis subPath                                action => _do_stepSubpath
    | keyOrAxis                                        action => _do_arg1


keyOrAxis ::= 
    keyname                                            action => _do_keyname
    | '[' UINT ']'                                     action => _do_array_index
    |    '.'                                           action => _do_self
    |    '[.]'                                         action => _do_selfArray
    |    '{.}'                                         action => _do_selfHash
    | 'self::*'                                        action => _do_self    
    | 'self::[*]'                                      action => _do_selfArray    
    | 'self::{*}'                                      action => _do_selfHash    
    | 'self::' keyname                                 action => _do_selfNamed    
    | 'self::' UINT                                    action => _do_selfIndexedOrNamed    
    | 'self::[' UINT ']'                               action => _do_selfIndexed    
    | '*'                                              action => _do_child
    | '[*]'                                            action => _do_childArray
    | '{*}'                                            action => _do_childHash
    |    'child::*'                                    action => _do_child
    |    'child::[*]'                                  action => _do_childArray
    |    'child::{*}'                                  action => _do_childHash
    |    'child::' keyname                             action => _do_childNamed
    |    'child::'    UINT                             action => _do_childIndexedOrNamed
    |    'child::[' UINT ']'                           action => _do_childIndexed
    |    '..'                                          action => _do_parent
    |    '[..]'                                        action => _do_parentArray
    |    '{..}'                                        action => _do_parentHash
    | 'parent::*'                                      action => _do_parent
    | 'parent::[*]'                                    action => _do_parentArray
    | 'parent::{*}'                                    action => _do_parentHash
    | 'parent::' keyname                               action => _do_parentNamed              
    | 'parent::' UINT                                  action => _do_parentIndexedOrNamed              
    | 'parent::[' UINT ']'                             action => _do_parentIndexed              
    | 'ancestor::*'                                    action => _do_ancestor
    | 'ancestor::[*]'                                  action => _do_ancestorArray
    | 'ancestor::{*}'                                  action => _do_ancestorHash
    | 'ancestor::' keyname                             action => _do_ancestorNamed
    | 'ancestor::' UINT                                action => _do_ancestorIndexedOrNamed
    | 'ancestor::[' UINT ']'                           action => _do_ancestorIndexed
    | 'ancestor-or-self::*'                            action => _do_ancestorOrSelf
    | 'ancestor-or-self::[*]'                          action => _do_ancestorOrSelfArray
    | 'ancestor-or-self::{*}'                          action => _do_ancestorOrSelfHash
    | 'ancestor-or-self::'     keyname                 action => _do_ancestorOrSelfNamed
    | 'ancestor-or-self::'     UINT                    action => _do_ancestorOrSelfIndexedOrNamed
    | 'ancestor-or-self::[' UINT ']'                   action => _do_ancestorOrSelfIndexed
    | 'descendant::*'                                  action => _do_descendant
    | 'descendant::[*]'                                action => _do_descendantArray
    | 'descendant::{*}'                                action => _do_descendantHash
    | 'descendant::' keyname                           action => _do_descendantNamed
    | 'descendant::' UINT                              action => _do_descendantIndexedOrNamed
    | 'descendant::[' UINT ']'                         action => _do_descendantIndexed
    | 'descendant-or-self::*'                          action => _do_descendantOrSelf
    | 'descendant-or-self::[*]'                        action => _do_descendantOrSelfArray
    | 'descendant-or-self::{*}'                        action => _do_descendantOrSelfHash
    | 'descendant-or-self::' keyname                   action => _do_descendantOrSelfNamed
    | 'descendant-or-self::' UINT                      action => _do_descendantOrSelfIndexedOrNamed
    | 'descendant-or-self::[' UINT ']'                 action => _do_descendantOrSelfIndexed
    | 'preceding-sibling::*'                           action => _do_precedingSibling
    | 'preceding-sibling::[*]'                         action => _do_precedingSiblingArray
    | 'preceding-sibling::{*}'                         action => _do_precedingSiblingHash
    | 'preceding-sibling::' keyname                    action => _do_precedingSiblingNamed
    | 'preceding-sibling::' UINT                       action => _do_precedingSiblingIndexedOrNamed
    | 'preceding-sibling::[' UINT ']'                  action => _do_precedingSiblingIndexed
    | 'following-sibling::*'                           action => _do_followingSibling
    | 'following-sibling::[*]'                         action => _do_followingSiblingArray
    | 'following-sibling::{*}'                         action => _do_followingSiblingHash
    | 'following-sibling::' keyname                    action => _do_followingSiblingNamed
    | 'following-sibling::' UINT                       action => _do_followingSiblingIndexedOrNamed
    | 'following-sibling::[' UINT ']'                  action => _do_followingSiblingIndexed

IndexExprs ::= IndexExpr+             separator => <comma>

IndexExpr ::=
    IntExpr                                            action => _do_index_single
    | rangeExpr                                        action => _do_arg1

rangeExpr ::= 
    IntExpr '..' IntExpr                               action => _do_index_range
    |IntExpr '..'                                      action => _do_startRange
    | '..' IntExpr                                     action => _do_endRange

Filter ::= 
    IndexFilter
    | LogicalFilter
    | Filter Filter                                    action => _do_mergeFilters

LogicalFilter ::=     
    '[' LogicalExpr ']'                                action => _do_boolean_filter

IndexFilter ::=     
    '[' IndexExprs ']'                                 action => _do_index_filter


IntExpr ::=
  WS ArithmeticIntExpr WS                              action => _do_arg2

 ArithmeticIntExpr ::=
     INT                                               action => _do_arg1
    | IntegerFunction                                  action => _do_arg1
    | '(' IntExpr ')'                                  action => _do_group
    || '-' ArithmeticIntExpr                           action => _do_unaryOperator
     | '+' ArithmeticIntExpr                           action => _do_unaryOperator
    || IntExpr '*' IntExpr                             action => _do_binaryOperation
     | IntExpr 'div' IntExpr                           action => _do_binaryOperation
#     | IntExpr ' /' IntExpr                           action => _do_binaryOperation 
#     | IntExpr '/ ' IntExpr                           action => _do_binaryOperation 
     | IntExpr '%' IntExpr                             action => _do_binaryOperation
    || IntExpr '+' IntExpr                             action => _do_binaryOperation
     | IntExpr '-' IntExpr                             action => _do_binaryOperation


NumericExpr ::=
  WS ArithmeticExpr WS                                 action => _do_arg2

ArithmeticExpr ::=
    NUMBER                                             action => _do_arg1
    || PredPathExpr                                    action => _do_getValueOperator
    | NumericFunction                                  action => _do_arg1
    | '(' NumericExpr ')'                              action => _do_group
    || '-' ArithmeticExpr                              action => _do_unaryOperator
     | '+' ArithmeticExpr                              action => _do_unaryOperator
    || NumericExpr '*' NumericExpr                     action => _do_binaryOperation
     | NumericExpr 'div' NumericExpr                   action => _do_binaryOperation
#     | NumericExpr ' /' NumericExpr                   action => _do_binaryOperation
#     | NumericExpr '/ ' NumericExpr                   action => _do_binaryOperation
     | NumericExpr '%' NumericExpr                     action => _do_binaryOperation
    || NumericExpr '+' NumericExpr                     action => _do_binaryOperation
     | NumericExpr '-' NumericExpr                     action => _do_binaryOperation

LogicalExpr ::=
    WS LogicalFunction WS                              action => _do_arg2
    || WS compareExpr WS                               action => _do_arg2

compareExpr ::=    
    PredPathExpr                                       action => _do_exists
    || AnyTypeExpr '<' AnyTypeExpr                     action => _do_binaryOperation
     | AnyTypeExpr '<=' AnyTypeExpr                    action => _do_binaryOperation
     | AnyTypeExpr '>' AnyTypeExpr                     action => _do_binaryOperation
     | AnyTypeExpr '>=' AnyTypeExpr                    action => _do_binaryOperation
     | StringExpr 'lt' StringExpr                      action => _do_binaryOperation
     | StringExpr 'le' StringExpr                      action => _do_binaryOperation
     | StringExpr 'gt' StringExpr                      action => _do_binaryOperation
     | StringExpr 'ge' StringExpr                      action => _do_binaryOperation
     | StringExpr '~' RegularExpr                      action => _do_binaryOperation
     | StringExpr '!~' RegularExpr                     action => _do_binaryOperation
     | NumericExpr '===' NumericExpr                   action => _do_binaryOperation
     | NumericExpr '!==' NumericExpr                   action => _do_binaryOperation
     | AnyTypeExpr '==' AnyTypeExpr                    action => _do_binaryOperation 
     | AnyTypeExpr '=' AnyTypeExpr                     action => _do_binaryOperation #to be xpath compatible
     | AnyTypeExpr '!=' AnyTypeExpr                    action => _do_binaryOperation
     | StringExpr 'eq' StringExpr                      action => _do_binaryOperation
     | StringExpr 'ne' StringExpr                      action => _do_binaryOperation
    || LogicalExpr 'and' LogicalExpr                   action => _do_binaryOperation
    || LogicalExpr 'or' LogicalExpr                    action => _do_binaryOperation


AnyTypeExpr ::=
    WS allTypeExp WS                                   action => _do_arg2    

allTypeExp ::=
    NumericExpr                                        action => _do_arg1
    |StringExpr                                        action => _do_arg1                    
  || PredPathExpr                                      action => _do_getValueOperator 


StringExpr ::=
    WS allStringsExp WS                                action => _do_arg2

allStringsExp ::=
    STRING                                             action => _do_arg1
     | StringFunction                                  action => _do_arg1
     | PredPathExpr                                    action => _do_getValueOperator
     || StringExpr '||' StringExpr                     action => _do_binaryOperation


RegularExpr ::= 
    WS STRING    WS                                    action => _do_re

LogicalFunction ::=
    'not' '(' LogicalExpr ')'                          action => _do_func
    | 'isRef' '('  OptionalPathArgs  ')'               action => _do_func
    | 'isScalar' '(' OptionalPathArgs ')'              action => _do_func
    | 'isArray' '(' OptionalPathArgs ')'               action => _do_func
    | 'isHash' '(' OptionalPathArgs ')'                action => _do_func
    | 'isCode' '(' OptionalPathArgs ')'                action => _do_func

StringFunction ::=
    NameFunction                                       action => _do_arg1
    | ValueFunction                                    action => _do_arg1

NameFunction ::= 
    'name' '(' OptionalPathArgs ')'                    action => _do_func

OptionalPathArgs ::= 
    RequiredPathArgs                                   action => _do_arg1
    | EMPTY                                            action => _do_arg1

RequiredPathArgs ::=
    WS PathExpr WS                                     action => _do_arg2

EMPTY ::= 

ValueFunction ::= 
    'value' '(' OptionalPathArgs ')'                   action => _do_func

CountFunction ::= 
    'count' '(' RequiredPathArgs ')'                   action => _do_func

LastFunction ::= 
    'last' '(' OptionalPathArgs ')'                    action => _do_func

PositionFunction ::= 
    'position' '(' OptionalPathArgs ')'                action => _do_func

SumFunction ::= 
    'sum' '(' RequiredPathArgs ')'                     action => _do_func

SumProductFunction ::= 
    'sumproduct' '(' RequiredPathArgs ',' RequiredPathAaction => _do_funcw2args

NumericFunction ::=
    IntegerFunction                                    action => _do_arg1
    |ValueFunction                                     action => _do_arg1
    |SumFunction                                       action => _do_arg1
    |SumProductFunction                                action => _do_arg1

IntegerFunction ::=
    CountFunction                                      action => _do_arg1
    |LastFunction                                      action => _do_arg1
    |PositionFunction                                  action => _do_arg1

ListFunction ::=
    'names' '(' OptionalPathArgs ')'                   action => _do_func
    | 'values' '(' OptionalPathArgs ')'                action => _do_func
    | 'lasts' '(' OptionalPathArgs ')'                 action => _do_func
    | 'positions' '(' OptionalPathArgs ')'             action => _do_func


 NUMBER ::= 
     unumber                                           action => _do_arg1
     | '-' unumber                                     action => _do_join
     | '+' unumber                                     action => _do_join

unumber    
    ~ uint
    | uint frac
    | uint exp
    | uint frac exp
    | frac
    | frac exp
 
uint            
    ~ digits

digits 
    ~ [\d]+
 
frac
    ~ '.' digits
 
exp
    ~ e digits
 
e
    ~ 'e'
    | 'e+'
    | 'e-'
    | 'E'
    | 'E+'
    | 'E-'

INT ::= 
    UINT                                               action => _do_arg1
    | '+' UINT                                         action => _do_join    #avoid ambiguity
    | '-' UINT                                         action => _do_join    #avoid ambiguity

UINT
    ~digits

STRING ::= 
    double_quoted                                      action => _do_double_quoted
    | single_quoted                                    action => _do_single_quoted

single_quoted        
    ~ ['] single_quoted_chars [']

single_quoted_chars      
     ~ single_quoted_char*
 
single_quoted_char  
    ~ [^']
    | '\' [']

double_quoted        
    ~ ["] double_quoted_chars ["]

double_quoted_chars      
     ~ double_quoted_char*
 
double_quoted_char  
    ~ [^"]
    | '\' '"'

keyname ::= 
    keyword                                           action => _do_token
    | STRING                                          action => _do_arg1
    | curly_delimited_string                          action => _do_curly_delimited_string

curly_delimited_string
    ~ '{' curly_delimited_chars '}'

curly_delimited_chars
    ~ curly_delimited_char*

curly_delimited_char
    ~ [^}{]
    | '\'    '{'
    | '\'    '}'

keyword 
    ~ ID

ID 
    ~ token
    | token ':' token      #to allow replication of xml tags names with namespaces

token                                 #must have at least one non digit 
    ~ notreserved
    | token [\d] 
    | [\d] token

notreserved 
    ~ [^\d:./*,'"|\s\]\[\(\)\{\}\\+-<>=!]+


# :discard 
#     ~ WS

WS ::= 
    whitespace
    |EMPTY

whitespace
    ~ [\s\n\r]+

comma 
    ~ ','

END_OF_SOURCE
});

sub _do_arg1{ return $_[1]};
sub _do_arg2{ return $_[2]};

sub _do_token{
    my $arg = $_[1];
    $arg =~ s/#([0-9]+)#/chr $1/ge; #recovery utf8 character
    return $arg;
}
sub _do_double_quoted {
    my $s = $_[1];
    $s =~ s/#([0-9]+)#/chr $1/ge; #recovery utf8 character 
    $s =~ s/^"|"$//g;
    $s =~ s/\\"/"/g;
    return $s;
}
sub _do_single_quoted {
    my $s = $_[1];
    $s =~ s/#([0-9]+)#/chr $1/ge; #recovery utf8 character 
    $s =~ s/^'|'$//g;
    $s =~ s/\\'/'/g;
    return $s;
}
sub _do_curly_delimited_string{
    my $s = $_[1];
    $s =~ s/#([0-9]+)#/chr $1/ge; #recovery utf8 character 
    $s =~ s/^{|}$//g;
    $s =~ s/\\{/{/g;
    $s =~ s/\\}/}/g;
    return $s;    
}
sub _do_re{
    my $re = $_[2];
    return qr/$re/;
}
sub _do_func{
    my $args =    $_[3] || [];
    return {oper => [$_[1], $args]}
}
sub _do_funcw2args{
    return {oper => [$_[1], $_[3],$_[5]]}
}
sub _do_join{
    return join '', @_[1..$#_];
}
sub _do_group{
    return $_[2]
}
sub _do_unaryOperator{
    return {oper => [@_[1,2]]}
}
sub _do_getValueOperator{
    return {values => $_[1]}
}
sub _do_binaryOperation{
    my $oper =     [$_[2]];
    $oper =~ s/^\s+|\s+$//g;
    my $args =     [@_[1,3]];
    foreach my $i (0..$#$args){
        if (ref $args->[$i] eq q|HASH| 
            and defined $args->[$i]->{q|oper|} 
            and $args->[$i]->{q|oper|}->[0] eq $oper->[0]){
            my $list = $args->[$i]->{q|oper|};
            push @$oper, @{$list}[1..$#$list];
        }else{
            push @$oper, $args->[$i]; 
        } 
    }
    return {oper => $oper};
}
sub _do_exists{
    return {oper => [q|exists|, $_[1]]}
}
sub _do_stepFilterSubpath(){
    my ($step, $filter, $subpath) = @_[1..3];
    carp q|arg is not a hash ref| unless ref $step eq q|HASH|; 
    @{$step}{qw|filter subpath|} = ($filter,$subpath);
    return $step;
}
sub _do_stepFilter(){
    my ($step, $filter) = @_[1,2];
    carp q|arg is not a hash ref| unless ref $step eq q|HASH|; 
    $step->{filter} = $filter;
    return $step;
}
sub _do_stepSubpath{
    my ($step,$subpath) = @_[1,2];
    carp q|arg is not a hash ref| unless ref $step eq q|HASH|; 
    $step->{subpath} = $subpath;
    return $step;
}
sub _do_path{
    return {paths => $_[1]}    
}
sub _do_pushArgs2array{
    my ($a,$b) = @_[1,3];
    my @array = (@$a,@$b);
    return \@array;
}
sub _do_absolutePath{
    return [{absolute => 1, path => $_[1]}];
}
sub _do_relativePath{
    return [{relative => 1, path => $_[1]}];
}
sub _do_relativePath2{
    return [{relative => 1, path => $_[2]}];
}
sub _do_boolean_filter{ 
    return {boolean => $_[2]}
};
sub _do_mergeFilters{
    my ($filters1, $filters2) = @_[1,2];
    my @filters = (@$filters1, @$filters2);
    return \@filters; 
}
sub _do_index_filter{
    return {indexes => $_[2]}
}
sub _do_index_single{
    return {index => $_[1]}
}
sub _do_index_range{
    return {range => [@_[1,3]]}
}
sub _do_startRange{
    {from => $_[1]}
}
sub _do_endRange{
    {to => $_[2]}
}
sub  _do_vlen{
    return {
            slashslash => $_[1],
            subpath => $_[2]
    };
}
sub _do_descendant{
    return {descendant => $_[1]};    
}
sub _do_descendantArray{
    return {descendantArray => $_[1]};    
}
sub _do_descendantHash{
    return {descendantHash => $_[1]};    
}
sub _do_descendantNamed{
    return {descendantNamed => $_[2]};    
}
sub _do_descendantIndexed{
    return {descendantIndexed => $_[2]};    
}
sub _do_descendantIndexedOrNamed{
    return {descendantIndexedOrNamed => $_[2]};    
}
sub _do_descendantOrSelf{
    return {descendantOrSelf => $_[1]};    
}
sub _do_descendantOrSelfArray{
    return {descendantOrSelfArray => $_[1]};    
}
sub _do_descendantOrSelfHash{
    return {descendantOrSelfHash => $_[1]};    
}
sub _do_descendantOrSelfNamed{
    return {descendantOrSelfNamed => $_[2]};    
}
sub _do_descendantOrSelfIndexed{
    return {descendantOrSelfIndexed => $_[2]};    
}
sub _do_descendantOrSelfIndexedOrNamed{
    return {descendantOrSelfIndexedOrNamed => $_[2]};    
}
sub _do_precedingSibling{
    return {precedingSibling => $_[1]};    
}
sub _do_precedingSiblingArray{
    return {precedingSiblingArray => $_[1]};    
}
sub _do_precedingSiblingHash{
    return {precedingSiblingHash => $_[1]};    
}
sub _do_precedingSiblingNamed{
    return {precedingSiblingNamed => $_[2]};    
}
sub _do_precedingSiblingIndexed{
    return {precedingSiblingIndexed => $_[2]};    
}
sub _do_precedingSiblingIndexedOrNamed{
    return {precedingSiblingIndexedOrNamed => $_[2]};    
}
sub _do_followingSibling{
    return {followingSibling => $_[1]};    
}
sub _do_followingSiblingArray{
    return {followingSiblingArray => $_[1]};    
}
sub _do_followingSiblingHash{
    return {followingSiblingHash => $_[1]};    
}
sub _do_followingSiblingNamed{
    return {followingSiblingNamed => $_[2]};    
}
sub _do_followingSiblingIndexed{
    return {followingSiblingIndexed => $_[2]};    
}
sub _do_followingSiblingIndexedOrNamed{
    return {followingSiblingIndexedOrNamed => $_[2]};    
}
sub _do_child{
    return {child => $_[1]};
}
sub _do_childArray{
    return {childArray => $_[1]};
}
sub _do_childHash{
    return {childHash => $_[1]};
}
sub _do_keyname{
    return {childNamed => $_[1]};    
}
sub _do_array_index{
    return {childIndexed => $_[2]}    
}
sub _do_array_hash_index{
    return {childIndesxedOrNamed => $_[1]}    
}
sub _do_childNamed{
    return {childNamed => $_[2]};
}
sub _do_childIndexed{
    return {childIndexed => $_[2]};
}
sub _do_childIndexedOrNamed{
    return {childIndesxedOrNamed => $_[2]};
}
sub _do_self{
    return {self =>  $_[1]};    
}
sub _do_selfArray{
    return {selfArray =>  $_[1]};    
}
sub _do_selfHash{
    return {selfHash =>  $_[1]};    
}
sub _do_selfNamed{
    return { selfNamed => $_[2]};    
}
sub _do_selfIndexedOrNamed{
    return { selfIndexedOrNamed => $_[2]};    
}
sub _do_selfIndexed{
    return { selfIndexed => $_[2]};    
}
sub _do_parent{
    return {parent => $_[1]};    
}
sub _do_parentArray{
    return {parentArray => $_[1]};    
}
sub _do_parentHash{
    return {parentHash => $_[1]};    
}
sub _do_parentNamed{
    return {parentNamed => $_[2]};
}
sub _do_parentIndexed{
    return {parentIndexed => $_[2]};
}
sub _do_parentIndexedOrNamed{
    return {parentIndexedOrNamed => $_[2]};
}
sub _do_ancestor{
    return {ancestor => $_[1]};
}
sub _do_ancestorArray{
    return {ancestorArray => $_[1]};
}
sub _do_ancestorHash{
    return {ancestorHash => $_[1]};
}
sub _do_ancestorNamed{
    return {ancestorNamed => $_[2]};    
}
sub _do_ancestorIndexed{
    return {ancestorIndexed => $_[2]};    
}
sub _do_ancestorIndexedOrNamed{
    return {ancestorIndexedOrNamed => $_[2]};    
}
sub _do_ancestorOrSelf{
    return {ancestorOrSelf => $_[1]}    
}
sub _do_ancestorOrSelfArray{
    return {ancestorOrSelfArray => $_[1]}    
}
sub _do_ancestorOrSelfHash{
    return {ancestorOrSelfHash => $_[1]}    
}
sub _do_ancestorOrSelfNamed{
    return {ancestorOrSelfNamed => $_[2]}        
}
sub _do_ancestorOrSelfIndexed{
    return {ancestorOrSelfIndexed => $_[2]}        
}
sub _do_ancestorOrSelfIndexedOrNamed{
    return {ancestorOrSelfIndexedOrNamed => $_[2]}        
}
#############################end of rules################################

my @context = ();
sub _names{
            return map {$_->{name}} _getSubObjectsOrCurrent(@_);
}
sub _values{
    #print 'Values arg = ', Dumper \@_;
    return map {${$_->{data}}} _getSubObjectsOrCurrent(@_);
}
sub _positions{
    my @r = _getSubObjectsOrCurrent(@_);
    return map {$_->{pos}} @r;            
}
sub _lasts{
    my @r = _getSubObjectsOrCurrent(@_);
    return map {$_->{size}} @r;    
}

no warnings qw{uninitialized numeric};

my $operatorBy = {
    '=' => sub($$){
        return _logicalOper(sub {$_[0] == $_[1]}, $_[0], $_[1]);
    },
    '==' => sub($$){
        return _logicalOper(sub {$_[0] == $_[1]}, $_[0], $_[1]);
    },
    '!=' => sub($$){
        return _logicalOper(sub {$_[0] != $_[1]}, $_[0], $_[1]);
    },
    'eq' => sub($$){
        return _logicalOper(sub {$_[0] eq $_[1]}, $_[0], $_[1]);
    },
    'ne' => sub($$){
        return _logicalOper(sub {$_[0] ne $_[1]}, $_[0], $_[1]);
    },
    '===' => sub($$){
        return _logicalOper(sub {
            looks_like_number($_[0])
            and looks_like_number($_[1])
            and $_[0] == $_[1]
        }, $_[0], $_[1]);
    },
    '!==' => sub($$){
        return _logicalOper(sub {
            $_[0] != $_[1]
        }, $_[0], $_[1]);
    },
    '>' => sub($$){
        return _logicalOper(sub {$_[0] > $_[1]}, $_[0], $_[1]);
    },
    '>=' => sub($$){
        return _logicalOper(sub {$_[0] >= $_[1]}, $_[0], $_[1]);
    },
    '<' => sub($$){
        return _logicalOper(sub {$_[0] < $_[1]}, $_[0], $_[1]);
    },
    '<=' => sub($$){
        return _logicalOper(sub {$_[0] <= $_[1]}, $_[0], $_[1]);
    },
    '>=' => sub($$){
        return _logicalOper(sub {$_[0] >= $_[1]}, $_[0], $_[1]);
    },
    'lt' => sub($$){
        return _logicalOper(sub {$_[0] lt $_[1]}, $_[0], $_[1]);
    },
    'le' => sub($$){
        return _logicalOper(sub {$_[0] le $_[1]}, $_[0], $_[1]);
    },
    'gt' => sub($$){
        return _logicalOper(sub {$_[0] gt $_[1]}, $_[0], $_[1]);
    },
    'ge' => sub($$){
        return _logicalOper(sub {$_[0] ge $_[1]}, $_[0], $_[1]);
    },
    'and' => sub($$){
        return _logicalOper(sub {$_[0] and $_[1]}, $_[0], $_[1]);
    },
    'or' => sub($$){
        return _logicalOper(sub {$_[0] or $_[1]}, $_[0], $_[1]);
    },
    '~' => sub($$){
        return _logicalOper(sub {$_[0] =~ $_[1]}, $_[0], $_[1]);
    },
    '!~' => sub($$){
        return _logicalOper(sub {$_[0] !~ $_[1]}, $_[0], $_[1]);
    },
    '*' => sub($$;@){
        return _naryOper(sub {$_[0] * $_[1]}, $_[0], $_[1], @_[2..$#_]);
    },
    'div' => sub($$;@){
        return _naryOper(sub {
            my $r = eval {$_[0] / $_[1]};
            carp qq|Division problems\n$@| if $@;
            return $r;
        }, $_[0], $_[1], @_[2..$#_]);
    },
    '/' => sub($$;@){
        return _naryOper(sub {
            my $r = eval {$_[0] / $_[1]};
            carp qq|Division problems\n$@| if $@;
            return $r;
        }, $_[1], @_[2..$#_]);
    },
    '+' => sub($$;@){
        return _naryOper(sub {$_[0] + $_[1]}, $_[0], $_[1], @_[2..$#_]);
    },
    '-' => sub($$;@){
        return _naryOper(sub {$_[0] - $_[1]}, $_[0], $_[1], @_[2..$#_]);
    },
    '%' => sub($$;@){
        return _naryOper(sub {$_[0] % $_[1]}, $_[0], $_[1], @_[2..$#_]);
    },
    '||' => sub{
        return _naryOper(sub {$_[0] . $_[1]}, $_[0], $_[1], @_[2..$#_])
    },
    names => \&_names,
    values => \&_values,
    positions => \&_positions,
    lasts => \&_lasts,
    name => sub {
        return (_names(@_))[0] // q||;
    },
    value => sub(){
        return (_values(@_))[0] // q||;
    },
    position => sub{
        my @r = _positions(@_);
        return $r[$#r] // 0;        
    },
    last => sub{
        my @r = _lasts(@_);
        return $r[$#r] // 0;
    },
    isHash => sub{
        my @r = grep {ref ${$_->{data}} eq q|HASH|} _getSubObjectsOrCurrent(@_);
        return @r > 0;
    },
    isArray => sub{
        my @r = grep {ref ${$_->{data}} eq q|ARRAY|} _getSubObjectsOrCurrent(@_);
        return @r > 0;    
    },
    isCode => sub{
        my @r = grep {ref ${$_->{data}} eq q|CODE|} _getSubObjectsOrCurrent(@_);
        return @r > 0;                
    },
    isRef => sub{
        my @r = grep {ref ${$_->{data}}} _getSubObjectsOrCurrent(@_);
        return @r > 0;    
    },
    isScalar => sub{
        my @r = grep {!ref ${$_->{data}}} _getSubObjectsOrCurrent(@_);
        return @r > 0;        
    },
    count =>sub{
        my @r = _getSubObjectsOrCurrent(@_);
        return scalar @r;
    },
    exists => sub{
        my @r = _getSubObjectsOrCurrent(@_);
        return scalar @r > 0;        
    },
    not => sub{
        return !_operation($_[0]);
    },
    sum => sub{
        my @r = _getSubObjectsOrCurrent($_[0]);
        my @s = grep{ref $_->{data} eq q|SCALAR| and looks_like_number(${$_->{data}})} @r; #ignore entry if it is not a scalar
        my $s = 0;
        $s += ${$_->{data}} foreach (@s);
        return $s;    
    },
    sumproduct => sub{
        my @r = _getSubObjectsOrCurrent($_[0]);
        my @s = _getSubObjectsOrCurrent($_[1]);
        my $size = $#r < $#s ? $#r: $#s;
        my $s = 0;
        foreach (0..$size){
            $s += ${$r[$_]->{data}} * ${$s[$_]->{data}} 
                if ref $r[$_]->{data} eq q|SCALAR| 
                and ref $s[$_]->{data} eq q|SCALAR|
                and looks_like_number(${$r[$_]->{data}})
                and looks_like_number(${$s[$_]->{data}}) 
        }
        return $s;    
    },
};
sub _operation($){
    my $operData = $_[0];
    return undef unless defined $operData and ref $operData eq q|HASH|;
    my %types = (
        oper => sub{
            my ($oper, @args) = @{$operData->{oper}};
            #print "oper=$oper";
            #my $oper = $params[0];
            return undef unless defined $oper and exists $operatorBy->{$oper};
            #my @args = @params[1..$#params];
            return $operatorBy->{$oper}->(@args);              
        },
        values =>sub{
            my @r = $operatorBy->{values}->($operData->{values});
            return @r;
        }
    );
    #print 'operdata = ', Dumper $operData;
    my @r = map {$types{$_}->()} grep {exists $types{$_}} keys %$operData;
    return @r if wantarray();
    return $r[0];
}
sub _naryOper(&$$;@){
        my ($oper,$x,$y,@e) = @_;
        $x = _operation($x) if ref $x;
        $y = _operation($y) if ref $y;
        my $res = $oper->($x,$y);
        foreach my $e (@e){
            $e = _operation($e) if ref $e;
            $res = $oper->($res,$e);
        }
        return $res
}
sub _logicalOper(&$$){
        my ($oper,$x,$y) = @_;
        #print "x=", Dumper $x;
        #print "y=", Dumper $y;
        my @x = ($x);
        my @y = ($y);
        @x = _operation($x) if ref $x and ref $x ne q|Regexp|;
        @y = _operation($y) if ref $y and ref $y ne q|Regexp|;
        #my @r = eval {};
        #warn qq|Warning: $@| if $@;
        foreach my $x (@x){
            foreach my $y (@y){
                return 1 if $oper->($x,$y)
            }    
        }
        return 0;
        #return $oper->($x,$y);
}


sub _evaluate{
    my $x = $_[0];
    return $x unless ref $x eq q|HASH| and exists $x->{oper};
    return _operation($x);
}
sub getStruct{
    my ($context, $subpath) = @_;
    return ($context) unless defined $subpath;
    push @context, $context;
    my @r = _getObjectSubset(${$context->{data}}, $subpath);
    pop @context;
    return @r; 
}
my %filterType = (
    boolean => sub {
        return  _operation($_[0]);
    }
    , indexes => sub{
        sub computeIndex{
            my $index = 0 + _evaluate($_[0]);
            $index += 1 + $context[$#context]->{size} if $index < 0;
            return $index;
        }
        my %indexType = (
            index => sub{
                return $context[$#context]->{pos} == computeIndex($_[0]);
            }
            , range => sub{
                #print 'range', Dumper $_[0];
                my $pos = $context[$#context]->{pos};
                my ($start, $end) = map {computeIndex($_)} @{$_[0]};
                return $pos >= $start && $pos <= $end;
            }
            , from => sub{
                #print 'from', Dumper $_[0];
                return $context[$#context]->{pos} >= computeIndex($_[0]);                
            }
            , to => sub{
                #print 'to', Dumper $_[0];
                return $context[$#context]->{pos} <= computeIndex($_[0]);                
            }
        );
        #print 'indexes filter ',Dumper @_;
        my $indexes = $_[0];
        foreach my $index (@$indexes){
            #print 'evaluate', Dumper $index;
            return 1 if (map {$indexType{$_}->($index->{$_})} grep {exists $indexType{$_}} keys %$index)[0]; 
        }
        return 0;
    }    
);
sub _filter{
    my ($context,$filter) = @_;
    #print 'validate -> ', Dumper \@_;
    return 1 unless defined $filter and ref $filter eq q|HASH|;  #just in case
    push @context, $context;
    my ($r) = map {$filterType{$_}->($filter->{$_})} grep {exists $filterType{$_}} keys %$filter;
    pop @context;
    return $r;    
}
sub _getFilteredKeys{
    my ($data,$filter,@keys) = @_;
    $filter //= [];
    my $order = $context[$#context]->{order} // q||;
    my $size = scalar @keys;

    my @keyIndex = map{{
        name => $keys[$_], 
        type => q|HASH|, 
        data  => \$data->{$keys[$_]}, 
        order => qq|$order/$keys[$_]|, 
        size => scalar @keys
    }} 0..$#keys;
    foreach my $filter (@$filter){
        my $pos = 1;
        $size = scalar @keyIndex;
        @keyIndex = grep {_filter(
                    $_
                    ,$filter
        )} map {@{$_}{qw|pos size|} = ($pos++, $size); $_} @keyIndex ;
    }

    my $pos = 1;
    $size = scalar @keyIndex;
    return map {@{$_}{qw|pos size|} = ($pos++, $size); $_} @keyIndex    
}
sub _getFilteredIndexes{
    my ($data,$filter,@indexes) = @_;
    $filter //= [];
    my $order = $context[$#context]->{order} // q||;
    my $size = scalar @indexes;
    my $large = 1;
    {    use integer;    my $n = $size; $large++ while($n /= 10); } #a scope to do integer operations;

    my @r = map {{                                                            #init result array     
        name => $_, 
        type => q|ARRAY|, 
        data  => \$data->[$_], 
        order => qq|$order/|.sprintf("%0*u",$large,$_), 
        size => $size
    }} @indexes;
    
    foreach my $filter (@$filter){
        my $pos = 1;
        $size = scalar @r;
        @r = grep {_filter(                                                #filter out from result
                    $_                
                    ,$filter
        )} map {@{$_}{qw|pos size|} = ($pos++, $size); $_} @r ;
    }

    my $pos = 1;
    $size = scalar @r;
    return map{    @{$_}{qw|pos size|} = ($pos++, $size); $_} @r;             #compute final positions in context
}
sub _anyChildType{
    my ($type,$name,$data,$subpath,$filter) = @_;
    my %filterByDataType = (
            HASH => sub{
                return () if defined $type and $type ne q|HASH|;
                my @keys = keys %$data;
                @keys = grep {$_ eq $name} @keys if defined $name;
                return _getFilteredKeys($data,$filter, sort @keys);
            }
            , ARRAY => sub{
                return () if defined $type and $type ne q|ARRAY|;
                my @indexes = 0..$#$data;
                @indexes = grep {$_ == $name} @indexes if defined $name;
                return _getFilteredIndexes($data,$filter, @indexes);
            }
    );
    return 
        map {getStruct($_, $subpath)} 
        map { $filterByDataType{$_}->()} 
        grep {exists $filterByDataType{$_}} 
        (ref $data);
}
sub _descendant{
    my ($data,$path) = @_;
    #print 'context', Dumper \@context;
    my @r = _getObjectSubset($data,$path);    
    my $order = $context[$#context]->{order} // q||;
    #print "order = $order";
    if (ref $data eq q|HASH|){
            my @keys = sort keys %$data;
            foreach (@keys){
                push @context, {name => $_, type => q|HASH|, data  => \$data->{$_}, order => qq|$order/$_|, pos =>1, size => scalar @keys };
                push @r, _descendant($data->{$_}, $path);
                pop @context;
            }
    }
    if (ref $data eq q|ARRAY|){
            foreach (0 .. $#$data){
                push @context, {name => $_, type => q|ARRAY|, data  => \$data->[$_], order =>  qq|$order/$_|, pos=> 1, size => scalar @$data};
                push @r, _descendant($data->[$_], $path);
                pop @context;
            }
    } 
    return @r;
}
sub _getDescendants{
    my($descendants,$subpath) = @_;
    my @r=();
    foreach (0..$#$descendants){
            if (defined $descendants->[$_]){                        #only if descendants was selected
                    my $last = $#context;
                    #print "descendant of $_", Dumper $descendants->[$_];
                    #print "subpath", Dumper $subpath;
                    push @context, @{$descendants->[$_]};
                    push @r, defined $subpath ?
                        _getObjectSubset(${$context[$#context]->{data}}, $subpath)
                        : ($context[$#context]);
                    $#context = $last;                        
            }
    }
    return @r;
}

sub _getDescContexts{
        my (@context) = @_;
        my @r = ();
        my $order = $context[$#context]->{order} // q||;
        my $data = ${$context[$#context]->{data}};
        my $pos = 1;
        if (ref $data eq q|HASH|){
                my @keys = sort keys %$data;
                foreach (@keys){
                    push @r, _getDescContexts(@context, {name => $_, type => q|HASH|, data  => \$data->{$_}, order => qq|$order/$_|, pos =>$pos++, size => scalar @keys });
                }
        }
        if (ref $data eq q|ARRAY|){
                foreach (0 .. $#$data){
                    push @r, _getDescContexts(@context, {name => $_, type => q|ARRAY|, data  => \$data->[$_], order =>  qq|$order/$_|, pos => $pos++, size => scalar @$data});
                }
        }
        return (\@context, @r);
}

sub _filterOutDescendants{
    my ($filters,$size,$descendants) = @_;
    $filters //= [];

    
    #print 'descendants', scalar @$descendants, Dumper \@$descendants;
    foreach my $filter (@$filters){
        my $pos = 1;
        my $cnt = 0;
        foreach my $k (0..$#$descendants){
            if (defined $descendants->[$k]){
                my $last = $#context;
                push @context, @{$descendants->[$k]};
                my ($s,$p) = @{$context[$#context]}{qw|size pos|};
                @{$context[$#context]}{qw|size pos|} = ($size,$pos++);    
                $cnt++, undef $descendants->[$k] if !_filter($context[$#context],$filter);
                @{$context[$#context]}{qw|size pos|} = ($s,$p);    
                $#context = $last;
            }
        }
        $size -= $cnt;
    }
    #print 'Selected descendants', scalar @$descendants, Dumper \@$descendants;
    return $descendants;    
}
sub _getDescendantsByTypeAndName{
        my ($type, $name, $subpath,$filter,$self) = @_;
        my $descendants = [_getDescContexts($context[$#context])];
        shift @$descendants unless $self;
        $descendants = [grep {$_->[$#$_]->{name} eq $name} @$descendants] if defined $name;
        $descendants = [grep {$_->[$#$_]->{type} eq $type} @$descendants] if defined $type;
        shift @{$descendants->[$_]} foreach (0..$#$descendants); #remove the current context from context list.
        my $size = scalar @$descendants;
        return _getDescendants(_filterOutDescendants($filter,$size,$descendants), $subpath);
}

sub _getAncestorsOrSelf{ 
    my ($ancestors,$subpath) = @_; 
    my @tmp = ();
    my @r;
    foreach (0..$#$ancestors){
            if (defined $ancestors->[$_]){                        #only if ancestor was selected
                    push @r, defined $subpath ?
                        _getObjectSubset(${$context[$#context]->{data}}, $subpath)
                        : ($context[$#context])                        
            }
            push @tmp, pop @context;
    }
    push @context, pop @tmp while(scalar @tmp > 0); #repo @context
    return @r;
}
        # foreach (0..$#$ancestors){    #pre filter ancestors with named ones, only!
        #     $size--, undef $ancestors->[$_] if $context[$_]->{name} ne $name;
        # }
sub _filterOutAncestorsOrSelf{
    my($type,$name,$filter,$ancestorsIndex) = @_;
    $filter //= [];

    #as array of flags. Each position flags a correpondent ancestor
    #my @ancestorsIndex = map {1} (0..$#context); 
    

    #filter out ancestors with a different name!
    map {    
        undef $ancestorsIndex->[$_] if $context[$#context - $_]->{name} ne $name;
    } 0..$#$ancestorsIndex if defined $name;

    #filter out ancestors of a different type!
    map {    
        undef $ancestorsIndex->[$_] if $context[$#context - $_]->{type} ne $type;#Não se devia decrementar duplamente
    } 0..$#$ancestorsIndex if defined $type;
    
    my $size = 0;
    map {$size++ if defined $_} @$ancestorsIndex;

    foreach my $filter (@$filter){
        my $pos = 1;
        my @tmp = ();
        my $cnt = 0;
        foreach my $k (0..$#$ancestorsIndex){
            if (defined $ancestorsIndex->[$k]){
                my ($s,$p) = @{$context[$#context]}{qw|size pos|};
                 @{$context[$#context]}{qw|size pos|} = ($size,$pos++);        
                $cnt++, undef $ancestorsIndex->[$k] if !_filter($context[$#context],$filter);
                @{$context[$#context]}{qw|size pos|} = ($s,$p);
            }        
            push @tmp, pop @context;
        }
        push @context, pop @tmp while(scalar @tmp > 0); #repo @context
        $size -= $cnt;                 #adjust the group's size;
    }
    return $ancestorsIndex;
} 
sub _filterOutSiblings{
    my ($type, $name, $subpath,$filter,$direction) = @_;
    my $mySelf = $context[$#context]->{data};
    my $context = pop @context;
    my $data = ${$context[$#context]->{data}};

    my %filterByDataType = (
            HASH => sub{
                my @keys = sort keys %$data;
                my $cnt = $#keys;
                $cnt-- while($cnt >= 0 and \$data->{$keys[$cnt]} != $mySelf);    
                my @siblings = do {
                    if ($direction eq q|preceding|){
                        $#keys = $cnt-1;
                        reverse @keys[0 .. $cnt-1];
                    }elsif($direction eq q|following|){
                        @keys[$cnt+1 .. $#keys]
                    }
                };
                @siblings = grep {$_ eq $name} @siblings if defined $name;
                @siblings = grep {q|HASH| eq $type} @siblings if defined $type;
                return _getFilteredKeys($data,$filter, @siblings);
            }
            , ARRAY => sub{
                my $cnt = $#$data;
                $cnt-- while($cnt >= 0 and \$data->[$cnt] != $mySelf);
                my @siblings = do {
                    if ($direction eq q|preceding|){
                        reverse 0..$cnt-1
                    }elsif($direction eq q|following|){
                        $cnt+1 .. $#$data        
                    }
                };
                @siblings = grep {$_ eq $name} @siblings if defined $name;
                @siblings = grep {q|ARRAY| eq $type} @siblings if defined $type;
                return _getFilteredIndexes($data,$filter, @siblings);
            }
    );
    my @r = 
        map {getStruct($_, $subpath)} 
        map { $filterByDataType{$_}->()} 
        grep {exists $filterByDataType{$_}} 
        (ref $data);
    push @context, $context;
    return @r;
}

my $dispatcher = {
    self => sub{
        my (undef, undef, $subpath,$filter) = @_;
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef, undef, $filter, [0]), $subpath);
    },
    selfArray => sub{
        my (undef, undef, $subpath,$filter) = @_;
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|, undef, $filter, [0]), $subpath);
    },
    selfHash => sub {
        my (undef, undef, $subpath,$filter) = @_;
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|, undef, $filter, [0]), $subpath);
    },
    selfNamed => sub{
        my (undef, $name, $subpath,$filter) = @_;
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|, $name, $filter, [0]), $subpath);
    },
    selfIndexed => sub{
        my (undef, $index, $subpath,$filter) = @_;
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|, $index, $filter, [0]), $subpath);
    },
    selfIndexedOrNamed => sub{
        my (undef, $index, $subpath,$filter) = @_;
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef, $index, $filter, [0]), $subpath);
    },
    parent => sub{
        my (undef, undef, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef, undef, $filter, [0]), $subpath);
        push @context, $current;
        return @r;
    },
    parentArray => sub{
        my (undef, undef, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|, undef, $filter, [0]), $subpath);
        push @context, $current;
        return @r;
    },
    parentHash => sub{
        my (undef, undef, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|, undef, $filter, [0]), $subpath);
        push @context, $current;
        return @r;
    },
    parentNamed => sub{
        my (undef, $name, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|, $name, $filter, [0]), $subpath);
        push @context, $current;
        return @r;
    },
    parentIndexed => sub{
        my (undef, $index, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|, $index, $filter, [0]), $subpath);
        push @context, $current;
        return @r;
    },
    parentIndexedOrNamed => sub{
        my (undef, $index, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef, $index, $filter, [0]), $subpath);
        push @context, $current;
        return @r;
    },
    ancestor => sub{
        my (undef, undef, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef, undef, $filter, [0..$#context]), $subpath);
        push @context, $current;
        return @r;
    },
    ancestorArray => sub{
        my (undef, undef, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|, undef, $filter, [0..$#context]), $subpath);
        push @context, $current;
        return @r;
    },
    ancestorHash => sub{
        my (undef, undef, $subpath,$filter) = @_;

        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|, undef, $filter, [0..$#context]), $subpath);
        push @context, $current;
        return @r;
    },
    ancestorNamed => sub{
        my (undef, $name, $subpath,$filter) = @_;
    
        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|, $name, $filter, [0..$#context]), $subpath);
        push @context, $current;
        return @r;
    },
    ancestorIndexed => sub{
        my (undef, $index, $subpath,$filter) = @_;
    
        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|, $index, $filter, [0..$#context]), $subpath);
        push @context, $current;
        return @r;
    },
    ancestorIndexedOrNamed => sub{
        my (undef, $index, $subpath,$filter) = @_;
    
        my $current = pop @context;
        my @r = _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef, $index, $filter, [0..$#context]), $subpath);
        push @context, $current;
        return @r;
    },
    ancestorOrSelf => sub{
        my (undef, undef, $subpath,$filter) = @_;
    
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef, undef, $filter, [0..$#context]), $subpath);
    }, 
    ancestorOrSelfArray => sub{
        my (undef, undef, $subpath,$filter) = @_;
    
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|, undef, $filter, [0..$#context]), $subpath);
    }, 
    ancestorOrSelfHash => sub{
        my (undef, undef, $subpath,$filter) = @_;
    
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|, undef, $filter, [0..$#context]), $subpath);
    }, 
    ancestorOrSelfNamed => sub{
        my (undef, $name, $subpath,$filter) = @_;
    
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|HASH|,$name,$filter, [0..$#context]), $subpath);
    }, 
    ancestorOrSelfIndexed => sub{
        my (undef, $index, $subpath,$filter) = @_;
    
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(q|ARRAY|,$index,$filter, [0..$#context]), $subpath);
    }, 
    ancestorOrSelfIndexedOrNamed => sub{
        my (undef, $index, $subpath,$filter) = @_;
    
        return _getAncestorsOrSelf(_filterOutAncestorsOrSelf(undef,$index,$filter,[0..$#context]), $subpath);
    }, 
    child => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _anyChildType(undef,undef,$data,$subpath,$filter);        
    },
    childArray => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _anyChildType(q|ARRAY|,undef,$data,$subpath,$filter);        
    },
    childHash => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _anyChildType(q|HASH|,undef,$data,$subpath,$filter);        
    },
    childNamed => sub{
        my ($data, $name, $subpath,$filter) = @_;
        return _anyChildType(q|HASH|,$name,$data,$subpath,$filter);        
    },
    childIndexed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _anyChildType(q|ARRAY|,$index,$data,$subpath,$filter);        
    },
    childIndesxedOrNamed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _anyChildType(undef,$index,$data,$subpath,$filter);        
    },
    descendant => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(undef,undef,$subpath,$filter)
    },
    descendantArray => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(q|ARRAY|,undef,$subpath,$filter)
    },
    descendantHash => sub{
        my ($data, undef, $subpath,$filter) = @_;
        print "AQUI";
        return _getDescendantsByTypeAndName(q|HASH|,undef,$subpath,$filter)
    },
    descendantNamed => sub{
        my ($data, $name, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(q|HASH|,$name,$subpath,$filter)
    },
    descendantIndexed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(q|ARRAY|,$index,$subpath,$filter)
    },
    descendantIndexedOrNamed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(undef,$index,$subpath,$filter)
    },
    descendantOrSelf => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(undef,undef,$subpath,$filter,1)
    },
    descendantOrSelfArray => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(q|ARRAY|,undef,$subpath,$filter,1)
    },
    descendantOrSelfHash => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(q|HASH|,undef,$subpath,$filter,1)
    },
    descendantOrSelfNamed => sub{
        my ($data, $name, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(q|HASH|,$name,$subpath,$filter,1)
    },
    descendantOrSelfIndexed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(q|ARRAY|,$index,$subpath,$filter,1)
    },
    descendantOrSelfIndexedOrNamed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _getDescendantsByTypeAndName(undef,$index,$subpath,$filter,1)
    },
    precedingSibling => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _filterOutSiblings(undef,undef,$subpath, $filter,q|preceding|)        
    },
    precedingSiblingArray => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _filterOutSiblings(q|ARRAY|,undef,$subpath, $filter,q|preceding|)        
    },
    precedingSiblingHash => sub{
        my ($data, undef, $subpath,$filter) = @_;
        _filterOutSiblings(q|HASH|,undef,$subpath, $filter,q|preceding|)        
    },
    precedingSiblingNamed => sub{
        my ($data, $name, $subpath,$filter) = @_;
        return _filterOutSiblings(q|HASH|,$name,$subpath, $filter,q|preceding|)        
    },
    precedingSiblingIndexed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _filterOutSiblings(q|ARRAY|,$index,$subpath, $filter,q|preceding|)        
    },
    precedingSiblingIndexedOrNamed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _filterOutSiblings(undef,$index,$subpath, $filter,q|preceding|)        
    },
    followingSibling => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _filterOutSiblings(undef,undef,$subpath, $filter,q|following|)        
    },
    followingSiblingArray => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _filterOutSiblings(q|ARRAY|,undef,$subpath, $filter,q|following|)        
    },
    followingSiblingHash => sub{
        my ($data, undef, $subpath,$filter) = @_;
        return _filterOutSiblings(q|HASH|,undef,$subpath, $filter,q|following|)        
    },
    followingSiblingNamed => sub{
        my ($data, $name, $subpath,$filter) = @_;
        return _filterOutSiblings(q|HASH|,$name,$subpath, $filter,q|following|)        
    },
    followingSiblingIndexed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _filterOutSiblings(q|ARRAY|,$index,$subpath, $filter,q|following|)        
    },
    followingSiblingIndexedOrNamed => sub{
        my ($data, $index, $subpath,$filter) = @_;
        return _filterOutSiblings(undef,$index,$subpath, $filter,q|following|)        
    },
    slashslash => sub{
        my ($data, undef, $subpath,undef) = @_;
        return _descendant($data,$subpath);
    }
};


# find_cycle($operatorBy);
# find_cycle($dispatcher);
# find_cycle(\@context);

$Data::Dumper::Deepcopy = 1;

sub _getObjectSubset{
    my ($data,$path) = @_;
    $path //= {};                        #if not defined $path

    my %seen;
    return 
        sort {
            $a->{order} cmp $b->{order}
        }grep {
            defined $_ 
            and defined $_->{data} 
            and defined $_->{order} 
            and !$seen{$_->{data}}++
        } map {
            $dispatcher->{$_}->($data, $path->{$_}, $path->{subpath}, $path->{filter})
        } grep{
            exists $path->{$_}
        } keys %$dispatcher;
}
sub _getSubObjectsOrCurrent{
    my $paths = $_[0];
    return _getObjects(@$paths) if defined $paths and ref $paths eq q|ARRAY| and scalar @$paths > 0;
    return ($context[$#context]);
}
sub _getObjects{
        my @paths = @_;
        my @r = ();
        foreach my $entry (@paths){
            my $data = ${$context[defined $entry->{absolute} ? 0 : $#context]->{data}};
            push @r, _getObjectSubset($data,$entry->{path});
        }
        return @r;
}

###########object based invocation methods ########################
sub _execute{
    my ($self,$data,$query) = @_;
    return undef unless ref $data eq q|HASH| or ref $data eq q|ARRAY|; 
    return undef unless defined $query and (defined $query->{oper} or defined $query->{paths});
    push @context, {data  => \$data, type => ref $data, order => '', name => '/', size => 1, pos => 1};
    my @r = defined $query->{oper} ? 
        map {\$_} (_operation($query))                                #if an operation    
        : map {$_->{data}} sort {$a->{order} cmp $b->{order}} _getObjects(@{$query->{paths}});     #else is a path
    pop @context;
    return Data::xPathLike::Results->new(@r);
}

#########################################public methods ###################################################################
sub new {}                 #The Marpa::R2 needs it
sub compile{
    my ($self,$q) = @_; 
    return undef unless $q;

    my $reader = Marpa::R2::Scanless::R->new({
        grammar => $grammar,
        trace_terminals => 0,
    }) or return undef;
    $q =~ s/[#\N{U+A0}-\N{U+10FFFF}]/sprintf "#%d#", ord $&/ge; #code utf8 characters with sequece #utfcode#. Marpa problem? 
    eval {$reader->read(\$q)};
    carp qq|Wrong xPathLike Expression\n$@| and return undef if $@; 
    my $qp = $reader->value or return undef;
    #print "compile", Dumper $qp;
    return Data::xPathLike::Data->new(${$qp})
}

sub data{
    my ($self,$data) = @_;
    return Data::xPathLike::Compiler->new($data)
}

sub DESTROY{
}

package Data::xPathLike::Compiler;
use Data::Dumper;
sub new{
    my ($self,$data) = @_;
    return undef unless defined $data and (ref $data eq q|HASH| or ref $data eq q|ARRAY|); 
    return bless {data=>$data}, $self;
}

sub query{
    my ($self,$xPathLikeString) = @_;
    my $c = Data::xPathLike->compile($xPathLikeString) or return undef;
    return $c->data($self->{data});    
}
sub DESTROY{
}


package Data::xPathLike::Data;
use Data::Dumper;

sub new{
    my ($self,$xPathLike) = @_;
    return undef unless defined $xPathLike and (defined $xPathLike->{oper} or defined $xPathLike->{paths});
    return bless {xPathLike=>$xPathLike}, $self;
}

sub data{
    my ($self,$data) = @_;
    return Data::xPathLike->_execute($data,$self->{xPathLike});
}

sub DESTROY{
}

package Data::xPathLike::Results;
use Data::Dumper;

sub new {
    my ($self,@results) = @_;
    return bless {results=>[@results]}, $self;
}

sub getrefs{
    my $self = shift;
    return @{$self->{results}};
}
sub getref{
    my $self = shift;
    return $self->{results}->[0];
}
sub getvalues{
    my $self = shift;
    return map {$$_} @{$self->{results}};
}
sub getvalue{
    my $self = shift;
    return undef unless ref $self->{results}->[0];
    return ${$self->{results}->[0]};
}

1;
__END__


=head1 NAME

Data::xPathLike - a xPath like processor for perl data-structures (hashes and arrays)! 

=head1 VERSION

Version 0.1

=head1 Why we need another one

There are already some good approaches to xPath syntax, namely the Data::dPath 
and Data::Path. 
Nevertheless we still missing some of powerfull constructions as provided by 
xPath.
Suppose, for example, we have an array of invoices with Total, Amount and Tax 
and need to check which one does not comply to the rule "Total = Amount * (1+Tax)".

For the data structure below we can easily achieve it with this code:


     use Data::xPathLike;
     use Data::Dumper;

     ($\,$,) = (qq|\n|, q|,|);
     my $data = Data::xPathLike->data([
             {invoice => {
                             Amount => 100,
                             Tax => 0.2,
                             Total => 120
                     }
             },
             {invoice => {
                             Amount => 200,
                             Tax => 0.15,
                             Total => 240
                     }       
             },
             receipt =>{ 
             }
     ]);

     print Dumper $data->query(q$
             //invoice[Total != Amount * (1 + Tax)]
     $)->getvalues();


The xPathLike uses the xPath 1.0 syntax to query any set of complex perl 
data structures, using keys or indexes for defining the path.
Examples:


     /0/invoice/Total
     /2
     /*/invoice[Total>100]/Total
     //Tax
     //Total[../Tax = .2]
     //*[count(itens/*) > 1][1]
     sum(//Total)


Like as in xPath it's also possible to query a function.


=head1 SYNOPSIS

How to use it.

     use strict;
     use Data::xPathLike;
     use Data::Dumper;

     ($\,$,) = ("\n",",");
     my $d = {
          drinks => {
               q|Alcoholic beverage| => 'not allowed',
               q|Soft drinks| => [qw|Soda Coke|]
          },
          food => { 
               fruit => [qw|bananas apples oranges pears|], 
               vegetables  => [qw|potatoes  carrots tomatoes|]
          } 
     };

     my $data = Data::xPathLike->data($d);
     my $results = $data->query(q|/*/*/0|);
     my @values = $results->getvalues();
     print @values;                         
     #Soda,bananas,potatoes

     my $ref = $results->getref();
     $$ref = 'Tonic';
     print $d->{drinks}->{q|Soft drinks|}->[0];     
     #Tonic

To get values we can invoke the getvalues ou getvalue methods to obtain a 
list/element matched. If what we need is to change the values we can use
getrefs or getref methods to obtain a reference to the matched 
data-structures. The getref(s) methods always returns a reference to 
matched data-structure. If the matched element is a scalar a reference to 
that scalar is returned. If the matched element is a reference array (or 
hash) a reference to that reference is returned, so we can change it and 
not only nested data-structures.


=head1 DESCRIPTION

It looks for complex perl data-structures which match the xPathLike expression 
and returns a list of matched data-structures.


Like xPath it is possible to deal with any logical or arithmetic 
expressions, ex: 

    *{count(a) == count(c) / 2 * (1 + count(b)) or d}

, or even 
query xPath functions ex: 

    count(//*)
    name(//*[last()])
    sum(//[*])


Additionally some extensions are implemented to deal with perl data-structures,
namely to choose between arrays and hashes.

Example:

Get all structures but only one which are arrays

     //[*]

Similarly to get all of hash structures, we can write

     //{*}

Besides that, some extra functions are also provide to check data type in
predicates, ex: 

     //*[isScalar()]


=head1 METHODS

The Data::xPathLike just provides two useful methods, compile and data. 
The first is used to compile a xPathLike expression and the second is used
to prepare data to be queried. 

=head2 Data::xPathLike methods

=head3 new()

Used only internally!!! Do nothing;

=head3 compile(xPathLikeString)

     my $query = Data::xPathLike->compile('*');                #compile the query
     
     my @values1 = $query->data({fruit => 'bananas'})->getvalues();
     # @values1 = (bananas)

     my @values2 = $query->data({
          fruit => 'bananas', 
          vegetables => 'orions'
     })->getvalues();
     # @values2 = (bananas, orions)

     my @values3 = $query->data({
          food => {fruit => 'bananas'}
     })->getvalues();
     # @values3 = ({fruit => 'bananas'})

The compile method receives a xPathLike string, compiles it and returns a Data::xPathLike::Data object.
This is the prefered method to run the same query over several data-structures.

=head3 data(dataRef)


    my $data = Data::xPathLike->data({
           food => {
                   fruit => 'bananas',
                   vegetables => 'unions'
           },
           drinks => {
                   wine => 'Porto',
                   water => 'Evian'
           }
    });


    my @values1 = $data->query('/*/*')->getvalues();
    print @values1; # Evian,Porto,bananas,unions

    my @values2 = $data->query('/*/wine')->getvalues();
    print @values2; #Porto

    #using a predicate, to get only first level entry which contains a fruit key
    my @values3 = $data->query('/*[fruit]/*')->getvalues();
    print @values3; #bananas,unions
    #using another filter to return only elements which have the value matching 
    #a /an/ pattern
    my @values4 = $data->query('/*/*[. ~ "an"]')->getvalues();
    print @values4;# Evian,bananas

    my @values5 = $data->query('//*[isScalar()]')->getvalues();
    print @values5;#Evian,Porto,bananas,unions

                  

The method data receives a hash (or array) reference and returns a Data::xPathLike::Compile object. 
This is the prefered method to run several query over same data.

=head2 Data::xPathLike::Data methods

=head3 data(data)

Executes the query over data and returns a Data::xPathLike::Results object

=head2 Data::xPathLike::Compiler methods

=head3 query(xPathLikeString)

Compile a xPathLike string, query the data and returns a Data::xPathLike::Results object

=head2 Data::xPathLike::Results methods

=head3 getrefs()
Returns a list os references for each matched data;

=head3 getref()
Returns a reference for first matched data;

=head3 getvalues()
Returns a list of values for each matched data;

=head3 getvalue()
Returns the value of first matched data;


=head1 xPath Compability

Unless some xPath functions, not yet implemented, and xPath axis preceding:: 
and following:: directions everything else is implemented. Probably buggly, 
sorry. I hope to fixe them as soon someone (?) identify them.

=head2 Supported axis 

=over 4

=item self::

=item child::

=item parent::

=item ancestor::

=item ancestor-or-self::

=item descendant::

=item descendant-or-self::

=item preceding-sibling::

=item following::sibling::

=back

=head2 Supported Functions

=over 4

=item count(path?)

=item sum(path)

=item name(path?)

=item position(path?)

=item last()

=item not(expr)

=item names(path?)*

=item values(path?)*

=item value(path?)*

=back

(*) not a xPath 1.0 function. 

names is like name but returns a list of names.

We don't support the C<text()> funcions as we don't know what that should mean 
in perl data-structures context, but the C<value()> and C<values()> functions 
are provided to return the value/values of current context if path argument is 
missing or the value/values of matched data-structures. That/those value/values 
could be scalar(s) or hash/array reference(s).



=head2 Supported operators

The xPath supported operators are the following: 

    +, -, *, div, %, =, !=, (), "", '', +, -, ., .., /, //, ::, <, <=, >, >=, [], and, or 
      and 
    | (paths union)

Addicionaly xPathLike also supports the following operators

    eq, ne, lt, le, gt, ge and ~ 

The ~ is the matching operator   

=head2 Support for data types

In xPathLike path expression, a digit step could mean a array index or a hash's key name.
ex:

    /a/0/b

may refere to a C<$d-E<gt>{a}-E<gt>[0]-E<gt>{b}> or to a C<$d-E<gt>{a}-E<gt>{0}-E<gt>{b}>. 
If a enforcement is required for select only array's index 0
the xPathLike expression should be       

    /a/[0]/b

And similarly for hash' key '0'    

    /a/{0}/b

The curly bracket could also be useful to refere to keys with spaces or any special 
character. Some examples

    /{two words as a keys}//{key with a / or a +}/*

The curly and square brackets could also be used with axis and wildcard *. Examples:

    //{*}
    //[*]
    //*/parent::[b]
    //a//parent::{*}
    //*[self::{*} = 3 or self::[*] > 10]
    /1/[*][4]/child::[*][1]/{Σ}/following-sibling::*[last()]

If a hash key is just a * the path expression is also posible using instead curly 
brackets, quotes (double or single)

    //"*"/b
    //a/'*'

Inside curly brackets, or quotes a backslash is used to escape { or } if the step 
delimited by those characters and " when used inside doubles quotes or  ' 
for single quotes delimitation,or escape itself. In any other situation is 
literaly interpreted

    //"2\""
    //'hash\'s key'
    //{\{}/
    
    //'2"'
    //"hash\'s key"
    //'{'
    
    //{\\}
    //"\\"
    //'\\'



=head1 AUTHOR

Isidro Vila Verde, C<< <jvverde at gmail.com> >>

=head1 BUGS

Send email to C<< <jvverde at gmail.com> >> with subject Data::xPathLike


=begin futuro

Please report any bugs or feature requests to C<bug-data-xPathLike at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Data-xPathLike>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=end futuro

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Data::xPathLike


=begin tmp
You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-xPathLike>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Data-xPathLike>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Data-xPathLike>

=item * Search CPAN

L<http://search.cpan.org/dist/Data-xPathLike/>

=back


=head1 ACKNOWLEDGEMENTS

=end tmp


=head1 LICENSE AND COPYRIGHT

Copyright 2013 Isidro Vila Verde.

This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:

L<http://www.perlfoundation.org/artistic_license_2_0>

Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.

If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.

This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.

This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.

Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


=cut

