Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Ajustar expresiones regulares en script

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.
Publicar una respuesta

Ajustar expresiones regulares en script

Notapor pablgonz » 2019-08-15 19:50 @868

Hola a todos. Hace bastante que no pasaba por el foro. Estoy actualizando un viejo script y no logro dar con las modificaciones necesarias dentro de las expresiones regulares para que funcione. El código que poseo es el siguiente (es solo una parte del script completo):
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/env perl
  2. use v5.28;
  3. use autodie;                        # muere si ocurre un error
  4. use File::Basename;                 # separa el archivo de entrada
  5.  
  6. ## Argumentos ---------------------------------------------------------
  7. @ARGV == 1  or die "Uso: $0 <archivo TeX a procesar>\n";
  8. my $nombre_archivo = shift;
  9. -f $nombre_archivo or die "ERROR: No encuentro [$nombre_archivo]\n";
  10.  
  11. ## Arreglo de la extensión --------------------------------------------
  12. my @SuffixList = ('.tex', '', '.ltx');          # extensión
  13. my ($name, $path, $ext) = fileparse($nombre_archivo, @SuffixList);
  14. $ext = '.tex' if not $ext;                      # fijamos la extensión
  15.  
  16. ## Abrimos el archivo de entrada a modificar --------------------------
  17. open my $ENTRADA, '<', $nombre_archivo;
  18. my $archivo;
  19.  {
  20.     local $/;
  21.     $archivo = <$ENTRADA>;
  22.  }
  23. close   $ENTRADA;
  24.  
  25. ## Cambios a realizar
  26. my %cambios = (
  27.     '\pspicture'                => '\TRICKS',
  28.     '\endpspicture'             => '\ENDTRICKS',
  29.     '\begin{MYexample'          => '\begin{MYEXAMPLE',
  30.     '\end{MYexample'            => '\end{MYEXAMPLE',
  31.     '\begin{pspicture'          => '\begin{TRICKS',
  32.     '\end{pspicture'            => '\end{TRICKS',
  33.     '\begin{postscript}'        => '\begin{POSTRICKS}',
  34.     '\end{postscript}'          => '\end{POSTRICKS}',
  35. );
  36.  
  37.  
  38. ## Variables y constantes
  39. my $no_del = "\0";
  40. my $del    = $no_del;
  41.  
  42. ## Reglas
  43. my $llaves      = qr/\{ .+? \}                                                               /x;
  44. my $corchetes   = qr/\[ .+? \]                                                               /x;
  45. my $no_corchete = qr/(?: $corchetes )?                                                       /x;
  46. my $delimitador = qr/\{ (?<del>.+?) \}                                                       /x;
  47. my $scontents   = qr/Scontents [*]? $no_corchete                                             /ix;
  48. my $verb        = qr/verb [*]?                                                               /ix;
  49. my $lst         = qr/lstinline (?!\*) $no_corchete                                           /ix;
  50. my $mint        = qr/mint (?!\*) $no_corchete $llaves                                        /ix;
  51. my $marca       = qr/\\ (?:$verb | $scontents | $lst | $mint) (\S) .+? \g{-1}                /x;
  52. my $comentario  = qr/^ \s* \%+ .+? $                                                         /mx;
  53. my $definedel   = qr/\\ (?:   DefineShortVerb | lstMakeShortInline  ) $no_corchete $delimitador /ix;
  54. my $indefinedel = qr/\\ (?: UndefineShortVerb | lstDeleteShortInline) $llaves                   /ix;
  55.  
  56. ## Cambiar en comentarios y comandos delimitados <del> contenido <del>    
  57. while ($archivo =~
  58.     / $marca
  59.     | $comentario
  60.     | $definedel
  61.     | $indefinedel
  62.     | $del .+? $del
  63.     /pgmx) {
  64.  
  65.     my($pos_inicial, $pos_final) = ($-[0], $+[0]);      # posiciones
  66.     my $encontrado = ${^MATCH};                         # lo encontrado
  67.  
  68.     if ($encontrado =~ /$definedel/) {                  # definimos delimitador
  69.     $del = $+{del};
  70.     $del = "\Q$+{del}" if substr($del,0,1) ne '\\';     # es necesario "escapar" el delimitador
  71.     }
  72.     elsif ($encontrado =~ /$indefinedel/) {             # indefinimos delimitador
  73.     $del = $no_del;                
  74.     }
  75.     else {                                              # aquí se hacen los cambios
  76.     while (my($busco, $cambio) = each %cambios) {
  77.         $encontrado =~ s/\Q$busco\E/$cambio/g;          # es necesario escapar $busco
  78.     }
  79.  
  80.     substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;    # insertamos los nuevos cambios
  81.  
  82.     pos($archivo) = $pos_inicial + length $encontrado;  # re posicionamos la siguiente búsqueda
  83.     }
  84. }
  85.  
  86. ## Comandos que utilizan llaves { balanceadas }  
  87. my $tcbxverb    = qr/\\ (?: tcboxverb | myverb | \Scontents [*]?) $no_corchete /ix;
  88. my $mintverb    = qr/\\ (?:mint(?:inline)?) $no_corchete $llaves               /ix;
  89. my $anidado     = qr/(\{(?:[^\{\}]++|(?R))*\})                                 /x;
  90. my $tcbxbrace   = qr/$tcbxverb $anidado                                        /x;
  91. my $mintbrace   = qr/$mintverb $anidado                                        /x;
  92.  
  93. ## Cambiar en comandos que utilizan llaves { contenido }  balanceadas
  94. while ($archivo =~ /$tcbxbrace|$mintbrace/pgmx) {
  95.  
  96.     my($pos_inicial, $pos_final) = ($-[0], $+[0]);               # posiciones
  97.     my $encontrado = ${^MATCH};                                  # lo encontrado
  98.  
  99.     while (my($busco, $cambio) = each %cambios) {
  100.                    $encontrado =~ s/\Q$busco\E/$cambio/g;        # es necesario escapar $busco
  101.                     }
  102.     substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;    # insertamos los nuevos cambios
  103.  
  104.     pos($archivo)= $pos_inicial + length $encontrado;            # re posicionamos la siguiente búsqueda
  105. }
  106.  
  107. ## Divido el archivo por líneas
  108. my @lineas = split /\n/, $archivo;
  109.  
  110. my $ENTORNO  = qr/(?: verbatim\*? | LTXexample | tcblisting | mybox | comment )/xi;
  111.  
  112. my $DEL;
  113.  
  114. ## Cambiar dentro de entornos verbatim
  115. for (@lineas) {
  116.     if (/^\\begin\{($ENTORNO)(?{ $DEL = "\Q$^N" })\}/ .. /^\\end\{$DEL\}/) {
  117.         while (my($busco, $cambio) = each %cambios) {
  118.             s/\Q$busco\E/$cambio/g;
  119.         }
  120.     }
  121. }
  122.  
  123.  
  124. ## Escritura del resultado
  125. open my $SALIDA, '>', "$name-out$ext";
  126. print   $SALIDA join("\n", @lineas);
  127. close   $SALIDA;
  128.  
  129. __END__
  130.  
