#!/usr/bin/perl
use strict;
use warnings;

use Test::More;

my @tier = (
    [ qw( aa ab ) ],
    [ qw( bb bc ) ],
    [ qw( cc cd ) ],
    [ qw( dd de ) ],
    [ qw( ee ef ) ],
    [ qw( ff fg ) ],
    [ qw( gg gh ) ],
    [ qw( hh hi ) ],
    [ qw( ii ij ) ],
    [ qw( jj jk ) ],
);

my $rx = do {
    local $" = ' | ';
    my $tiers = join "\n", (
        "\\A",
        map( "(?: (?: \\A | (?<! \\A ) _ ) (?: @$_ ) \\d* )?", @tier ),
        "\\z",
    );
    qr/$tiers/x;
};

my %testcase = (
	aa_bb_cc       => 1,
	aa_bb123_cc_dd => 1,
	aa_cc          => 1,
	cc_ee123_jj    => 1,
	bb_aa          => 0,
	bb12_aa43      => 0,
	1              => 0,
	_              => 0,
	aa_            => 0,
	_ee            => 0,
	_12            => 0,
);

plan tests => keys( %testcase ) + 0;

while( my( $test, $expect_match ) = each %testcase ) {
    if( $expect_match ) {
        like( $test, $rx, "match $test" );
    }
    else {
        unlike( $test, $rx, "reject $test" );
    }
}
__END__
1..11
ok 1 - reject bb12_aa43
ok 2 - match cc_ee123_jj
ok 3 - match aa_bb123_cc_dd
ok 4 - reject bb_aa
ok 5 - reject _ee
ok 6 - match aa_cc
ok 7 - reject _
ok 8 - reject _12
ok 9 - reject aa_
ok 10 - match aa_bb_cc
ok 11 - reject 1