my @sets;
for (@list) {
    my $str = $_;
    for (0..(length-1)) {
        $sets[$_] .= substr $str, $_, 1;
    }
}
my $re = qr/^${\join '', map {"[$_]"} @sets}$/;