Coloreado en 0.005 segundos, usando GeSHi 1.0.8.4

Básicamente se encarga de cambiar los nombres de ciertos comandos `LaTeX` dentro de un archivo para luego procesarlo. Hasta ahí todo bien. El tema es que ahora deseo agregar una nueva regla para que capture y cambie las palabras dentro del comando `\Scontents`, que funciona de la siguiente forma:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
\Scontents[corchete opcional]{ texto entre llaves donde deseo hacer los cambios }
\Scontents*[corchete opcional]{ texto entre llaves donde deseo hacer los cambios }
\Scontents*[corchete opcional]⟨delimitador⟩ texto delimitado donde deseo hacer los cambios ⟨delimitador⟩
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Si `\Scontents` está escrito en una sola línea funciona perfecto, pero si lo escribo en más de una línea no funciona de manera correcta, salvo que la entrada sea usando llaves: `\Scontents{...}`, pero aún así falla si encuentra llaves escapadas (con un `\` justo a la izquierda). Si el archivo de entrada es de esta forma:
Sintáxis: [ Descargar ] [ Ocultar ]
Using latex Syntax Highlighting
  1. \documentclass{article}
  2. \usepackage{scontents}
  3. \begin{document}
  4. % En una línea
  5. Se puede usar \Scontents*|\pspicture o \pspicture*| escrito en una línea
  6. Se puede usar \Scontents*[key=val]+ \pspicture o \pspicture* + escrito en una línea
  7. Se puede usar \Scontents*[key=val]{ \pspicture o \pspicture* } escrito en una línea
  8. Se puede usar \Scontents{ \pspicture o \pspicture* } escrito en una línea
  9. Se puede usar \Scontents[key=val]{ \pspicture o \pspicture* } escrito en una línea
  10.  
  11. % En varias líneas
  12. Se puede usar \Scontents*|
  13.  
  14.    \pspicture o \pspicture*
  15.    
  16.     | en varias líneas
  17. Se puede usar \Scontents*[key=val]+
  18.  
  19.   \pspicture o
  20.  
  21.   \pspicture*
  22.   + en varias líneas
  23. Se puede usar \Scontents*[key=val]{
  24.  
  25.        \pspicture o \pspicture*
  26.        
  27.        } en varias líneas
  28. Se puede usar \Scontents{
  29. \{ \{ \} \}
  30.        \pspicture o \pspicture*
  31.        }
  32.        en varias líneas
  33. Se puede usar \Scontents[key=val]{
  34.        \pspicture o \pspicture*
  35.        } en varias líneas
  36. %\begin{postscript}
  37. \begin{verbatim}
  38. \psset{unit=1.0cm}
  39. \begin{pspicture}[showgrid=true](4,2)
  40.   \psscaleboxto(8,2){foo bar baz}
  41. \end{pspicture}
  42. \end{verbatim}
  43.  
  44. Texto \begin{verbatim} \begin{pspicture} ... \end{pspicture} \end{verbatim}  escrito en una línea
  45.  
  46. \begin{pspicture*}(4,2)(8,1)
  47. \psset{unit=1.0cm}
  48. \psscaleboxto(8,2){foo bar baz}
  49. \end{pspicture*}
  50.  
  51. %%% \pspicture*(4,2)(8,1) o \begin{pspicture*}(4,2)(8,1)
  52. \pspicture*(4,2)(8,1)
  53. \psset{unit=1.0cm}
  54. \psscaleboxto(8,2){foo bar baz}
  55. \endpspicture
  56. % se puede \endpspicture o \end{pspicture*}
  57. % \pspicture(4,2)(8,1) o \begin{pspicture}(4,2)(8,1)
  58. \pspicture(4,2)(8,1)
  59. \psset{unit=1.0cm}
  60. \psscaleboxto(8,2){foo bar baz}
  61. \endpspicture
  62. %\endpspicture o \end{pspicture}
  63. \end{document}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

La salida debería ser la siguiente:
Sintáxis: [ Descargar ] [ Ocultar ]
Using latex Syntax Highlighting
  1. \documentclass{article}
  2. \usepackage{scontents}
  3. \begin{document}
  4. % En una línea
  5. Se puede usar \Scontents*|\TRICKS o \TRICKS*| escrito en una línea
  6. Se puede usar \Scontents*[key=val]+ \TRICKS o \TRICKS* + escrito en una línea
  7. Se puede usar \Scontents*[key=val]{ \TRICKS o \TRICKS* } escrito en una línea
  8. Se puede usar \Scontents{ \TRICKS o \TRICKS* } escrito en una línea
  9. Se puede usar \Scontents[key=val]{ \TRICKS o \TRICKS* } escrito en una línea
  10.  
  11. % En varias líneas
  12. Se puede usar \Scontents*|
  13.  
  14.    \TRICKS o \TRICKS*
  15.    
  16.     | en varias líneas
  17. Se puede usar \Scontents*[key=val]+
  18.  
  19.   \TRICKS o
  20.  
  21.   \TRICKS*
  22.   + en varias líneas
  23. Se puede usar \Scontents*[key=val]{
  24.  
  25.        \TRICKS o \TRICKS*
  26.        
  27.        } en varias líneas
  28. Se puede usar \Scontents{
  29. \{ \{ \} \}
  30.        \TRICKS o \TRICKS*
  31.        }
  32.        en varias líneas
  33. Se puede usar \Scontents[key=val]{
  34.        \TRICKS o \TRICKS*
  35.        } en varias líneas
  36. %\begin{POSTRICKS}
  37. \begin{verbatim}
  38. \psset{unit=1.0cm}
  39. \begin{TRICKS}[showgrid=true](4,2)
  40.   \psscaleboxto(8,2){foo bar baz}
  41. \end{TRICKS}
  42. \end{verbatim}
  43.  
  44. Texto \begin{verbatim} \begin{TRICKS} ... \end{TRICKS} \end{verbatim}  escrito en una línea
  45.  
  46. \begin{pspicture*}(4,2)(8,1)
  47. \psset{unit=1.0cm}
  48. \psscaleboxto(8,2){foo bar baz}
  49. \end{pspicture*}
  50.  
  51. %%% \TRICKS*(4,2)(8,1) o \begin{TRICKS*}(4,2)(8,1)
  52. \pspicture*(4,2)(8,1)
  53. \psset{unit=1.0cm}
  54. \psscaleboxto(8,2){foo bar baz}
  55. \endpspicture
  56. % se puede \ENDTRICKS o \end{TRICKS*}
  57. % \TRICKS(4,2)(8,1) o \begin{TRICKS}(4,2)(8,1)
  58. \pspicture(4,2)(8,1)
  59. \psset{unit=1.0cm}
  60. \psscaleboxto(8,2){foo bar baz}
  61. \endpspicture
  62. %\ENDTRICKS o \end{TRICKS}
  63. \end{document}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Es decir, debería funcionar si la entrada está en más de una línea y no debería tomar en cuenta las llaves `\{` y `\}` (son validas en LaTeX).
He intentado durante un buen rato usar (?!...) para `\{` y `\}`, las cuales no siempre están balanceadas, pero nada ha funcionado. Lo mismo para la expresión con argumento delimitado.

Si alguno de los presentes tiene alguna sugerencia o una mejor estrategia para esto, se agradece.

Saludos.
Última edición por pablgonz el 2019-08-16 09:03 @419, editado 2 veces en total
pablgonz
Perlero nuevo
Perlero nuevo
 
Mensajes: 236
Registrado: 2010-09-08 21:03 @919
Ubicación: Concepción (Chile)
Arriba

Publicidad

Re: Ajustar expresiones regulares en script

Notapor explorer » 2019-08-16 04:11 @216

La expresión regular $marca no está preparada para analizar patrones que cubran varias líneas.

Es decir, el patrón '.+? ' de $marca no detecta los caracteres de fin de línea, por lo que no pasa a la siguiente.

Hay que incorporar el modificador '/s' a la expresión regular para permitir que '.+?' contemple el caso de que el patrón ocupe varias líneas.

En perldoc perlre:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
  Modificadores
    En las operaciones de detección de coincidencias se pueden usar varios
    modificadores. Se muestran a continuación los modificadores relacionados
    con la interpretación de una expresión regular. Los modificadores que
    cambian la forma en que Perl usa una expresión regular se describen en
    "Operadores de entrecomillado para expresiones regulares" in perlop y en
    "Detalles complejos del análisis de construcciones entrecomilladas" in
    perlop.

    m   Trata la cadena como si fuera un conjunto de líneas. Es decir, cambia
        el significado de "^" y "$", que detectan el principio y el final de
        la cadena respectivamente, para que detecten el principio y el final
        de cualquier línea en cualquier parte de la cadena.

    s   Trata la cadena como una sola línea. Es decir, cambia el significado
        de "." para que detecte cualquier carácter, incluso el de nueva línea,
        que normalmente no detectaría.

        Si se usan juntos, como "/ms", permiten que "." detecte cualquier
        carácter y, a la vez, que "^" y "$" detecten, respectivamente, las
        posiciones justo a continuación e inmediatamente antes de los
        caracteres de nueva línea en la cadena.
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Ajustar expresiones regulares en script

Notapor pablgonz » 2019-08-16 09:01 @417

explorer escribiste:La expresión regular $marca no está preparada para analizar patrones que cubran varias líneas.

Es decir, el patrón '.+? ' de $marca no detecta los caracteres de fin de línea, por lo que no pasa a la siguiente.

Hay que incorporar el modificador '/s' a la expresión regular para permitir que '.+?' contemple el caso de que el patrón ocupe varias líneas.

En perldoc perlre: ...

Muchas gracias explorer, había olvidado una de las reglas básicas..."leer la documentación primero". He modificado el script ahorrándome un while y reparado un problema que tenía con el uso de ^ en el for, ha quedado de la siguiente manera:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/env perl
  2. use v5.28;
  3. use autodie;                        # muere si ocurre un error
  4. use File::Basename;                 # separa el archivo de entrada
  5.  
  6. ## Argumentos ---------------------------------------------------------
  7. @ARGV == 1  or die "Uso: $0 <archivo TeX a procesar>\n";
  8. my $nombre_archivo = shift;
  9. -f $nombre_archivo or die "ERROR: No encuentro [$nombre_archivo]\n";
  10.  
  11. ## Arreglo de la extensión --------------------------------------------
  12. my @SuffixList = ('.tex', '', '.ltx');          # extensión
  13. my ($name, $path, $ext) = fileparse($nombre_archivo, @SuffixList);
  14. $ext = '.tex' if not $ext;                      # fijamos la extensión
  15.  
  16. ## Abrimos el archivo de entrada a modificar --------------------------
  17. open my $ENTRADA, '<', $nombre_archivo;
  18. my $archivo;
  19.  {
  20.     local $/;
  21.     $archivo = <$ENTRADA>;
  22.  }
  23. close   $ENTRADA;
  24.  
  25. ## Cambios a realizar
  26. my %cambios = (
  27.     '\pspicture'                => '\TRICKS',
  28.     '\endpspicture'             => '\ENDTRICKS',
  29.     '\begin{MYexample'          => '\begin{MYEXAMPLE',
  30.     '\end{MYexample'            => '\end{MYEXAMPLE',
  31.     '\begin{pspicture'          => '\begin{TRICKS',
  32.     '\end{pspicture'            => '\end{TRICKS',
  33.     '\begin{postscript}'        => '\begin{POSTRICKS}',
  34.     '\end{postscript}'          => '\end{POSTRICKS}',
  35. );
  36.  
  37.  
  38. ## Variables y constantes
  39. my $no_del = "\0";
  40. my $del    = $no_del;
  41.  
  42. ## Reglas
  43. my $llaves      = qr/\{ .+? \}                                                               /x;
  44. my $corchetes   = qr/\[ .+? \]                                                               /x;
  45. my $no_corchete = qr/(?: $corchetes )?                                                       /x;
  46. my $delimitador = qr/\{ (?<del>.+?) \}                                                       /x;
  47. my $scontents   = qr/Scontents [*]? $no_corchete                                             /ix;
  48. my $verb        = qr/verb [*]?                                                               /ix;
  49. my $lst         = qr/lstinline (?!\*) $no_corchete                                           /ix;
  50. my $mint        = qr/mint (?!\*) $no_corchete $llaves                                        /ix;
  51. my $marca       = qr/\\ (?:$verb | $scontents | $lst | $mint) (\S) .+? \g{-1}                /sx;
  52. my $comentario  = qr/^ \s* \%+ .+? $                                                         /mx;
  53. my $definedel   = qr/\\ (?:   DefineShortVerb | lstMakeShortInline  ) $no_corchete $delimitador /ix;
  54. my $indefinedel = qr/\\ (?: UndefineShortVerb | lstDeleteShortInline) $llaves                   /ix;
  55.  
  56. ## Comandos que utilizan llaves { balanceadas }  
  57. my $tcbxverb    = qr/\\ (?: tcboxverb | myverb | Scontents [*]?) $no_corchete  /ix;
  58. my $mintverb    = qr/\\ (?:mint(?:inline)?) $no_corchete $llaves               /ix;
  59. my $anidado     = qr/(\{(?:[^\{\}]++|(?R))*\})                                 /x;
  60. my $tcbxbrace   = qr/$tcbxverb $anidado                                        /sx;
  61. my $mintbrace   = qr/$mintverb $anidado                                        /sx;
  62.  
  63. ## Cambiar en comentarios y comandos delimitados <del> contenido <del>  o { contenido }
  64. while ($archivo =~
  65.     / $marca
  66.     | $tcbxbrace
  67.     | $mintbrace
  68.     | $comentario
  69.     | $definedel
  70.     | $indefinedel
  71.     | $del .+? $del
  72.     /pgmx) {
  73.  
  74.     my($pos_inicial, $pos_final) = ($-[0], $+[0]);      # posiciones
  75.     my $encontrado = ${^MATCH};                         # lo encontrado
  76.  
  77.     if ($encontrado =~ /$definedel/) {                  # definimos delimitador
  78.     $del = $+{del};
  79.     $del = "\Q$+{del}" if substr($del,0,1) ne '\\';     # es necesario "escapar" el delimitador
  80.     }
  81.     elsif ($encontrado =~ /$indefinedel/) {             # indefinimos delimitador
  82.     $del = $no_del;                
  83.     }
  84.     else {                                              # aquí se hacen los cambios
  85.     while (my($busco, $cambio) = each %cambios) {
  86.         $encontrado =~ s/\Q$busco\E/$cambio/g;          # es necesario escapar $busco
  87.     }
  88.  
  89.     substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;    # insertamos los nuevos cambios
  90.  
  91.     pos($archivo) = $pos_inicial + length $encontrado;  # re posicionamos la siguiente búsqueda
  92.     }
  93. }
  94.  
  95. ## Divido el archivo por líneas
  96. my @lineas = split /\n/, $archivo;
  97.  
  98. my $ENTORNO  = qr/(?: verbatim\*? | LTXexample | tcblisting | mybox | comment )/xi;
  99.  
  100. my $DEL;
  101.  
  102. ## Ordenamos las palabras que deseamos cambiar
  103. my %replace = (%cambios);
  104. my $find = join "|", map {quotemeta} sort { length($a)<=>length($b) } keys %replace;
  105.  
  106. ## Cambiar dentro de entornos verbatim
  107. for (@lineas) {
  108.     if (/\\begin\{($ENTORNO)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
  109.         s/($find)/$replace{$1}/g;
  110.     }
  111. }
  112.  
  113. ## Escritura del resultado
  114. open my $SALIDA, '>', "$name-out$ext";
  115. print   $SALIDA join("\n", @lineas);
  116. close   $SALIDA;
  117.  
  118. __END__
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4

El único problema que me resta es con la expresión regular recursiva, ¿cómo la modifico para que ignore los caracteres \{ y \}?, es decir, al ingresar algo así:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Se puede usar \Scontents{
\{ \{ \}
       \pspicture o \pspicture*
       }
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

obtener una salida así:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Se puede usar \Scontents{
\{ \{ \}
       \TRICKS o \TRICKS*
       }
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Gracias nuevamente.
pablgonz
Perlero nuevo
Perlero nuevo
 
Mensajes: 236
Registrado: 2010-09-08 21:03 @919
Ubicación: Concepción (Chile)
Arriba

Re: Ajustar expresiones regulares en script

Notapor pablgonz » 2019-08-19 07:58 @374

Creo que he dado con la solución, claro, he tenido que usar dos bucles while, y cambiar la expresión regular recursiva a :
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
my $anidado     = qr/(\{(?>[^\{\}\\]++|\\.|(?R))*+\})                                        /x;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Funciona en todos los casos que he probado, al final quedó así:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/env perl
  2. use v5.28;
  3. use autodie;                        # muere si ocurre un error
  4. use File::Basename;                 # separa el archivo de entrada
  5.  
  6. ## Argumentos ---------------------------------------------------------
  7. @ARGV == 1  or die "Uso: $0 <archivo TeX a procesar>\n";
  8. my $nombre_archivo = shift;
  9. -f $nombre_archivo or die "ERROR: No encuentro [$nombre_archivo]\n";
  10.  
  11. ## Arreglo de la extensión --------------------------------------------
  12. my @SuffixList = ('.tex', '', '.ltx');          # extensión
  13. my ($name, $path, $ext) = fileparse($nombre_archivo, @SuffixList);
  14. $ext = '.tex' if not $ext;                      # fijamos la extensión
  15.  
  16. ## Abrimos el archivo de entrada a modificar --------------------------
  17. open my $ENTRADA, '<', $nombre_archivo;
  18. my $archivo;
  19.  {
  20.     local $/;
  21.     $archivo = <$ENTRADA>;
  22.  }
  23. close   $ENTRADA;
  24.  
  25. ## Cambios a realizar
  26. my %cambios = (
  27.     '\pspicture'                => '\TRICKS',
  28.     '\endpspicture'             => '\ENDTRICKS',
  29.     '\begin{MYexample'          => '\begin{MYEXAMPLE',
  30.     '\end{MYexample'            => '\end{MYEXAMPLE',
  31.     '\begin{pspicture'          => '\begin{TRICKS',
  32.     '\end{pspicture'            => '\end{TRICKS',
  33.     '\begin{postscript}'        => '\begin{POSTRICKS}',
  34.     '\end{postscript}'          => '\end{POSTRICKS}',
  35. );
  36.  
  37.  
  38. ## Variables y constantes
  39. my $no_del = "\0";
  40. my $del    = $no_del;
  41.  
  42. ## Reglas
  43. my $llaves      = qr/\{ .+? \}                                                               /x;
  44. my $corchetes   = qr/\[ .+? \]                                                               /x;
  45. my $no_corchete = qr/(?: $corchetes )?                                                       /x;
  46. my $delimitador = qr/\{ (?<del>.+?) \}                                                       /x;
  47. my $scontents   = qr/Scontents [*]? $no_corchete                                             /ix;
  48. my $verb        = qr/verb [*]?                                                               /ix;
  49. my $lst         = qr/lstinline (?!\*) $no_corchete                                           /ix;
  50. my $mint        = qr/mint (?!\*) $no_corchete $llaves                                        /ix;
  51. my $marca       = qr/\\ (?:$verb | $scontents | $lst | $mint) (\S) .+? \g{-1}                /sx;
  52. my $comentario  = qr/^ \s* \%+ .+? $                                                         /mx;
  53. my $definedel   = qr/\\ (?:   DefineShortVerb | lstMakeShortInline  ) $no_corchete $delimitador /ix;
  54. my $indefinedel = qr/\\ (?: UndefineShortVerb | lstDeleteShortInline) $llaves                   /ix;
  55. my $tcbxverb    = qr/\\ (?: tcboxverb | myverb | Scontents [*]?) $no_corchete                /ix;
  56. my $mintverb    = qr/\\ (?:mint(?:inline)?) $no_corchete $llaves                             /ix;
  57. my $anidado     = qr/(\{(?>[^\{\}\\]++|\\.|(?R))*+\})                                        /x;
  58. my $tcbxbrace   = qr/$tcbxverb $anidado                                                      /x;
  59. my $mintbrace   = qr/$mintverb $anidado                                                      /x;
  60.  
  61. ## Cambiar en comentarios y comandos delimitados <del> contenido <del>
  62. while ($archivo =~
  63.     / $marca
  64.     | $comentario
  65.     | $definedel
  66.     | $indefinedel
  67.     | $del .+? $del
  68.     /pgmx) {
  69.  
  70.     my($pos_inicial, $pos_final) = ($-[0], $+[0]);      # posiciones
  71.     my $encontrado = ${^MATCH};                         # lo encontrado
  72.  
  73.     if ($encontrado =~ /$definedel/) {                  # definimos delimitador
  74.     $del = $+{del};
  75.     $del = "\Q$+{del}" if substr($del,0,1) ne '\\';     # es necesario "escapar" el delimitador
  76.     }
  77.     elsif ($encontrado =~ /$indefinedel/) {             # indefinimos delimitador
  78.     $del = $no_del;                
  79.     }
  80.     else {                                              # aquí se hacen los cambios
  81.     while (my($busco, $cambio) = each %cambios) {
  82.         $encontrado =~ s/\Q$busco\E/$cambio/g;          # es necesario escapar $busco
  83.     }
  84.  
  85.     substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;    # insertamos los nuevos cambios
  86.  
  87.     pos($archivo) = $pos_inicial + length $encontrado;  # re posicionamos la siguiente búsqueda
  88.     }
  89. }
  90.  
  91. ## Cambiar en comandos que utilizan llaves { contenido }  balanceadas
  92. while ($archivo =~ /$tcbxbrace | $mintbrace /pgmx) {
  93.  
  94.     my($pos_inicial, $pos_final) = ($-[0], $+[0]);               # posiciones
  95.     my $encontrado = ${^MATCH};                                  # lo encontrado
  96.  
  97.     while (my($busco, $cambio) = each %cambios) {
  98.                    $encontrado =~ s/\Q$busco\E/$cambio/g;        # es necesario escapar $busco
  99.                     }
  100.     substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;    # insertamos los nuevos cambios
  101.  
  102.     pos($archivo)= $pos_inicial + length $encontrado;            # re posicionamos la siguiente búsqueda
  103. }
  104.  
  105. ## Divido el archivo por líneas
  106. my @lineas = split /\n/, $archivo;
  107.  
  108. my $ENTORNO  = qr/(?: verbatim\*? | LTXexample | tcblisting | mybox | comment )/xi;
  109.  
  110. my $DEL;
  111.  
  112. ## Ordenamos las palabras que deseamos cambiar
  113. my %replace = (%cambios);
  114. my $find = join "|", map {quotemeta} sort { length($a)<=>length($b) } keys %replace;
  115.  
  116. ## Cambiar dentro de entornos verbatim
  117. for (@lineas) {
  118.     if (/\\begin\{($ENTORNO)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
  119.         s/($find)/$replace{$1}/g;
  120.     }
  121. }
  122.  
  123. ## Escritura del resultado
  124. open my $SALIDA, '>', "$name-out$ext";
  125. print   $SALIDA join("\n", @lineas);
  126. close   $SALIDA;
  127.  
  128. __END__
  129.  
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4

Quizás pueda optimizarse el código o hacerlo de otra forma, pero de momento parece estar correcto.
pablgonz
Perlero nuevo
Perlero nuevo
 
Mensajes: 236
Registrado: 2010-09-08 21:03 @919
Ubicación: Concepción (Chile)
Arriba
Publicar una respuesta

Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 0 invitados

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management