package Tree::Transform::XSLTish::Optimizer;
use strict;
use warnings;
use Tree::XPathEngine;
use Scalar::Util qw(blessed looks_like_number reftype);
my $NCName = qr{(?: [A-Za-z_] [\w\\.\\-]* )}x;
my $QName = qr{(?: $NCName : )? $NCName}x;
sub optimize_single_step {
my ($path) = @_;
my $s=$path->as_string;
warn "single: $s\n";
if ($s =~ m{\A \( child:: ($QName) \) \z}x) {
return "self::$1",0,0,'any';
}
if ($s =~ m{\A \( /descendant:: ($QName) (?: /self::node\(\) )? \) \z}x) {
return "self::$1",0,0,'any';
}
return;
}
sub optimize_simple_path {
my ($path) = @_;
my $s=$path->as_string;
$s =~ s{/self::node\(\)/}{/}g;
warn "simple: $s\n";
return unless $s =~ m{\A \(
(?: (?:child|/descendant) :: $QName )
(?: / (?:child|descendant) :: $QName )+
\) \z}x;
$s =~ s{/self::node\(\)/}{/}g;
my @steps= reverse grep {$_} split '/',substr($s,1,-1);
my @new=();
while (my $step = shift @steps) {
if ($step =~ m{^child::($QName)$}) {
if (@new) {
push @new,"parent::$1";
}
else {
push @new,"self::$1";
}
}
elsif ($step =~ m{^descendant::($QName)$}) {
if (@steps) {
push @new,"ancestor::$1";
}
else {
push @new,"parent::$1";
}
}
}
return unless @new;
return join('/',@new),0,0,'any';
}
my @rules = (
\&optimize_single_step,
\&optimize_simple_path,
);
my @flds=qw(opt_pattern min_depth max_depth expected_result);
sub optimize {
my ($class,$rule) = @_;
return unless $rule->{match};
my $path = Tree::XPathEngine->new(NAME=>$QName)->_parse($rule->{match});
for my $opt (@rules) {
if (my @ret=$opt->($path)) {
@{$rule}{@flds}=@ret;
return;
}
}
return;
}
1;