Perl 5.10 introduce la posibilidad de definir subpatrones en una sección del patrón. Citando la versión del documento perlretut para perl5.10:
This feature (introduced in Perl 5.10) significantly extends the power
of Perl’s pattern matching. By referring to some other capture group
anywhere in the
pattern with the construct (?group-ref), the pattern within the
referenced group is used as an independent subpattern in place of the
group reference itself.
Because the group reference may be contained within the group it refers
to, it is now possible to apply pattern matching to tasks that hitherto
required a
recursive parser.
...
In(?...)both absolute and relative backreferences may be used. The entire pattern can be reinserted with(?R)or(?0). If you prefer to name your buffers, you can use(?&name)to recurse into that buffer.
Véase un ejemplo que reconoce los palabra-palíndromos (esto es, la lectura directa y la inversa de la cadena pueden diferir en los signos de puntuación):
casiano@millo:~/Lperltesting$ cat -n palindromos.pl 1 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w 2 use v5.10; 3 4 my $regexp = qr/^(\W* 5 (?: 6 (\w) (?1) \g{-1} # palindromo estricto 7 | 8 \w? # no recursiva 9 ) 10 \W*)$/ix; 11 12 my $input = <>; 13 chomp($input); 14 if ($input =~ $regexp) { 15 say "$input is a palindrome"; 16 } 17 else { 18 say "does not match"; 19 }
i
en la regexp qr/^(\W* (?: (\w) (?1) \g{-1} | \w? ) \W*)$/ix?Siguen algunos ejemplos de ejecución3.5
pl@nereida:~/Lperltesting$ ./palindromos.pl A man, a plan, a canal: Panama! A man, a plan, a canal: Panama! is a palindrome pl@nereida:~/Lperltesting$ ./palindromos.pl A man, a plan, a cam, a yak, a yam, a canal – Panama! A man, a plan, a cam, a yak, a yam, a canal – Panama! is a palindrome pl@nereida:~/Lperltesting$ ./palindromos.pl A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal – Panama! A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal – Panama! is a palindrome pl@nereida:~/Lperltesting$ ./palindromos.pl saippuakauppias saippuakauppias is a palindrome pl@nereida:~/Lperltesting$ ./palindromos.pl dfghjgfd does not match pl@nereida:~/Lperltesting$ ./palindromos.pl ...,;;;; ...,;;;; is a palindrome
(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)
Similar to (??{ code }) (véase la sección
3.2.9)
except it does not involve compiling any code,
instead it treats the contents of a capture buffer as an independent
pattern that must match at the current position. Capture buffers
contained by the pattern will have the value as determined by the
outermost recursion.
PARNO is a sequence of digits (not starting with 0) whose value
reflects the paren-number of the capture buffer to recurse to.
(?R)recurses to the beginning of the whole pattern.(?0)is an alternate syntax for(?R).
If PARNO is preceded by a plus or minus sign then it
is assumed to be relative, with negative numbers indicating preceding
capture buffers and positive ones following. Thus (?-1) refers to the
most recently declared buffer, and (?+1) indicates the next buffer to
be declared.
Note that the counting for relative recursion differs from that of relative backreferences, in that with recursion unclosed buffers are included.Hay una diferencia fundamental entre
\g{-1} y (?-1).
El primero significa lo que casó con el último paréntesis.
El segundo significa que se debe llamar a la expresión regular
que define el último paréntesis. Véase un ejemplo:
pl@nereida:~/Lperltesting$ perl5.10.1 -wdE 0 main::(-e:1): 0 DB<1> x ($a = "12 aAbB 34") =~ s/([aA])(?-1)(?+1)([bB])/-\1\2-/g 0 1 DB<2> p $a 12 -aB- 34
En perlre también se comenta sobre este punto:
If there is no corresponding capture buffer defined, then it is a fatal error. Recursing deeper than 50 times without consuming any input string will also result in a fatal error. The maximum depth is compiled into perl, so changing it requires a custom build.
El siguiente programa (inspirado en uno
que aparece en perlre)
reconoce una llamada a una función foo()
que puede contener una secuencia de expresiones con paréntesis equilibrados
como argumento:
1 pl@nereida:~/Lperltesting$ cat perlrebalancedpar.pl 2 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w 3 use v5.10; 4 use strict; 5 6 my $regexp = qr{ ( # paren group 1 (full function) 7 foo 8 ( # paren group 2 (parens) 9 \( 10 ( # paren group 3 (contents of parens) 11 (?: 12 [^()]+ # Non-parens 13 | 14 (?2) # Recurse to start of paren group 2 15 )* 16 ) # 3 17 \) 18 ) # 2 19 ) # 1 20 }x; 21 22 my $input = <>; 23 chomp($input); 24 my @res = ($input =~ /$regexp/); 25 if (@res) { 26 say "<$&> is balanced\nParen: (@res)"; 27 } 28 else { 29 say "does not match"; 30 }Al ejecutar obtenemos:
pl@nereida:~/Lperltesting$ ./perlrebalancedpar.pl foo(bar(baz)+baz(bop)) <foo(bar(baz)+baz(bop))> is balanced Paren: (foo(bar(baz)+baz(bop)) (bar(baz)+baz(bop)) bar(baz)+baz(bop))
Como se comenta en perlre es conveniente usar índices relativos si se quiere tener una expresión regular reciclable:
The following shows how using negative indexing can make it easier to
embed recursive patterns inside of a qr// construct for later use:
1. my $parens = qr/(\((?:[^()]++|(?-1))*+\))/;
2. if (/foo $parens \s+ + \s+ bar $parens/x) {
3. # do something here...
4. }
Véase la sección
3.2.6
para comprender el uso de los operadores posesivos como ++.
El siguiente programa presenta una heurística para determinar los bloques de un programa:
1 pl@nereida:~/Lperltesting$ cat blocks.pl 2 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w 3 use v5.10; 4 use strict; 5 #use re 'debug'; 6 7 my $rb = qr{(?x) 8 ( 9 \{ # llave abrir 10 (?: 11 [^{}]++ # no llaves 12 | 13 [^{}]*+ # no llaves 14 (?1) # recursivo 15 [^{}]*+ # no llaves 16 )*+ 17 \} # llave cerrar 18 ) 19 }; 20 21 local $/ = undef; 22 my $input = <>; 23 my@blocks = $input =~ m{$rb}g; 24 my $i = 0; 25 say($i++.":\n$_\n===") for @blocks;
Veamos una ejecución. Le daremos como entrada el siguiente programa: Al ejecutar el programa con esta entrada obtenemos:
pl@nereida:~/Lperltesting$ cat -n blocks.c
1 main() { /* 1 */
2 { /* 2 */ }
3 { /* 3 */ }
4 }
5
6 f(){ /* 4 */
7 { /* 5 */
8 { /* 6 */ }
9 }
10 { /* 7 */
11 { /* 8 */ }
12 }
13 }
14
15 g(){ /* 9 */
16 }
17
18 h() {
19 {{{}}}
20 }
21 /* end h */
|
pl@nereida:~/Lperltesting$ perl5.10.1 blocks.pl blocks.c
0:
{ /* 1 */
{ /* 2 */ }
{ /* 3 */ }
}
===
1:
{ /* 4 */
{ /* 5 */
{ /* 6 */ }
}
{ /* 7 */
{ /* 8 */ }
}
}
===
2:
{ /* 9 */
}
===
3:
{
{{{}}}
}
===
|
La posibilidad de combinar en las expresiones regulares Perl 5.10
la recursividad con los constructos (?<name>...)
y ?&name) así como las secciones (?(DEFINE) ...)
permiten la escritura de expresiones regulares que reconocen lenguajes recursivos.
El siguiente
ejemplo muestra un reconocedor de un subconjunto del lenguaje
LATEX (véase la entrada LaTeX en la wikipedia):
1 pl@nereida:~/Lperltesting$ cat latex5_10.pl 2 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w 3 use strict; 4 use v5.10; 5 6 my $regexp = qr{ 7 \A(?&File)\z 8 9 (?(DEFINE) 10 (?<File> (?&Element)*+\s* 11 ) 12 13 (?<Element> \s* (?&Command) 14 | \s* (?&Literal) 15 ) 16 17 (?<Command> \\ \s* (?<L>(?&Literal)) \s* (?<Op>(?&Options)?) \s* (?<A>(?&Args)) 18 (?{ 19 say "command: <$+{L}> options: <$+{Op}> args: <$+{A}>" 20 }) 21 ) 22 23 (?<Options> \[ \s* (?:(?&Option) (?:\s*,\s* (?&Option) )*)? \s* \] 24 ) 25 26 (?<Args> (?: \{ \s* (?&Element)* \s* \} )* 27 ) 28 29 (?<Option> \s* [^][$&%#_{}~^\s,]+ 30 ) 31 32 (?<Literal> \s* ([^][$&%#_{}~^\s]+) 33 ) 34 ) 35 }xms; 36 37 my $input = do{ local $/; <>}; 38 if ($input =~ $regexp) { 39 say "$@: matches:\n$&"; 40 } 41 else { 42 say "does not match"; 43 }
Añadimos una acción semántica al final de la aceptación de un <Command>.
(?<Command> \\ \s* (?<L>(?&Literal)) \s* (?<Op>(?&Options)?) \s* (?<A>(?&Args)?)
(?{
say "command: <$+{L}> options: <$+{Op}> args: <$+{A}>"
})
)
Esta acción es ejecutada pero no afecta al proceso de análisis.
(véase la sección
3.2.8 para mas información sobre las acciones semánticas
en medio de una regexp).
La acción se limita a mostrar que ha casado con cada una de las tres componentes:
el comando, las opciones y los argumentos.
Los paréntesis adicionales, como en (?<L>(?&Literal)) son necesarios
para guardar lo que casó.
Cuando se ejecuta produce la siguiente salida3.6:
pl@nereida:~/Lperltesting$ cat prueba.tex
\documentclass[a4paper,11pt]{article}
\usepackage{latexsym}
\author{D. Conway}
\title{Parsing \LaTeX{}}
\begin{document}
\maketitle
\tableofcontents
\section{Description}
...is easy \footnote{But not\\ \emph{necessarily} simple}.
In fact it's easy peasy to do.
\end{document}
pl@nereida:~/Lperltesting$ ./latex5_10.pl prueba.tex
command: <documentclass> options: <[a4paper,11pt]> args: <{article}>
command: <usepackage> options: <> args: <{latexsym}>
command: <author> options: <> args: <{D. Conway}>
command: <LaTeX> options: <> args: <{}>
command: <title> options: <> args: <{Parsing \LaTeX{}}>
command: <begin> options: <> args: <{document}>
command: <maketitle> options: <> args: <>
command: <tableofcontents> options: <> args: <>
command: <section> options: <> args: <{Description}>
command: <emph> options: <> args: <{necessarily}>
command: <footnote> options: <> args: <{But not\\ \emph{necessarily} simple}>
command: <end> options: <> args: <{document}>
: matches:
\documentclass[a4paper,11pt]{article}
\usepackage{latexsym}
\author{D. Conway}
\title{Parsing \LaTeX{}}
\begin{document}
\maketitle
\tableofcontents
\section{Description}
...is easy \footnote{But not\\ \emph{necessarily} simple}.
In fact it's easy peasy to do.
\end{document}
La siguiente entrada prueba3.tex no pertenece
al lenguaje definido por el patrón regular,
debido a la presencia de la cadena $In$
en la última línea:
pl@nereida:~/Lperltesting$ cat prueba3.tex
\documentclass[a4paper,11pt]{article}
\usepackage{latexsym}
\author{D. Conway}
\title{Parsing \LaTeX{}}
\begin{document}
\maketitle
\tableofcontents
\section{Description}
\comm{a}{b}
...is easy \footnote{But not\\ \emph{necessarily} simple}.
$In$ fact it's easy peasy to do.
\end{document}
pl@nereida:~/Lperltesting$ ./latex5_10.pl prueba3.tex
command: <documentclass> options: <[a4paper,11pt]> args: <{article}>
command: <usepackage> options: <> args: <{latexsym}>
command: <author> options: <> args: <{D. Conway}>
command: <LaTeX> options: <> args: <{}>
command: <title> options: <> args: <{Parsing \LaTeX{}}>
command: <begin> options: <> args: <{document}>
command: <maketitle> options: <> args: <>
command: <tableofcontents> options: <> args: <>
command: <section> options: <> args: <{Description}>
command: <comm> options: <> args: <{a}{b}>
command: <emph> options: <> args: <{necessarily}>
command: <footnote> options: <> args: <{But not\\ \emph{necessarily} simple}>
does not match
10 (?<File> (?&Element)*+\s* 11 )¿Que ocurrre si se quita el posesivo y se vuelve a ejecutar
$ ./latex5_10.pl prueba3.tex?
Véase el nodo Complex regex for maths formulas en perlmonks para la formulación del problema. Un monje pregunta:
Hiya monks,
Im having trouble getting my head around a regular expression to match sequences. I need to catch all exceptions where a mathematical expression is illegal...
There must be either a letter or a digit either side of an operator
parenthesis must open and close next to letters or digits, not next to operators, and do not have to exist
variables must not be more than one letter
Nothing other than a-z,A-Z,0-9,+,-,*,/,(,) can be used
Can anyone offer a hand on how best to tackle this problem?
many thanks
La solución parte de que una expresión es o bien un término o bien un término seguido de una operador y un término, esto es:
termino
termino op termino op termino ...
termino (op termino)*.
Un término es un número o un identificador o una expresión entre paréntesis, esto es:
numero
identificador
( expresión )
La siguiente expresión regular recursiva sigue esta idea:
pl@nereida:~/Lperltesting$ cat -n simpleexpressionsna.pl 1 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 2 use v5.10; 3 use strict; 4 use warnings; 5 6 local our ($skip, $term, $expr); 7 $skip = qr/\s*/; 8 $expr = qr{ (?<EXPR> 9 (?<TERM> # An expression is a TERM ... 10 $skip (?<ID>[a-zA-Z]+) 11 | $skip (?<INT>[1-9]\d*) 12 | $skip \( 13 $skip (?&EXPR) 14 $skip \) 15 ) (?: $skip # possibly followed by a sequence of ... 16 (?<OP>[-+*/]) 17 (?&TERM) # ... operand TERM pairs 18 )* 19 ) 20 }x; 21 my $re = qr/^ $expr $skip \z/x; 22 sub is_valid { shift =~ /$re/o } 23 24 my @test = ( '(a + 3)', '(3 * 4)+(b + x)', '(5 - a)*z', 25 '((5 - a))*((((z)))+2)', '3 + 2', '!3 + 2', '3 + 2!', 26 '3 a', '3 3', '3 * * 3', 27 '2 - 3 * 4', '2 - 3 + 4', 28 ); 29 foreach (@test) { 30 say("$_:"); 31 say(is_valid($_) ? "\n<$_> is valid" : "\n<$_> is not valid") 32 }Podemos usar acciones semánticas empotradas para ver la forma en la que trabaja la expresión regular (véase la sección 3.2.8):
pl@nereida:~/Lperltesting$ cat -n simpleexpressions.pl 1 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 2 use v5.10; 3 use strict; 4 use warnings; 5 6 use re 'eval'; # to allow Eval-group at runtime 7 8 local our ($skip, $term, $expr); 9 $skip = qr/\s*/; 10 $expr = qr{ (?<EXPR> 11 (?<TERM> # An expression is a TERM ... 12 $skip (?<ID>[a-zA-Z]+) (?{ print "[ID $+{ID}] " }) 13 | $skip (?<INT>[1-9]\d*) (?{ print "[INT $+{INT}] " }) 14 | $skip \( (?{ print "[(] " }) 15 $skip (?&EXPR) 16 $skip \) (?{ print "[)] " }) 17 ) (?: $skip # possibly followed by a sequence of ... 18 (?<OP>[-+*/]) (?{ print "[OP $+{OP}] " }) 19 (?&TERM) # ... operand TERM pairs 20 )* 21 ) 22 }x; 23 my $re = qr/^ $expr $skip \z/x; 24 sub is_valid { shift =~ /$re/o } 25 26 my @test = ( '(a + 3)', '(3 * 4)+(b + x)', '(5 - a)*z', 27 '((5 - a))*((((z)))+2)', '3 + 2', '!3 + 2', '3 + 2!', 28 '3 a', '3 3', '3 * * 3', 29 '2 - 3 * 4', '2 - 3 + 4', 30 ); 31 foreach (@test) { 32 say("$_:"); 33 say(is_valid($_) ? "\n<$_> is valid" : "\n<$_> is not valid") 34 }
Ejecución:
pl@nereida:~/Lperltesting$ ./simpleexpressions.pl (a + 3): [(] [ID a] [OP +] [INT 3] [)] <(a + 3)> is valid (3 * 4)+(b + x): [(] [INT 3] [OP *] [INT 4] [)] [OP +] [(] [ID b] [OP +] [ID x] [)] <(3 * 4)+(b + x)> is valid (5 - a)*z: [(] [INT 5] [OP -] [ID a] [)] [OP *] [ID z] <(5 - a)*z> is valid ((5 - a))*((((z)))+2): [(] [(] [INT 5] [OP -] [ID a] [)] [)] [OP *] [(] [(] [(] [(] [ID z] [)] [)] [)] [OP +] [INT 2] [)] <((5 - a))*((((z)))+2)> is valid 3 + 2: [INT 3] [OP +] [INT 2] <3 + 2> is valid !3 + 2: <!3 + 2> is not valid 3 + 2!: [INT 3] [OP +] [INT 2] <3 + 2!> is not valid 3 a: [INT 3] <3 a> is not valid 3 3: [INT 3] <3 3> is not valid 3 * * 3: [INT 3] [OP *] <3 * * 3> is not valid 2 - 3 * 4: [INT 2] [OP -] [INT 3] [OP *] [INT 4] <2 - 3 * 4> is valid 2 - 3 + 4: [INT 2] [OP -] [INT 3] [OP +] [INT 4] <2 - 3 + 4> is valid