Foro - Perl en Español

por **pablgonz** » 2015-12-11 16:20 @722

Hola a todos nuevamente, estoy trabajando en un script y me he topado con un problema de una líneas sobrantes (la primera y la última) al extraer un bloque de texto con una expresión regular. Si el archivo de entrada es así:

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

\documentclass{article}
\usepackage{lmodern}
\usepackage{pstricks-add}
\begin{document}
Texto texto texto
% codigo uno
\begin{postscript}
code uno
\end{postscript}
Texto texto texto
Texto texto texto
% codigo dos
texto\begin{pspicture}(-0.5,-0.5)(5,3.5)
code dos
\end{pspicture}texto
Texto texto texto
Texto texto texto
% código tres
\psset{
unit=1.0cm,
algebraic=true,
dimen=middle,
linewidth=0.8pt
}
\begin{pspicture}(-0.5,-0.5)(5,3.5)
code tres
\end{pspicture}
Texto texto texto
% código cuatro
\begin{pgfpicture}
code cinco
\end{pgfpicture}
Texto texto texto
% código cinco
TIKZ
\begin{tikzpicture}
code cinco
\end{tikzpicture}
% código seis
Texto texto texto 
\begin{forest}
code seis
\end{forest}
 
Texto texto texto 
 
\begin{postscript}
\begin{ganttchart}
ganttchart
\end{ganttchart}
\end{postscript}
final
\end{document}
 
\begin{pspicture}(-0.5,-0.5)(5,3.5)
IGNORAR
\end{pspicture}
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

y pasar este script con la opción --source:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/env perl
use v5.22;
use File::Basename; 
use Getopt::Long qw(:config bundling_override require_order);
use autodie;                  
use File::Temp qw(tempdir);
use File::Copy;
#--------------------------- Constantes -------------------------------#
my $BPL       = '\begin{postscript}';
my $EPL       = '\end{postscript}';
my $sipgf     = 'pgfpicture';
my $nopgf     = 'pgfinterruptpicture';
my $BP        = '\\\\begin\{postscript\}';
my $EP        = '\\\\end\{postscript\}';
my $tempDir   = tempdir( CLEANUP => 1); # temporary directory
#-------------------------- Getopt::Long ------------------------------#
my $other     = "other";        # other environment for search
my $imageDir  = "images";       # dir for images (images default)
my $ignore    = "ignore";       # ignore verbatim environment
my $clear     = 0;              # 1->clear all temporary files
my $source    = 0;              # 1->extrae codigo de las imágenes
my $nopreview = 0;              # 1->activa el modo nopreview
my $subfile   = 0;              # 1->activa el modo nopreview
my $latex     = 0;              # 1->create all images using latex
my $xetex     = 0;              # 1->create all images using xelatex
my $luatex    = 0;              # 1->create all images using lualatex
my $png       = 0;              # 1->create .png using Ghoscript
my $jpg       = 0;              # 1->create .jpg using Ghoscript
my $eps       = 0;              # 1->create .eps using pdftops
my $svg       = 0;              # 1->create .svg using pdf2svg
my $ppm       = 0;              # 1->create .ppm using pdftoppm
my $all       = 0;              # 1->create all images type
my $miktex    = 0;              # 1->enable write 18 for miktex system
my $Verbose   = 0;              # 0 or 1, logfile  
#------------------------ Opciones y ayuda ----------------------------#
my $usage = <<"END_OF_USAGE";
Uso: script [opciones] entrada.tex [salida]
END_OF_USAGE
 
### error
sub errorUsage { die "@_ (use script --help)\n"; }
 
