diff _test/temp.pl @ 209:a8db61d0ed33

IMPL::Class::Meta refactoring
author cin
date Mon, 28 May 2012 19:58:56 +0400
parents 68a59c3358ff
children 6adaeb86945d
line wrap: on
line diff
--- a/_test/temp.pl	Fri May 18 18:43:00 2012 +0400
+++ b/_test/temp.pl	Mon May 28 19:58:56 2012 +0400
@@ -1,135 +1,1 @@
-#!/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)]);
\ No newline at end of file
+print "asd::asd" =~ /^[a-zA-Z]+(?:::[a-zA-Z]+)*$/;
\ No newline at end of file