#!/usr/bin/perl
use strict;

use Data::Dumper();

=pod

{
	bar => {
		next => {
			foo => {
				data => 'teo'
			},
			baz => {
				data => 'ioh'
			}
		},
		data => 'duo'
	},
	wee => {
		data => 'iwy'
	}
}

=cut

my $tree = {};

foreach my $selector(
    { path => [qw( foo bar )], data => 'teo' },
    { path => [qw( {x:.*} zoo bar )], data => 'view/{x}'},
    { path => [qw( foo >zoo >bar )], data => 'ilo' },
    { path => [qw( bar )], data => 'duo' },
    { path => [qw( wee )], data => 'iwy'},
    { path => [qw( foo wee )], data => 'fwy'},
    { path => [qw( {x:\w+} )], data => 'x:{x}'},
    { path => [qw( boo {x:\w+} )], data => 'boo/{x}'},
) {
	my $t = $tree;
	my @path = reverse @{$selector->{path}};
	my $last = pop @path;
	my $level = 1;
	foreach my $prim (@path ) {
        $t = ($t->{$prim}->{next} ||= {});
        $level ++;
	}
	$t->{$last}->{level} = $level;
	$t->{$last}->{data} = $selector->{data};
}

my @target = qw( foo zoo bar );
my @results;
my $alternatives = [ { selector => $tree, immediate => 1 } ];

$alternatives = MatchAlternatives($_,$alternatives,\@results) foreach reverse @target;


sub MatchAlternatives {
	my ($segment,$alternatives,$results) = @_;
	
	warn "alternatives: ", scalar @$alternatives,", segment: $segment";
	
	my @next;
	
	foreach my $alt (@$alternatives) {
		while (my ($selector,$match) = each %{$alt->{selector}} ) {
			warn $selector;
			
			warn "\timmediate" if $alt->{immediate};
			warn "\thas children" if $match->{next};
			
			my $context = {
				vars => \%{ $alt->{vars} || {} },
				selector => $match->{next}
			};
			
			if ($selector =~ s/^>//) {
                $context->{immediate} = 1;
			}
                
            if (my ($name,$rx) = ($selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/) ) {
            	#this is a regexp
            	warn "\tregexp: [$name] $rx";
            	
            	if ( my @captures = ($segment =~ m/($rx)/) ) {
                    $context->{success} = 1;
                    
                    warn "\t",join(',',@captures);
                    
	            	if ($name) {
                        $context->{vars}->{$name} = \@captures;
	            	}
            	}
            } else {
            	#this is a segment name
            	if ($segment eq $selector) {
            		$context->{success} = 1;
            	}
            }
            
            # test if there were a match
            if (delete $context->{success}) {
            	warn "\tmatch";
            	if (my $data = $match->{data}) {
            		# interpolate data
            		$data =~ s/{(\w+)(?:\:(\d+))?}/
                        my ($name,$index) = ($1,$2 || 0);
                        
                        if ($context->{vars}{$name}) {
                        	$context->{vars}{$name}[$index];
                        } else {
                        	"";
                        }
                    /gex;
                    
                    push @$results, { level => $match->{level}, result => $data };
            	}
            	warn "\tnext" if $context->{selector};
            	push @next, $context if $context->{selector};
            } else {
                #repeat current alternative if it's not required to be immediate
                push @next, {
                	selector => { $selector, $match },
                	vars => $alt->{vars}
                } unless $alt->{immediate};
            }
		}
	}
	
	warn "end, next trip: ",scalar @next, " alternatives";
	
	return \@next;
}

print Data::Dumper->Dump([$tree,\@results],[qw(tree results)]);