Desafio regex

Meu amigo Rogério Zamboim me desafiou a resolver um problema com uma expressão regular. Desconfio que isso estava lhe causando insônia e ele queria transferi-la pra alguém... De qualquer modo, o desafio acabou sendo bem interessante.

O problema é validar um campo cujo conteúdo deve ser uma seqüência de dígitos, de 1 a 8, separados por barras invertidas, em ordem monotônica decrescente. Exemplificando, os seguintes valores são válidos para o campo:

8\7\6\5\4\3\2\1
8
8\1
8\7\2
1
2\1
7\5\3

Já os seguintes valores são inválidos:

8\
\7
8\6\
\2\1
6\\2
7\6\6\2
6\2\5

Confesso que de cara dei um tiro n'água e enviei-lhe a seguinte "solução", obviamente errada:

   /^[1-8](?:\\[1-7])?(?:\\[1-6])?(?:\\[1-5])?(?:\\[1-4])?(?:\\[1-3])?(?:\\[1-2])?(?:\\1)?$/

O problema é que ela não garante que os dígitos são decrescentes. Por exemplo, a string "4\5" é aceita por ela.

Pensando melhor, ficou claro que expressões regulares "puras" não têm poder de expressão suficiente pra especificar a regra de validação de modo conciso. Isso porque elas não conseguem expressar a ordenação dos dígitos. Não se trata de um impossibilidade teórica, mas prática. Uma solução puramente regular envolveria a descrição explícita de todas as possibilidades, resultando numa expressão enorme. Algo como:

   /^(?:[1-8]|[2-8]\\1|[3-8]\\2|...|[3-8]\\2\\1|[4-8]\\3\\1|.../

Convencido de que não seria possível uma solução direta, resolvi usar uma expressão regular apenas para garantir a forma básica, i.e., uma seqüência de dígitos separados por barras invertidas, e deixar a verificação da ordem para um código posterior. O melhor que consegui foi o seguinte:

   sub validate_loop {
       my ($string) = @_;
       my $top = 9;
       for my $val (split /\\/, $string) {
           return 0 unless $val =~ /^[1-8]$/;
           return 0 unless $top > $val;
           $top = $val;
       }
       return 1;
   }

Esta função recebe uma string com o valor do campo. A variável $top contém sempre o valor máximo que o próximo dígito pode conter mais um, e começa com 9, já que o primeiro dígito pode estar entre 1 e 8. O loop quebra a string nas barras invertidas e verifica se o que há entre elas são dígitos entre 1 e 8 e se eles são menores que $top, atribuindo a $top o valor do próximo dígito.

É razoável, mas não satisfatório. Usa duas expressões regulares e faz muitos testes separados... Não estava muito bom.

Fiquei matutando uns dois dias sobre isso e pensando se dentre as várias extensões que Perl oferece além dos operadores básicos de expressões regulares não haveria algum que me permitisse construir uma solução mais sucinta. Relendo a documentação deparei-me com o operador "(?{code})", que permite inserir código no meio de uma expressão regular. Hmmm... parecia útil, mas eu nunca havia usado algo assim.

Depois de algumas tentativas frustradas acabei bolando a seguinte solução:

   sub validate_re {
       my ($string) = @_;
       our ($dec, $last) = (1);
       return ($string =~ /^([1-8])(?{$last=$^N})(?:\\([1-8])(?{$dec=0 if $last <= $^N; $last=$^N}))*$/) && $dec;
   }

A expressão regular ficou maior por causa do código embutido dentro dela. Remova mentalmente os operadores (?{...}) e você verá que ela está simplesmente verificando se a string consiste em uma seqüência de dígitos separados por barras invertidas.

No primeiro operador de código, a variável $last recebe o valor do primeiro dígito da string. (A variável implícita $^N lembra o valor da última captura por parêntesis.) No segundo operador, usamos seu valor para verificar se o próximo dígito é menor que o anterior e atribuímos o novo dígito a ela.

A variável $dec mantém o estado da verificação de ordem. Ela começa como 1 e recebe 0 caso o segundo operador de código detecte que há algum dígito fora de ordem monotônica decrescente.

Eu demorei um bom tempo pra chegar à conclusão de que essas duas variáveis tinham que ser globais (declaradas com "our"). Se elas são locais (declaradas com "my") não funciona. A documentação não é clara a esse respeito e eu desconfio que seja um bug do próprio interpretador Perl, mas não tenho certeza.

A função acaba retornando a conjunção da avaliação da expressão regular com o valor final de $dec.

Pronto, agora eu posso dormir em paz.

(Não é verdade... a (des)formatação dos scripts acima está me deixando nervoso. Vou tentar resolver a questão usando o SyntaxHighlighter, mas não hoje.)

---

Passei a usar o SyntaxHighlighter, mas como ele ainda não tem suporte oficial pra Perl não ficou ainda muito bonito. Tem gente trabalhando nisso...