### Getopt::Long
my $result=GetOptions (
    'imgdir=s'          => \$imageDir, # images
    'ignore=s'          => \$ignore, # ignore, ignore*
    'other=s'           => \$other, # other, other*
    'e|eps'             => \$eps, # pdftops
    'j|jpg'             => \$jpg, # gs
    'p|png'             => \$png, # gs
    'P|ppm'             => \$ppm, # pdftoppm
    's|svg'             => \$svg, # pdf2svg
    'a|all'             => \$all, # all
    'c|clear'           => \$clear, # clear
    'h|help'            => \$::opt_help, # help
    'subfile'           => \$subfile, # subfile
    'source'            => \$source, # src 
    'np|nopreview'      => \$nopreview, # 
    'xetex'             => \$xetex, # 
    'latex'             => \$latex, # 
    'luatex'            => \$luatex,# 
    'miktex'            => \$miktex, # 
    'Verbose'           => \$Verbose, # verbose
    ) or die "use script --help para ver las opciones\n";
 
### help
if ($::opt_help) {
    print $usage;
    exit(0);
}
 
#--------------- Chequeamos los argumentos de entrada -----------------#
@ARGV > 0 or errorUsage "Falta ingresar el nombre del archivo de entrada";
@ARGV < 3 or errorUsage "Opción desconocida o varios archivos de entrada";
 
#--------------------- Arreglo de la extensión ------------------------#
my @SuffixList = ('.tex', '', '.ltx');    # posibles
my ($name, $path, $ext) = fileparse($ARGV[0], @SuffixList);
$ext = '.tex' if not $ext;
 
### El nombre del archivo de salida se guarda en $ARGV[1]
my $output = $ARGV[1];
 
#---------------------- Abrimos el archivo ----------------------------#
open my $ENTRADA, '<', "$name$ext";
my $archivo;
{
    local $/;
    $archivo = <$ENTRADA>;
}
close   $ENTRADA;
 
### Creamos el directorio para las imágenes 
-e $imageDir or mkdir($imageDir,0744) or die "No puedo crear $imageDir: $!\n";
 
### Dividimos el archivo de entrada 
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+?) (\\begin\{document\} .+?)(\\end\{document\}.*)\z/msx;
 
### Verbatim environments
my $VERBATIM  = qr/(?: (v|V)erbatim\*?| PSTexample | aling)/xi;
 
### postscript environment
my $POSTSCRIPT = qr/(?: postscript)/xi;
 
### tikzpicture environment
my $ENVIRONMENT    = qr/(?: tikzpicture | pspicture\*?)/xi;
 
#------------------ Expresiones regulares en $cuerpo ------------------#
 
### \pspicture to \begin{pspicture}
$cuerpo =~ s/\\pspicture(\*)?(.+?)\\endpspicture/\\begin{pspicture$1}$2\\end{pspicture$1}/gmsx;
 
