Como imprimo uma regex expandida em formato não expandido?

É possível imprimir um regex criado usando notação expandida ( qr/.../x) em formato não expandido? Por exemplo:

my $decimal = qr/
  (?=\d|\.\d)  # look-ahead to ensure at least one of the optional parts matches
  \d*          # optional whole digits
  (?:\.\d*)?   # optional decimal point and fractional digits
/x;

say $decimal;

Eu quero que isso seja impresso como (?=\d|\.\d)\d*(?:\.\d*)?.

Eu poderia escrever um analisador para remover as partes não funcionais, mas isso replicaria o que o perl já faz e provavelmente eu errei alguns dos casos não triviais.

(Sim, isso parece um pouco bobo. Tenho um caso de uso em que preciso imprimir muitas mensagens matched <pattern>e gostaria de limitar as mensagens a uma única linha, permitindo que a notação expandida seja usada para padrões.)

O Perl não fornece esse utilitário. Analisa padrões regex; não os gera. A stringification do objeto é a string exata fornecida ao analisador, envolvida em uma (?:...)que represente os sinalizadores. A cadeia fornecida ao analisador é o literal pós-interpolação menos os delimitadores. ^[1]

Dito isto, seria trivial fazer com um analisador de expressões regulares.

Existe o YAPE :: Regex , mas não é atualizado há muito tempo. Por exemplo, ele não suporta o (?^:...)encontrado na stringification de regex na versão moderna do Perl.

Há também Regexp :: Parser . É mais novo, mas também não suporta (?^:...)! Mas se contornássemos isso, seria perfeito, pois naturalmente ignora os espaços em branco e os comentários! Tudo o que precisamos fazer é analisar o padrão e obter uma especificação da árvore de análise.

Finalmente, há Regexp :: Parsertron . É o mais novo e suporta (?^:...), mas não distingue espaços em branco e comentários de tokens de "correspondências exatas".

Então, vamos usar Regexp :: Parser. ^[2]

#!/usr/bin/perl
use strict;
use warnings;
use feature qw( say );

use Regexp::Parser qw( );

{
   @ARGV == 1
      or die("usage\n");

   my $re = $ARGV[0];

   # R::P doesn't support «(?^:...)», so we'll
   # provide a backwards-compatible stringification.
   $re =~ s{^\(\?\^(\w*):}{
      my %on = map { $_ => 1 } split //, $1;
      my $on  = join "", grep  $on{$_}, qw( i m s x );
      my $off = join "", grep !$on{$_}, qw( i m s x );
      "(?$on-$off:"
   }e;

   my $parser = Regexp::Parser->new($re);
   my $roots = $parser->root
      or die($parser->errmsg);

   say join "", map $_->visual, @$roots;
}

Teste:

$ despace_re '(?^x:
   (?=\d|\.\d)  # look-ahead to ensure at least one of the optional parts matches
   \d*          # optional whole digits
   (?:\.\d*)?   # optional decimal point and fractional digits
)'
(?x-ims:(?=\d|\.\d)\d*(?:\.\d*)?)

1. \Q, \ue similares são feitos no mesmo estágio na interpolação. \N{...}é resolvido para \N{U+...}imortalizar as configurações atuais dos nomes de chars. Outros escapes, tais como \x27, \x{0000027}, \\e \/são preservados personagem para personagem.

2. Uma solução baseada em YAPE :: Regex foi usada em uma revisão anterior desta resposta.