### tikz/pst to Postscript
$cuerpo =~ s/\\begin\{$POSTSCRIPT\}.+?\\end\{$POSTSCRIPT\}(*SKIP)(*F)|
        (
        (?:\\(psset|tikzset)(\{(?:\{.*?\}|[^\{])*\}).*?)?  # si está lo guardo
        (\\begin\{($ENVIRONMENT)\} (.*?)  \\end\{\g{-2}\})
    )
    /$BPL\n$1\n$EPL/gmsx;
 
### pgfpicture to Postscript
$cuerpo =~ s/\\begin\{$POSTSCRIPT\}.+?\\end\{$POSTSCRIPT\}(*SKIP)(*F)|
    (
        \\begin\{$sipgf\}
            .*?
            (
                \\begin\{$nopgf\}
                .+?
                \\end\{$nopgf\}
                .*?
            )*?
        \\end\{$sipgf\}
    )
    /$BPL\n$1\n$EPL/gmsx;
 
### other to PostScript
my $EXPORT  = qr/(forest|ganttchart|tikzcd|circuitikz|dependency|$other\*?)/x;
 
$cuerpo =~ s/\\begin\{$POSTSCRIPT\}.+?\\end\{$POSTSCRIPT\}(*SKIP)(*F)|
        (\\begin\{($EXPORT)\} (.*?)  \\end\{\g{-2}\})
        /$BPL\n$1\n$EPL/gmsx;
 
#----------------- Creación del fichero de imágenes -------------------#
### $nopreview mode 
if ($nopreview) {
my @env_extract;
 
while ( $cuerpo =~ m/(?<=$BP)(?<env_src>.+?)(?=$EP)/gms ) { # recorremos $cuerpo
    push @env_extract, $+{env_src}."\n\\newpage\n";
}
open my $SALIDA, '>', "$imageDir/$name-fig$ext";
print $SALIDA $cabeza."\\pagestyle{empty}\n\\begin{document}\n"."@env_extract\n"."\\end{document}";
close $SALIDA;
} # close $nopreview
### preview mode (default)
else {
my $opcion = $xetex ? 'xetex,'
           : $latex ? ''
           :          'pdftex,'
           ;
 
my $preview = <<"EXTRA";
\\AtBeginDocument\{%
\\RequirePackage\[${opcion}active,tightpage\]\{preview\}%
\\renewcommand\\PreviewBbAdjust\{-60pt -60pt 60pt 60pt\}%
\\newenvironment\{postscript\}\{\}\{\}%
\\PreviewEnvironment\{postscript\}\}%
EXTRA
# write
open my $SALIDA, '>', "$imageDir/$name-fig$ext";
print   $SALIDA $preview.$cabeza.$cuerpo."\\end{document}";
close   $SALIDA;
} # close preview
 
#-------------------- Extracción de ficheros fuente -------------------#
if ($source) {
my $src_file = "$name-src-";   # nombre del archivo de salida
my $srcNo    = 1; # contador para los ficheros fuente
 
while ($cuerpo =~ m/(?<=$BP)(?<env_src>.+?)(?=$EP)/gms) { # recorremos $cuerpo
 
open my $SALIDA, '>', "$imageDir/$src_file$srcNo$ext";
    print $SALIDA $+{env_src};
close $SALIDA;
    }
continue {
    $srcNo++; # auto incremento del contador
}
} # close $source
 
#-------------------- Extracción de subficheros -----------------------#
if ($subfile) {
my $sub_file = "$name-fig-";   # nombre del archivo de salida
my $subNo = 1; # subfile number
 
while ($cuerpo =~ m/(?<=$BP)(?<env_src>.+?)(?=$EP)/gms) { # recorremos $cuerpo
 
open my $SALIDA, '>', "$imageDir/$sub_file$subNo$ext";
print $SALIDA <<"EOC";
$cabeza\\pagestyle\{empty\}\n\\begin\{document\}$+{'env_src'}\\end\{document\}
EOC
close $SALIDA;
    } # close while 
continue {
    $subNo++; # auto incremento del contador
}
} # close $subfile
 
#------------------ Creación del archivo de salida --------------------#
if (defined $output) {
if ($output =~ /(^\-|^\.).*?/){ # No comienze por -, -- o .
    die "$output no es un nombre valido para el archivo de salida\n";
    } 
if ($output eq "$ARGV[0]" or $output eq "$name") { # $output = $input
    $output = "$name-out$ext";  
    }
if ($output =~ /.*?$ext/){ # Si $output termina en .ltx o .tex la quitamos
    $output =~ s/(.+?)$ext/$1/gms;
    }
 
### Convertimos Postscript a includegraphics 
my $grap="\\includegraphics[scale=1]{$name-fig-";
my $close = '}';
my $imgNo = 1; # contador para las imágenes
 
$cuerpo =~ s/$BP.+?$EP/$grap@{[$imgNo++]}$close/msg; # cambiamos
 
# print "Creamos $output$ext\n" if $verbose;
open my $SALIDA, '>', "$tempDir/$output$ext";
    print $SALIDA <<"EOC";
$cabeza$cuerpo$final
EOC
close $SALIDA;
copy "$tempDir/$output$ext", "$tempDir/mojo";
} # cerramos defined 
 
move "$tempDir/$output$ext", "$output$ext";
__END__
 
Coloreado en 0.010 segundos,  usando GeSHi 1.0.8.4

crea los archivos, pero, deja una línea en blanco al principio y al final de cada archivo generado, por ejemplo, crea

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

 
code uno
 
Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

y debería crear

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

code uno
Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

. He usado las aserciones de inspección (?<=$BP) y (?=$EP) para extraer lo que deseo en esta opción y en otra ($subfile) en la cual funciona correctamente. Si no he entendido mal cómo funcionan, estas no incluyen $BP ni $EP en la captura pero al parecer las cambia por una línea en blanco.
Saludos
Pablo

while ($cuerpo =~ m/(?<=$BP)(?<env_src>.+?)(?=$EP)/gms) {

No es necesario usar aserciones de ancho cero, en este caso. Estás aplicando un patrón a $cuerpo, para buscar el interior entre dos marcas, y esa captura la haces con paréntesis (y con nombre), así que no es necesario el uso de patrones en aserciones de ancho cero, ya que no son capturados. Sí que son más útiles en las sustituciones (porque no queremos sustituir esos patrones).

Quedaría así:

while ($cuerpo =~ m/$BP(?<env_src>.+?)$EP/gms) {

En cuanto a lo de que aparecen líneas en blanco, indudablemente es que esos caracteres no son capturados por $BP o $EP. Ejemplo, si tenemos

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/env perl
 
my $BP =         quotemeta('\begin{postscript}');
my $EP =         quotemeta('\end{postscript}'  );
 
my $cuerpo = '\begin{postscript}
code uno
\end{postscript}
 
\begin{postscript}
code dos
\end{postscript}
';
 
while ($cuerpo =~ m/$BP(?<env_src>.+?)$EP/gms) {
 
    print "[$+{env_src}]";
}
 
print "\n";
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

La salida es:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

[

code uno

][

code dos

]Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

que es justo lo que te pasa. Si agregamos a los patrones el que capturen los posibles caracteres espacio,

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/env perl
 
my $BP =         quotemeta('\begin{postscript}') . '\s*';
my $EP = '\s*' . quotemeta('\end{postscript}'  );
 
my $cuerpo = '\begin{postscript}
code uno
\end{postscript}
 
\begin{postscript}
code dos
\end{postscript}
';
 
while ($cuerpo =~ m/$BP(?<env_src>.+?)$EP/gms) {
 
    print "[$+{env_src}]";
}
 
print "\n";
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

la salida ya cambia:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

[code uno][code dos]Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Humm... casi mejor poner los '\s*' en el patrón principal:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

while ($cuerpo =~ m/$BP\s*(?<env_src>.+?)\s*$EP/gms) {
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **pablgonz** » 2015-12-11 18:50 @826

Genial, no pude dar con esa línea, usé las aserciones pensando que era lo indicado en este caso, leeré más respecto de estas.

Un par de consultas respecto a la respuesta que me has dado:
1. Al ver el código que dejas de ejemplo veo que usas quotemeta(...), es decir, que estas "escapando" el contenido dentro de (...), entonces si cambio de:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my $BPL       = '\begin{postscript}';
my $EPL       = '\end{postscript}';
my $BP        = '\\\\begin\{postscript\}';
my $EP        = '\\\\end\{postscript\}';
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

a

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my $BP =         quotemeta('\begin{postscript}');
my $EP =         quotemeta('\end{postscript}'  );
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

¿funcionará en todos los casos?

2. ¿Es mejor usar paréntesis de captura con nombre o seguir usando la referencia $1, $2, etc.?

3. Uso varias veces (*SKIP)(*F)| regex, en el lado derecho, ¿puedo volver a usar (*SKIP)?, no lo he intentado, pero lo de (*SKIP)(*F) es una de las cosas más geniales de Perl (algunos amigos han intentado hacer cosas parecidas en otros lenguajes y al parecer no se puede en todos).

4. Siempre escribes los códigos con un formato bonito de espacios y tabulaciones. ¿Qué opciones usas en perltidy? ¿o solo lo haces manualmente?

Agradecido:
Pablo.

P.D.: Ahora sí cambie la línea del shebang y ocupo Getopt de manera más eficiente.

por **explorer** » 2015-12-13 08:33 @398

pablgonz escribiste:1. Al ver el código que dejas de ejemplo veo que usas quotemeta(...), es decir, que estas "escapando" el contenido dentro de (...), entonces si cambio de:
Sintáxis: [ Descargar ] [ Ocultar ]
Sintáxis: [ Descargar ] [ Mostrar ]
Using perl Syntax Highlighting
my $BPL = '\begin{postscript}';

my $EPL = '\end{postscript}';

my $BP = '\\\\begin\{postscript\}';

my $EP = '\\\\end\{postscript\}';

Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
a
Sintáxis: [ Descargar ] [ Ocultar ]
Sintáxis: [ Descargar ] [ Mostrar ]
Using perl Syntax Highlighting
my $BP = quotemeta('\begin{postscript}');

my $EP = quotemeta('\end{postscript}' );

Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
¿funcionará en todos los casos?

Cuestión de probar

Si, en informática, estamos repitiendo algo muchas veces (en tu caso, escapar caracteres con '\'), es que algo no estamos haciendo bien.

Sabiendo que Perl sabe "escapar" caracteres, bien sea usando quotemeta() o "\Q...\E", pues buena gana de hacerlo nosotros.

pablgonz escribiste:2. ¿Es mejor usar paréntesis de captura con nombre o seguir usando la referencia $1, $2, etc.?

Da igual. Bueno, no. Es más claro con nombre, además de ser más robusto (resistirá los futuros cambios que hagamos, si hacemos alguna). Hay que escribir más, pero el código queda más claro.

pablgonz escribiste:3. Uso varias veces (*SKIP)(*F)| regex. En el lado derecho ¿puedo volver a usar (*SKIP)? No lo he intentado, pero lo de (*SKIP)(*F) es una de las cosas más geniales de Perl (algunos amigos han intentado hacer cosas parecidas en otros lenguajes y al parecer no se puede en todos).

Yo creo que sí se puede usar en otros lenguajes, siempre y cuando hagan uso de la biblioteca PCRE.

Lo de usarlo en el lado derecho... pues habría que verlo, pero antes hay que entender qué es lo que hace.

El (*SKIP) dice que si se cumple el patrón anterior a él, las siguientes pruebas de búsqueda deben realizarse a partir de ese punto, y no volver hacia atrás. Y el (*FAIL) marca la búsqueda como fallida, por lo que reinicia la búsqueda.

Como estos patrones especiales los tienes en el lado izquierdo de un patrón de alternancia '|', entonces se ejecutan antes que el patrón que está en el lado derecho. Si pones otro (*SKIP)(*FAIL) en el lado derecho, tendrá el mismo comportamiento: si encuentra el patrón, seguirá buscando desde ese punto. Y como hay un (*FAIL), nunca se cumplirá la exp. reg., por lo que no habrá sustitución (salvo que agregues un tercer caso con '|').

pablgonz escribiste:4. Siempre escribes los códigos con un formato bonito de espacios y tabulaciones. ¿Qué opciones usas en perltidy? ¿o solo lo haces manualmente?

perltidy hace bastante, pero no distingue todos los casos. El orden que hago es: primero perltidy y luego ajuste manual (no se puede aplicar perltidy otra vez porque desbarata todo el formateo manual).

Las reglas de formateo las saqué del libro PBP. Las primeras reglas te enseñan a escribir código de esa manera.

Foro - Perl en Español

Eliminar primera y última línea de un cadena

Eliminar primera y última línea de un cadena

Publicidad

Re: Eliminar primera y última línea de un cadena

Re: Eliminar primera y última línea de un cadena

Re: Eliminar primera y última línea de un cadena

¿Quién está conectado?