Foro - Perl en Español

por **pablgonz** » 2015-01-01 22:35 @983

Lo logré... la solución es un poco chambona... pero... bastante útil:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use v5.18;
use re 'eval';
use autodie;                    # muere si ocurre un error
use File::Basename;             # separa el archivo de entrada
use Config;
 
# Constantes 
my $tempDir = ".";              # temporary directory
my $imageDir = "images";        # where to save the images
my $ignore = "ignore";          # ignore verbatim environment
my $exacount = 1;               # Counter for images
my $other = "other";            # otro entorno 
#--------------------- Arreglo de la extensión -------------------------
my @SuffixList = ('.tex', '', '.ltx');               # posible extensión
my ($name, $path, $ext) = fileparse($ARGV[0], @SuffixList);
$ext = '.tex' if not $ext; 
 
#---------------- Creamos el directorio para las imágenes --------------
-e $imageDir or mkdir($imageDir,0744) or die "No puedo crear $imageDir: $!\n";
 
# Constantes para regex
my $BP = '\\\\begin{postscript}';
my $EP = '\\\\end{postscript}';
my $BPL = '\begin{postscript}';
my $EPL = '\end{postscript}';
my $sipgf = 'pgfpicture';
my $nopgf = 'pgfinterruptpicture';
my $graphics = "graphic=\{\[scale=1\]$imageDir/$name-fig";
 
############################# PARTE 1 ##################################
#---------------- Creamos un hash con los cambios ----------------------
my %cambios = (
# pspicture    
    '\pspicture'                => '\TRICKS',
    '\endpspicture'             => '\ENDTRICKS',
# pspicture
    '\begin{pspicture'          => '\begin{TRICKS',
    '\end{pspicture'            => '\end{TRICKS',
# postscript
    '\begin{postscript}'        => '\begin{POSTRICKS}',
    '\end{postscript}'          => '\end{POSTRICKS}',
# $other    
    "\\begin\{$other"           => '\begin{OTHER',
    "\\end\{$other"             => '\end{OTHER',
# document
    '\begin{document}'          => '\begin{DOCTRICKS}',
    '\end{document}'            => '\end{DOCTRICKS}',
# tikzpicture
    '\begin{tikzpicture}'       => '\begin{TIKZPICTURE}',
    '\end{tikzpicture}'         => '\end{TIKZPICTURE}',
# pgfinterruptpicture
    '\begin{pgfinterruptpicture'=> '\begin{PGFINTERRUPTPICTURE',
    '\end{pgfinterruptpicture'  => '\end{PGFINTERRUPTPICTURE',
# pgfpicture
    '\begin{pgfpicture}'        => '\begin{PGFPICTURE}',
    '\end{pgfpicture}'          => '\end{PGFPICTURE}',
# ganttchart
    '\begin{ganttchart}'        => '\begin{GANTTCHART}',
    '\end{ganttchart}'          => '\end{GANTTCHART}',
# circuitikz
    '\begin{circuitikz}'        => '\begin{CIRCUITIKZ}',
    '\end{circuitikz}'          => '\end{CIRCUITIKZ}',
# forest     
    '\begin{forest}'            => '\begin{FOREST}',
    '\end{forest}'              => '\end{FOREST}',
# tikzcd 
    '\begin{tikzcd}'            => '\begin{TIKZCD}',
    '\end{tikzcd}'              => '\end{TIKZCD}',
# dependency
    '\begin{dependency}'        => '\begin{DEPENDENCY}',
    '\end{dependency}'          => '\end{DEPENDENCY}',
);
 
#--------------------------- Coment Verbatim --------------------------#
 
open my $ENTRADA, '<', "$name$ext";
my $archivo;
{
    local $/;
    $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
# Variables y constantes
my $no_del = "\0";
my $del    = $no_del;
 
# Reglas
my $llaves      = qr/\{ .+? \}                                                                  /x;
my $no_corchete = qr/(?:\[ .+? \])?                                                             /x;
my $delimitador = qr/\{ (?<del>.+?) \}                                                          /x;
my $verb        = qr/(spv|v|V)erb [*]?                                                          /ix;
my $lst         = qr/lstinline (?!\*) $no_corchete                                              /ix;
my $mint        = qr/mint      (?!\*) $no_corchete $llaves                                      /ix;
my $marca       = qr/\\ (?:$verb | $lst | $mint ) (\S) .+? \g{-1}                               /x;
my $comentario  = qr/^ \s* \%+ .+? $                                                            /mx;
my $definedel   = qr/\\ (?:   DefineShortVerb | lstMakeShortInline  ) $no_corchete $delimitador /ix;
my $indefinedel = qr/\\ (?: UndefineShortVerb | lstDeleteShortInline) $llaves                   /ix;
 
while ($archivo =~
        /   $marca
        |   $comentario
        |   $definedel
        |   $indefinedel
        |   $del .+? $del                                                       # delimitado
        /pgmx) {
 
        my($pos_inicial, $pos_final) = ($-[0], $+[0]);                          # posiciones
        my $encontrado = ${^MATCH};                                             # lo encontrado
 
    if ($encontrado =~ /$definedel/){                                           # definimos delimitador
                        $del = $+{del};
                        $del = "\Q$+{del}" if substr($del,0,1) ne '\\';         # es necesario "escapar" el delimitador
                }
    elsif($encontrado =~ /$indefinedel/) {                                      # indefinimos delimitador
                 $del = $no_del;                                       
        }
    else {                                                                      # aquí se hacen los cambios
        while (my($busco, $cambio) = each %cambios) {
                       $encontrado =~ s/\Q$busco\E/$cambio/g;                   # es necesario escapar $busco
                        }
        substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;     # insertamos los nuevos cambios
 
        pos($archivo)= $pos_inicial + length $encontrado;                        # re posicionamos la siguiente búsqueda
        }
}
 
# Write 
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
   print   $SALIDA "$archivo";
close $SALIDA;
 
#--------------------- Coment Verbatim environment --------------------#
 
my @lineas;
{
   open my $FILE,'<',"$tempDir/$name-tmp$ext";
   @lineas = <$FILE>;
   close $FILE;
}
 
# Verbatim environments 
my $ENTORNO  = qr/(?: (v|V)erbatim\*?| PSTexample | LTXexample| $ignore\*? | PSTcode | tcblisting\*? | spverbatim | minted | lstlisting | alltt | comment\*? | xcomment)/xi;
 
# postscript environment 
my $POSTSCRIPT = qr/(?: postscript)/xi;
 
# tikzpicture environment 
my $TIKZENV    = qr/(?: tikzpicture)/xi;
#    
my $DEL;
# tcbverb verbatim
my $tcbverb = qr/\\(?:tcboxverb|myverb)/;
my $arg_brac = qr/(?:\[.+?\])?/;
 
my $arg_curl = qr/\{(.+)\}/;          
 
# coment verbatim environment
for (@lineas) {
    if (/\\begin\{($ENTORNO)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    }
} 
# coment tcolorbox inline
for (@lineas) {
    if (m/$tcbverb$arg_brac$arg_curl/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close 
 }
# remove postscript from hash
delete @cambios{'\begin{postscript}','\end{postscript}'}; 
# coment in postscript environment
for (@lineas) {
    if (/\\begin\{($POSTSCRIPT)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close postcript environment
}
# remove tikzpicture from hash
delete @cambios{'\begin{tikzpicture}','\end{tikzpicture}'}; 
# coment in tikzpicture environment
for (@lineas) {
    if (/\\begin\{($TIKZENV)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close TIKZ environment
}
 
# Write file
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print   $SALIDA @lineas;
close   $SALIDA;
 
############################# PARTE 2 ##################################
#------------- Convert ALL into Postscript environments ---------------#
open my $ENTRADA, '<', "$tempDir/$name-tmp$ext";
my $archivo;
{
    local $/;
    $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
## Partición del documento
 
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+?) (^\\begin{document} .+)(^\\end{document}.*)\z/msx;
 
# \pspicture to \begin{pspicture}
$cuerpo =~ s/\\pspicture(\*)?(.+?)\\endpspicture/\\begin{pspicture$1}$2\\end{pspicture$1}/gmsx;
 
# pspicture to Postscript
$cuerpo =~ s/
    (
        (?:\\psset\{[^\}]+\}.*?)?
        (?:\\begin\{pspicture(\*)?\})
                .*?
        (?:\\end\{pspicture(\*)?\})
    )
    /$BPL\n$1\n$EPL/gmsx;
 
# pgfpicture to Postscript
$cuerpo =~ s/
    (
        \\begin{$sipgf}
            .*?
            (
                \\begin{$nopgf}
                .+?
                \\end{$nopgf}
                .*?
            )*?
        \\end{$sipgf}
    )
    /$BPL\n$1\n$EPL/gmsx;
 
# tikz to Postscript
$cuerpo =~ s/
     (
        (?:\\tikzset(\{(?:\{.*?\}|[^\{])*\}).*?)? # si está lo guardo
              (?:\\begin\{tikzpicture\})       # aquí comienza la búsqueda
                            .*?                # guardo el contenido en $1
                    (?:\\end\{tikzpicture\})   # termina la búsqueda
                ) # cierra $1
                /$BPL\n$1\n$EPL/gmsx;
 
# rest to Postscript
my $export  = qr/(forest|ganttchart|tikzcd|circuitikz|dependency|$other\*?)/x;
 
$cuerpo =~ s/(\\begin\{($export)\} (.*?)  \\end\{\g{-2}\})/$BPL\n$1\n$EPL/gmsx;
 
# Write 
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
   print   $SALIDA "$cabeza$cuerpo$final";
close $SALIDA;
 
 
##---------------------------- PARTE 3 -------------------------------##
#-------------------------- Reverse changes ---------------------------#
 
my %cambios = (
# pst/tikz set    
    '\PSSET'                    =>      '\psset',
    '\TIKZSET'                  =>      '\tikzset',                     
# pspicture    
    '\TRICKS'                   =>      '\pspicture',
    '\ENDTRICKS'                =>      '\endpspicture',             
# pspicture
    '\begin{TRICKS'             =>      '\begin{pspicture',
    '\end{TRICKS'               =>      '\end{pspicture',
# $other    
    '\begin{OTHER'              =>      "\\begin\{$other",              
    '\end{OTHER'                =>      "\\end\{$other",
# document
    '\begin{DOCTRICKS}'         =>      '\begin{document}',
    '\end{DOCTRICKS}'           =>      '\end{document}',
# tikzpicture
    '\begin{TIKZPICTURE}'       =>      '\begin{tikzpicture}',
    '\end{TIKZPICTURE}'         =>      '\end{tikzpicture}',
# pgfinterruptpicture
    '\begin{PGFINTERRUPTPICTURE'=>      '\begin{pgfinterruptpicture',
    '\end{PGFINTERRUPTPICTURE'  =>      '\end{pgfinterruptpicture',
# pgfpicture
    '\begin{PGFPICTURE}'        =>      '\begin{pgfpicture}',
    '\end{PGFPICTURE}'          =>      '\end{pgfpicture}',
# ganttchart
    '\begin{GANTTCHART}'        =>      '\begin{ganttchart}',
    '\end{GANTTCHART}'          =>      '\end{ganttchart}',
# circuitikz
    '\begin{CIRCUITIKZ}'        =>      '\begin{circuitikz}',
    '\end{CIRCUITIKZ}'          =>      '\end{circuitikz}',
# forest     
    '\begin{FOREST}'            =>      '\begin{forest}',
    '\end{FOREST}'              =>      '\end{forest}',
# tikzcd 
    '\begin{TIKZCD}'            =>      '\begin{tikzcd}',
    '\end{TIKZCD}'              =>      '\end{tikzcd}',
# dependency
    '\begin{DEPENDENCY}'        =>      '\begin{dependency}',
    '\end{DEPENDENCY}'          =>      '\end{dependency}',
);
 
#-------------------------- Back Postscript ---------------------------#
my @lineas;
{
   open my $FILE,'<',"$tempDir/$name-tmp$ext";
   @lineas = <$FILE>;
   close $FILE;
}
# reverse in postscript environment
for (@lineas) {
    if (/\\begin\{($POSTSCRIPT)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close postscript environment changes
}
    
# Write 
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print   $SALIDA @lineas;
close   $SALIDA;
 
##---------------------------- PARTE 4 -------------------------------##
#--------------- Extract source code for PST/PGF/TIKZ -----------------#
open my $ENTRADA, '<',"$tempDir/$name-tmp$ext";
my $archivo;
{
    local $/;
    $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
# Dividir el archivo 
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+?) (^\\begin{document} .+)(^\\end{document}.*)\z/msx;
 
$cabeza .= <<"EXTRA";
\\newenvironment{postscript}{}{}
\\pagestyle{empty}
EXTRA
 
# Poner el atributo añadido a PostScript
while ($cuerpo =~ /\\begin\{postscript\}/gsm) {
 
    my $corchetes = $1;
    my($pos_inicial, $pos_final) = ($-[1], $+[1]);      # posición donde están los corchetes
 
    if (not $corchetes) {
        $pos_inicial = $pos_final = $+[0];              # si no hay corchetes, nos ponemos al final de \begin
    }
    if (not $corchetes  or  $corchetes =~ /\[\s*\]/) {  # si no hay corchetes, o están vacíos,
        $corchetes = "[$graphics-$exacount}]";          # ponemos los nuestros
    }
    substr($cuerpo, $pos_inicial, $pos_final - $pos_inicial) = $corchetes;    
    pos($cuerpo) = $pos_inicial + length $corchetes;    # reposicionamos la búsqueda de la exp. reg.
}
continue {
    $exacount++;
}
 
#---------------------- Extract source code in images -----------------#
while ($cuerpo =~ /$BP\[.+?(?<img_src_name>$imageDir\/.+?-\d+)\}\](?<code>.+?)(?=^$EP)/gsm) {
    open my $SALIDA, '>', "$+{'img_src_name'}$ext";
    print $SALIDA <<"EOC";
$cabeza\\begin{document}$+{'code'}\\end{document}
EOC
close $SALIDA;
}
 
__END__
Coloreado en 0.011 segundos,  usando GeSHi 1.0.8.4

Después de mucho pensar en el asunto de los anidados (son realmente un dolor de cabeza) me decidí por atacar el problema desde otro punto de vista:

Creo un hash con las palabras que deseo cambiar dentro de líneas que me dan problemas y recorro todo el archivo haciendo los cambios y lo guardo.
Como tengo varios entornos donde no deseo hacer cambios (postscript, y tikzpicture}), leo el archivo por líneas y usando for y quitando algunas claves del hash hago los cambios dentro de lo que no deseo modificar y guardo el archivo.
Vuelvo a abrir el archivo y con expresiones regulares modifico lo que me interesa, ya no tengo anidados, puesto que modifiqué las palabras que me interferían y lo vuelvo a guardar.
Creo un nuevo hash para volver las palabras a la normalidad solo dentro de \begin{postscript} ... \end{postscript} y lo guardo. Ahora está todo como lo deseo.
Vuelvo a abrir el archivo y extraigo lo que me interesa.

Agradezco enormemente a explorer y a los distintos usuarios que escriben en el foro, revisar soluciones de otros asuntos ayuda bastante.
Saludos.

# Write
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
   print   $SALIDA "$archivo";
close $SALIDA;
 
#--------------------- Coment Verbatim environment --------------------#
 
my @lineas;
{
   open my $FILE,'<',"$tempDir/$name-tmp$ext";
   @lineas = <$FILE>;
   close $FILE;
}
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

se puede reducir a

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my @lineas = split /\n/, $archivo;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **pablgonz** » 2015-01-04 11:19 @513

Con el cambio que me propones ya no funciona, con el script así:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use v5.18;
use re 'eval';
use autodie;                    # muere si ocurre un error
use File::Basename;             # separa el archivo de entrada
use Config;
 
# Constantes
my $tempDir = ".";              # temporary directory
my $imageDir = "images";        # where to save the images
my $ignore = "ignore";          # ignore verbatim environment
my $exacount = 1;               # Counter for images
my $other = "other";            # otro entorno
#--------------------- Arreglo de la extensión -------------------------
my @SuffixList = ('.tex', '', '.ltx');               # posible extensión
my ($name, $path, $ext) = fileparse($ARGV[0], @SuffixList);
$ext = '.tex' if not $ext;
 
#---------------- Creamos el directorio para las imágenes --------------
-e $imageDir or mkdir($imageDir,0744) or die "No puedo crear $imageDir: $!\n";
# Constantes para regex
my $BP = '\\\\begin{postscript}';
my $EP = '\\\\end{postscript}';
my $BPL = '\begin{postscript}';
my $EPL = '\end{postscript}';
my $sipgf = 'pgfpicture';
my $nopgf = 'pgfinterruptpicture';
my $graphics = "graphic=\{\[scale=1\]$imageDir/$name-fig";
 
#------------ Creamos un hash con los cambios para verbatim -----------#
my %cambios = (
# pst/tikz set    
    '\psset'                    => '\PSSET',
    '\tikzset'                  => '\TIKZSET',
# pspicture    
    '\pspicture'                => '\TRICKS',
    '\endpspicture'             => '\ENDTRICKS',
# pspicture
    '\begin{pspicture'          => '\begin{TRICKS',
    '\end{pspicture'            => '\end{TRICKS',
# postscript
    '\begin{postscript}'        => '\begin{POSTRICKS}',
    '\end{postscript}'          => '\end{POSTRICKS}',
# $other    
    "\\begin\{$other"           => '\begin{OTHER',
    "\\end\{$other"             => '\end{OTHER',
# document
    '\begin{document}'          => '\begin{DOCTRICKS}',
    '\end{document}'            => '\end{DOCTRICKS}',
# tikzpicture
    '\begin{tikzpicture}'       => '\begin{TIKZPICTURE}',
    '\end{tikzpicture}'         => '\end{TIKZPICTURE}',
# pgfinterruptpicture
    '\begin{pgfinterruptpicture'=> '\begin{PGFINTERRUPTPICTURE',
    '\end{pgfinterruptpicture'  => '\end{PGFINTERRUPTPICTURE',
# pgfpicture
    '\begin{pgfpicture}'        => '\begin{PGFPICTURE}',
    '\end{pgfpicture}'          => '\end{PGFPICTURE}',
# ganttchart
    '\begin{ganttchart}'        => '\begin{GANTTCHART}',
    '\end{ganttchart}'          => '\end{GANTTCHART}',
# circuitikz
    '\begin{circuitikz}'        => '\begin{CIRCUITIKZ}',
    '\end{circuitikz}'          => '\end{CIRCUITIKZ}',
# forest     
    '\begin{forest}'            => '\begin{FOREST}',
    '\end{forest}'              => '\end{FOREST}',
# tikzcd 
    '\begin{tikzcd}'            => '\begin{TIKZCD}',
    '\end{tikzcd}'              => '\end{TIKZCD}',
# dependency
    '\begin{dependency}'        => '\begin{DEPENDENCY}',
    '\end{dependency}'          => '\end{DEPENDENCY}',
);
 
#------------------------ Coment inline Verbatim ----------------------#
open my $ENTRADA, '<', "$name$ext";
my $archivo;
{
    local $/;
    $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
# Variables y constantes
my $no_del = "\0";
my $del    = $no_del;
 
# Reglas
my $llaves      = qr/\{ .+? \}                                                                  /x;
my $no_corchete = qr/(?:\[ .+? \])?                                                             /x;
my $delimitador = qr/\{ (?<del>.+?) \}                                                          /x;
my $verb        = qr/(spv|v|V)erb [*]?                                                          /ix;
my $lst         = qr/lstinline (?!\*) $no_corchete                                              /ix;
my $mint        = qr/mint      (?!\*) $no_corchete $llaves                                      /ix;
my $marca       = qr/\\ (?:$verb | $lst | $mint ) (\S) .+? \g{-1}                               /x;
my $comentario  = qr/^ \s* \%+ .+? $                                                            /mx;
my $definedel   = qr/\\ (?:   DefineShortVerb | lstMakeShortInline  ) $no_corchete $delimitador /ix;
my $indefinedel = qr/\\ (?: UndefineShortVerb | lstDeleteShortInline) $llaves                   /ix;
 
while ($archivo =~
        /   $marca
        |   $comentario
        |   $definedel
        |   $indefinedel
        |   $del .+? $del                                                       # delimitado
        /pgmx) {
 
        my($pos_inicial, $pos_final) = ($-[0], $+[0]);                          # posiciones
        my $encontrado = ${^MATCH};                                             # lo encontrado
 
    if ($encontrado =~ /$definedel/){                                           # definimos delimitador
                        $del = $+{del};
                        $del = "\Q$+{del}" if substr($del,0,1) ne '\\';         # es necesario "escapar" el delimitador
                }
    elsif($encontrado =~ /$indefinedel/) {                                      # indefinimos delimitador
                 $del = $no_del;                                       
        }
    else {                                                                      # aquí se hacen los cambios
        while (my($busco, $cambio) = each %cambios) {
                       $encontrado =~ s/\Q$busco\E/$cambio/g;                   # es necesario escapar $busco
                        }
        substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;     # insertamos los nuevos cambios
 
        pos($archivo)= $pos_inicial + length $encontrado;                        # re posicionamos la siguiente búsqueda
        }
}
 
# Write 
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
   print   $SALIDA "$archivo";
close $SALIDA;
 
#--------------------- Coment Verbatim environment --------------------#
 
my @lineas;
{
   open my $FILE,'<',"$tempDir/$name-tmp$ext";
   @lineas = <$FILE>;
   close $FILE;
}
 
# Verbatim environments 
my $ENTORNO  = qr/(?: (v|V)erbatim\*?| PSTexample | LTXexample| $ignore\*? | PSTcode | tcblisting\*? | spverbatim | minted | lstlisting | alltt | comment\*? | xcomment)/xi;
 
# postscript environment 
my $POSTSCRIPT = qr/(?: postscript)/xi;
 
# tikzpicture environment 
my $TIKZENV    = qr/(?: tikzpicture)/xi;
#    
my $DEL;
# tcbverb verbatim
my $tcbverb = qr/\\(?:tcboxverb|myverb)/;
my $arg_brac = qr/(?:\[.+?\])?/;
my $arg_curl = qr/\{(.+)\}/;          
 
# coment verbatim environment
for (@lineas) {
    if (/\\begin\{($ENTORNO)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    }
} 
# coment tcolorbox inline
for (@lineas) {
    if (m/$tcbverb$arg_brac$arg_curl/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close 
 }
# remove postscript from hash
delete @cambios{'\begin{postscript}','\end{postscript}'}; 
# coment in postscript environment
for (@lineas) {
    if (/\\begin\{($POSTSCRIPT)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close postcript environment
}
# remove tikzpicture from hash
delete @cambios{'\begin{tikzpicture}','\end{tikzpicture}'}; 
# coment in tikzpicture environment
for (@lineas) {
    if (/\\begin\{($TIKZENV)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close TIKZ environment
}
 
# Write file
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print   $SALIDA @lineas;
close   $SALIDA;
 
##--------------------------- PARTE 2 --------------------------------##
#------------- Convert ALL into Postscript environments ---------------#
open my $ENTRADA, '<', "$tempDir/$name-tmp$ext";
my $archivo;
{
    local $/;
    $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
## Partición del documento
 
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+?) (^\\begin{document} .+)(^\\end{document}.*)\z/msx;
 
# \pspicture to \begin{pspicture}
$cuerpo =~ s/\\pspicture(\*)?(.+?)\\endpspicture/\\begin{pspicture$1}$2\\end{pspicture$1}/gmsx;
 
# pspicture to Postscript
$cuerpo =~ s/
    (
        (?:\\psset\{[^\}]+\}.*?)?
        (?:\\begin\{pspicture(\*)?\})
                .*?
        (?:\\end\{pspicture(\*)?\})
    )
    /$BPL\n$1\n$EPL/gmsx;
 
# pgfpicture to Postscript
$cuerpo =~ s/
    (
        \\begin{$sipgf}
            .*?
            (
                \\begin{$nopgf}
                .+?
                \\end{$nopgf}
                .*?
            )*?
        \\end{$sipgf}
    )
    /$BPL\n$1\n$EPL/gmsx;
 
# tikz to Postscript
$cuerpo =~ s/
     (
        (?:\\tikzset(\{(?:\{.*?\}|[^\{])*\}).*?)? # si está lo guardo
              (?:\\begin\{tikzpicture\})       # aquí comienza la búsqueda
                            .*?                # guardo el contenido en $1
                    (?:\\end\{tikzpicture\})   # termina la búsqueda
                ) # cierra $1
                /$BPL\n$1\n$EPL/gmsx;
 
# rest to Postscript
my $export  = qr/(forest|ganttchart|tikzcd|circuitikz|dependency|$other\*?)/x;
 
$cuerpo =~ s/(\\begin\{($export)\} (.*?)  \\end\{\g{-2}\})/$BPL\n$1\n$EPL/gmsx;
 
# Write 
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
   print   $SALIDA "$cabeza$cuerpo$final";
close $SALIDA;
 
##---------------------------- PARTE 3 -------------------------------##
#-------------------------- Reverse changes ---------------------------#
my %cambios = (
# pst/tikz set    
    '\PSSET'                    =>      '\psset',
    '\TIKZSET'                  =>      '\tikzset',                     
# pspicture    
    '\TRICKS'                   =>      '\pspicture',
    '\ENDTRICKS'                =>      '\endpspicture',             
# pspicture
    '\begin{TRICKS'             =>      '\begin{pspicture',
    '\end{TRICKS'               =>      '\end{pspicture',
# $other    
    '\begin{OTHER'              =>      "\\begin\{$other",              
    '\end{OTHER'                =>      "\\end\{$other",
# document
    '\begin{DOCTRICKS}'         =>      '\begin{document}',
    '\end{DOCTRICKS}'           =>      '\end{document}',
# tikzpicture
    '\begin{TIKZPICTURE}'       =>      '\begin{tikzpicture}',
    '\end{TIKZPICTURE}'         =>      '\end{tikzpicture}',
# pgfinterruptpicture
    '\begin{PGFINTERRUPTPICTURE'=>      '\begin{pgfinterruptpicture',
    '\end{PGFINTERRUPTPICTURE'  =>      '\end{pgfinterruptpicture',
# pgfpicture
    '\begin{PGFPICTURE}'        =>      '\begin{pgfpicture}',
    '\end{PGFPICTURE}'          =>      '\end{pgfpicture}',
# ganttchart
    '\begin{GANTTCHART}'        =>      '\begin{ganttchart}',
    '\end{GANTTCHART}'          =>      '\end{ganttchart}',
# circuitikz
    '\begin{CIRCUITIKZ}'        =>      '\begin{circuitikz}',
    '\end{CIRCUITIKZ}'          =>      '\end{circuitikz}',
# forest     
    '\begin{FOREST}'            =>      '\begin{forest}',
    '\end{FOREST}'              =>      '\end{forest}',
# tikzcd 
    '\begin{TIKZCD}'            =>      '\begin{tikzcd}',
    '\end{TIKZCD}'              =>      '\end{tikzcd}',
# dependency
    '\begin{DEPENDENCY}'        =>      '\begin{dependency}',
    '\end{DEPENDENCY}'          =>      '\end{dependency}',
);
 
#-------------------------- Back Postscript ---------------------------#
my @lineas;
{
   open my $FILE,'<',"$tempDir/$name-tmp$ext";
   @lineas = <$FILE>;
   close $FILE;
}
# reverse in postscript environment
for (@lineas) {
    if (/\\begin\{($POSTSCRIPT)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
        while (my($busco, $cambio) = each %cambios) {
            s/\Q$busco\E/$cambio/g;
        }
    } # close postscript environment changes
}
    
# Write 
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print   $SALIDA @lineas;
close   $SALIDA;
 
##---------------------------- PARTE 4 -------------------------------##
#--------------- Extract source code for PST/PGF/TIKZ -----------------#
open my $ENTRADA, '<',"$tempDir/$name-tmp$ext";
my $archivo;
{
    local $/;
    $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
# Dividir el archivo 
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+?) (^\\begin{document} .+)(^\\end{document}.*)\z/msx;
 
$cabeza .= <<"EXTRA";
\\pagestyle{empty}
EXTRA
 
# Poner el atributo añadido a PostScript
while ($cuerpo =~ /\\begin\{postscript\}/gsm) {
 
    my $corchetes = $1;
    my($pos_inicial, $pos_final) = ($-[1], $+[1]);      # posición donde están los corchetes
 
    if (not $corchetes) {
        $pos_inicial = $pos_final = $+[0];              # si no hay corchetes, nos ponemos al final de \begin
    }
    if (not $corchetes  or  $corchetes =~ /\[\s*\]/) {  # si no hay corchetes, o están vacíos,
        $corchetes = "[$graphics-$exacount}]";          # ponemos los nuestros
    }
    substr($cuerpo, $pos_inicial, $pos_final - $pos_inicial) = $corchetes;    
    pos($cuerpo) = $pos_inicial + length $corchetes;    # reposicionamos la búsqueda de la exp. reg.
}
continue {
    $exacount++;
}
 
#---------------------- Extract source code in images -----------------#
while ($cuerpo =~ /$BP\[.+?(?<img_src_name>$imageDir\/.+?-\d+)\}\](?<code>.+?)(?=^$EP)/gsm) {
    open my $SALIDA, '>', "$+{'img_src_name'}$ext";
    print $SALIDA <<"EOC";
$cabeza\\begin{document}$+{'code'}\\end{document}
EOC
close $SALIDA;
}
 
__END__
Coloreado en 0.010 segundos,  usando GeSHi 1.0.8.4

Teniendo este archivo de entrada:

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

\documentclass{article}
% Las líneas que están en
% éste sector no deben modificarse
\usepackage{pst-all} 
\usepackage[siunitx]{circuitikz}
\begin{document}
Lo que sigue no debe quedar dentro de Postscript
\begin{verbatim}
\begin{tikzpicture}
code
\end{tikzpicture}
\end{verbatim}
 
Lo que sigue no debe quedar dentro de Postscript
\begin{verbatim}
\begin{pspicture}(-11,0)(11,0)  
code
\end{pspicture} 
\end{verbatim}
 
Cambiamos ésta línea \verb|\begin{pspicture*} o \begin{tikzpicture} \begin{other}|
y lo que sigue a mayuscula
%\begin{tikzpicture}
% code
%\end{tikzpicture}
 
Este entono no debe quedar anidado
\begin{postscript} 
\psset{code} 
\begin{pspicture}(-11,0)(11,0)  
code
\end{pspicture} 
\end{postscript} 
 
Este entono no debe quedar anidado
\begin{postscript}
\begin{tikzpicture}[scale=2]
code
\end{tikzpicture}
\end{postscript}
 
Esto debe quedar dentro de Postscript
\begin{tikzpicture}
code
\end{tikzpicture}
 
Esto debe quedar dentro de Postscript
\psset{xunit=0.5cm, yunit=0.5cm, yAxis=false} 
\begin{pspicture}(-11,0)(11,0)  
\psaxes[Dx=5, subticks=5]{<->}(0,0)(-11,0)(11,0) 
\psline[linewidth=3pt, linecolor=cyan]{o->}(-2,0)(11,0) 
\end{pspicture}
 
Este entono no debe quedar anidado
\begin{postscript}
\begin{tikzcd}
\shadedraw [shading=ball] (0,0) circle (2cm);
\end{tikzcd}
\end{postscript} 
 
Este entono no debe quedar anidado dentro de PostScript
\begin{tikzpicture}
\begin{circuitikz}
code
\end{circuitikz}
\end{tikzpicture} 
 
Esto debe quedar dentro de Postscript
\begin{circuitikz}
code
\end{circuitikz}
 
Final del test
\end{document}
No tocar 
\begin{pspicture}(-11,0)(11,0)  
code
\end{pspicture}
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

obtengo éste archivo de salida:

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

\documentclass{article}
% Las líneas que están en
% éste sector no deben modificarse
\usepackage{pst-all} 
\usepackage[siunitx]{circuitikz}
\begin{document}
Lo que sigue no debe quedar dentro de Postscript
\begin{verbatim}
\begin{TIKZPICTURE}
code
\end{TIKZPICTURE}
\end{verbatim}
 
Lo que sigue no debe quedar dentro de Postscript
\begin{verbatim}
\begin{TRICKS}(-11,0)(11,0)     
code
\end{TRICKS} 
\end{verbatim}
 
Cambiamos ésta línea \verb|\begin{TRICKS*} o \begin{TIKZPICTURE} \begin{OTHER}|
y lo que sigue a mayuscula
%\begin{TIKZPICTURE}
% code
%\end{TIKZPICTURE}
 
Este entono no debe quedar anidado
\begin{postscript} 
\psset{code} 
\begin{pspicture}(-11,0)(11,0)  
code
\end{pspicture} 
\end{postscript} 
 
Este entono no debe quedar anidado
\begin{postscript}
\begin{tikzpicture}[scale=2]
code
\end{tikzpicture}
\end{postscript}
 
Esto debe quedar dentro de Postscript
\begin{postscript}
\begin{tikzpicture}
code
\end{tikzpicture}
\end{postscript}
 
Esto debe quedar dentro de Postscript
\begin{postscript}
\psset{xunit=0.5cm, yunit=0.5cm, yAxis=false} 
\begin{pspicture}(-11,0)(11,0)  
\psaxes[Dx=5, subticks=5]{<->}(0,0)(-11,0)(11,0) 
\psline[linewidth=3pt, linecolor=cyan]{o->}(-2,0)(11,0) 
\end{pspicture}
\end{postscript}
 
Este entono no debe quedar anidado
\begin{postscript}
\begin{tikzcd}
\shadedraw [shading=ball] (0,0) circle (2cm);
\end{tikzcd}
\end{postscript} 
 
Este entono no debe quedar anidado dentro de PostScript
\begin{postscript}
\begin{tikzpicture}
\begin{circuitikz}
code
\end{circuitikz}
\end{tikzpicture}
\end{postscript} 
 
Esto debe quedar dentro de Postscript
\begin{postscript}
\begin{circuitikz}
code
\end{circuitikz}
\end{postscript}
 
Final del test
\end{document}
No tocar 
\begin{pspicture}(-11,0)(11,0)  
code
\end{pspicture}
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Es decir, todo lo que me interesa está dentro de \begin{postscript} ... \end{postscript}.
Quizás se puede hacer más corto y reducir la cantidad de veces que abro y cierro el archivo. A final deseo agregar

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my $grap="\\includegraphics[scale=1]{$name-fig-";
my $close = '}';
my $IMGno = 1;
$cuerpo =~ s/$BP.+?$EP/$grap.$IMGno++.$close/gemsx;
print $cuerpo;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

para crear un archivo en el cual TODOS los \begin{postscript} ... \end{postscript} se cambien por \includegraphics[scale=1]{$name-fig-1}, \includegraphics[scale=1]{$name-fig-2}, etc.
Saludos

por **pablgonz** » 2015-01-04 20:52 @911

Le di vueltas toda la tarde, pero no pude reducir la cantidad de veces que abro y cierro el archivo. Esta es la versión final:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use v5.18;
use re 'eval';
use autodie;                    # muere si ocurre un error
use File::Basename;             # separa el archivo de entrada
use Config;
 
# Constantes
my $tempDir = ".";              # temporary directory
my $imageDir = "images";        # where to save the images
my $ignore = "ignore";          # ignore verbatim environment
my $exacount = 1;               # Counter for images
my $other = "other";            # otro entorno
#--------------------- Arreglo de la extensión -------------------------
my @SuffixList = ('.tex', '', '.ltx');               # posible extensión
my ($name, $path, $ext) = fileparse($ARGV[0], @SuffixList);
$ext = '.tex' if not $ext;
 
#---------------- Creamos el directorio para las imágenes --------------
-e $imageDir or mkdir($imageDir,0744) or die "No puedo crear $imageDir: $!\n";
# Constantes para regex
my $BP = '\\\\begin{postscript}';
my $EP = '\\\\end{postscript}';
my $BPL = '\begin{postscript}';
my $EPL = '\end{postscript}';
my $sipgf = 'pgfpicture';
my $nopgf = 'pgfinterruptpicture';
my $graphics = "graphic=\{\[scale=1\]$imageDir/$name-fig";
 
#------------ Creamos un hash con los cambios para verbatim -----------#
my %cambios = (
# pst/tikz set    
        '\psset'                    => '\PSSET',
        '\tikzset'                  => '\TIKZSET',
# pspicture    
        '\pspicture'                => '\TRICKS',
        '\endpspicture'             => '\ENDTRICKS',
# pspicture
        '\begin{pspicture'          => '\begin{TRICKS',
        '\end{pspicture'            => '\end{TRICKS',
# postscript
        '\begin{postscript}'        => '\begin{POSTRICKS}',
        '\end{postscript}'          => '\end{POSTRICKS}',
# $other    
        "\\begin\{$other"           => '\begin{OTHER',
        "\\end\{$other"             => '\end{OTHER',
# document
        '\begin{document}'          => '\begin{DOCTRICKS}',
        '\end{document}'            => '\end{DOCTRICKS}',
# tikzpicture
        '\begin{tikzpicture}'       => '\begin{TIKZPICTURE}',
        '\end{tikzpicture}'         => '\end{TIKZPICTURE}',
# pgfinterruptpicture
        '\begin{pgfinterruptpicture'=> '\begin{PGFINTERRUPTPICTURE',
        '\end{pgfinterruptpicture'  => '\end{PGFINTERRUPTPICTURE',
# pgfpicture
        '\begin{pgfpicture}'        => '\begin{PGFPICTURE}',
        '\end{pgfpicture}'          => '\end{PGFPICTURE}',
# ganttchart
        '\begin{ganttchart}'        => '\begin{GANTTCHART}',
        '\end{ganttchart}'          => '\end{GANTTCHART}',
# circuitikz
        '\begin{circuitikz}'        => '\begin{CIRCUITIKZ}',
        '\end{circuitikz}'          => '\end{CIRCUITIKZ}',
# forest    
        '\begin{forest}'            => '\begin{FOREST}',
        '\end{forest}'              => '\end{FOREST}',
# tikzcd
        '\begin{tikzcd}'            => '\begin{TIKZCD}',
        '\end{tikzcd}'              => '\end{TIKZCD}',
# dependency
        '\begin{dependency}'        => '\begin{DEPENDENCY}',
        '\end{dependency}'          => '\end{DEPENDENCY}',
);
 
#------------------------ Coment inline Verbatim ----------------------#
open my $ENTRADA, '<', "$name$ext";
my $archivo;
{
        local $/;
        $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
# Variables y constantes
my $no_del = "\0";
my $del    = $no_del;
 
# Reglas
my $llaves      = qr/\{ .+? \}                                                                  /x;
my $no_corchete = qr/(?:\[ .+? \])?                                                             /x;
my $delimitador = qr/\{ (?<del>.+?) \}                                                          /x;
my $verb        = qr/(spv|v|V)erb [*]?                                                          /ix;
my $lst         = qr/lstinline (?!\*) $no_corchete                                              /ix;
my $mint        = qr/mint      (?!\*) $no_corchete $llaves                                      /ix;
my $marca       = qr/\\ (?:$verb | $lst | $mint ) (\S) .+? \g{-1}                               /x;
my $comentario  = qr/^ \s* \%+ .+? $                                                            /mx;
my $definedel   = qr/\\ (?:   DefineShortVerb | lstMakeShortInline  ) $no_corchete $delimitador /ix;
my $indefinedel = qr/\\ (?: UndefineShortVerb | lstDeleteShortInline) $llaves                   /ix;
 
while ($archivo =~
                /   $marca
                |   $comentario
                |   $definedel
                |   $indefinedel
                |   $del .+? $del                                                       # delimitado
                /pgmx) {
 
                my($pos_inicial, $pos_final) = ($-[0], $+[0]);                          # posiciones
                my $encontrado = ${^MATCH};                                             # lo encontrado
 
        if ($encontrado =~ /$definedel/){                                           # definimos delimitador
                                                $del = $+{del};
                                                $del = "\Q$+{del}" if substr($del,0,1) ne '\\';         # es necesario "escapar" el delimitador
                                }
        elsif($encontrado =~ /$indefinedel/) {                                      # indefinimos delimitador
                                 $del = $no_del;                                      
                }
        else {                                                                      # aquí se hacen los cambios
                while (my($busco, $cambio) = each %cambios) {
                                           $encontrado =~ s/\Q$busco\E/$cambio/g;                   # es necesario escapar $busco
                                                }
                substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado;     # insertamos los nuevos cambios
 
                pos($archivo)= $pos_inicial + length $encontrado;                        # re posicionamos la siguiente búsqueda
                }
}
 
# Write
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
   print   $SALIDA "$archivo";
close $SALIDA;
 
#--------------------- Coment Verbatim environment --------------------#
 
my @lineas;
{
   open my $FILE,'<',"$tempDir/$name-tmp$ext";
   @lineas = <$FILE>;
   close $FILE;
}
 
# Verbatim environments
my $ENTORNO  = qr/(?: (v|V)erbatim\*?| PSTexample | LTXexample| $ignore\*? | PSTcode | tcblisting\*? | spverbatim | minted | lstlisting | alltt | comment\*? | xcomment)/xi;
 
# postscript environment
my $POSTSCRIPT = qr/(?: postscript)/xi;
 
# tikzpicture environment
my $TIKZENV    = qr/(?: tikzpicture)/xi;
#    
my $DEL;
# tcbverb verbatim
my $tcbverb = qr/\\(?:tcboxverb|myverb)/;
my $arg_brac = qr/(?:\[.+?\])?/;
my $arg_curl = qr/\{(.+)\}/;          
 
# coment verbatim environment
for (@lineas) {
        if (/\\begin\{($ENTORNO)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
                while (my($busco, $cambio) = each %cambios) {
                        s/\Q$busco\E/$cambio/g;
                }
        }
}
# coment tcolorbox inline
for (@lineas) {
        if (m/$tcbverb$arg_brac$arg_curl/) {
                while (my($busco, $cambio) = each %cambios) {
                        s/\Q$busco\E/$cambio/g;
                }
        } # close
 }
# remove postscript from hash
delete @cambios{'\begin{postscript}','\end{postscript}'};
# coment in postscript environment
for (@lineas) {
        if (/\\begin\{($POSTSCRIPT)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
                while (my($busco, $cambio) = each %cambios) {
                        s/\Q$busco\E/$cambio/g;
                }
        } # close postcript environment
}
# remove tikzpicture from hash
delete @cambios{'\begin{tikzpicture}','\end{tikzpicture}'};
# coment in tikzpicture environment
for (@lineas) {
        if (/\\begin\{($TIKZENV)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
                while (my($busco, $cambio) = each %cambios) {
                        s/\Q$busco\E/$cambio/g;
                }
        } # close TIKZ environment
}
 
# Write file
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print   $SALIDA @lineas;
close   $SALIDA;
 
##--------------------------- PARTE 2 --------------------------------##
#------------- Convert ALL into Postscript environments ---------------#
open my $ENTRADA, '<', "$tempDir/$name-tmp$ext";
my $archivo;
{
        local $/;
        $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
## Partición del documento
 
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+?) (\\begin{document} .+?)(\\end{document}.*)\z/msx;
 
# \pspicture to \begin{pspicture}
$cuerpo =~ s/\\pspicture(\*)?(.+?)\\endpspicture/\\begin{pspicture$1}$2\\end{pspicture$1}/gmsx;
 
# pspicture to Postscript
$cuerpo =~ s/
        (
                (?:\\psset\{[^\}]+\}.*?)?
                (?:\\begin\{pspicture(\*)?\})
                                .*?
                (?:\\end\{pspicture(\*)?\})
        )
        /$BPL\n$1\n$EPL/gmsx;
 
# pgfpicture to Postscript
$cuerpo =~ s/
        (
                \\begin{$sipgf}
                        .*?
                        (
                                \\begin{$nopgf}
                                .+?
                                \\end{$nopgf}
                                .*?
                        )*?
                \\end{$sipgf}
        )
        /$BPL\n$1\n$EPL/gmsx;
 
# tikz to Postscript
$cuerpo =~ s/
         (
                (?:\\tikzset(\{(?:\{.*?\}|[^\{])*\}).*?)? # si está lo guardo
                          (?:\\begin\{tikzpicture\})       # aquí comienza la búsqueda
                                                        .*?                # guardo el contenido en $1
                                        (?:\\end\{tikzpicture\})   # termina la búsqueda
                                ) # cierra $1
                                /$BPL\n$1\n$EPL/gmsx;
 
# rest to Postscript
my $export  = qr/(forest|ganttchart|tikzcd|circuitikz|dependency|$other\*?)/x;
 
$cuerpo =~ s/(\\begin\{($export)\} (.*?)  \\end\{\g{-2}\})/$BPL\n$1\n$EPL/gmsx;
 
# Write
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
   print   $SALIDA "$cabeza$cuerpo$final";
close $SALIDA;
 
##---------------------------- PARTE 3 -------------------------------##
#-------------------------- Reverse changes ---------------------------#
my %cambios = (
# pst/tikz set    
        '\PSSET'                    =>      '\psset',
        '\TIKZSET'                  =>      '\tikzset',                    
# pspicture    
        '\TRICKS'                   =>      '\pspicture',
        '\ENDTRICKS'                =>      '\endpspicture',            
# pspicture
        '\begin{TRICKS'             =>      '\begin{pspicture',
        '\end{TRICKS'               =>      '\end{pspicture',
# $other    
        '\begin{OTHER'              =>      "\\begin\{$other",             
        '\end{OTHER'                =>      "\\end\{$other",
# document
        '\begin{DOCTRICKS}'         =>      '\begin{document}',
        '\end{DOCTRICKS}'           =>      '\end{document}',
# tikzpicture
        '\begin{TIKZPICTURE}'       =>      '\begin{tikzpicture}',
        '\end{TIKZPICTURE}'         =>      '\end{tikzpicture}',
# pgfinterruptpicture
        '\begin{PGFINTERRUPTPICTURE'=>      '\begin{pgfinterruptpicture',
        '\end{PGFINTERRUPTPICTURE'  =>      '\end{pgfinterruptpicture',
# pgfpicture
        '\begin{PGFPICTURE}'        =>      '\begin{pgfpicture}',
        '\end{PGFPICTURE}'          =>      '\end{pgfpicture}',
# ganttchart
        '\begin{GANTTCHART}'        =>      '\begin{ganttchart}',
        '\end{GANTTCHART}'          =>      '\end{ganttchart}',
# circuitikz
        '\begin{CIRCUITIKZ}'        =>      '\begin{circuitikz}',
        '\end{CIRCUITIKZ}'          =>      '\end{circuitikz}',
# forest    
        '\begin{FOREST}'            =>      '\begin{forest}',
        '\end{FOREST}'              =>      '\end{forest}',
# tikzcd
        '\begin{TIKZCD}'            =>      '\begin{tikzcd}',
        '\end{TIKZCD}'              =>      '\end{tikzcd}',
# dependency
        '\begin{DEPENDENCY}'        =>      '\begin{dependency}',
        '\end{DEPENDENCY}'          =>      '\end{dependency}',
);
 
#-------------------------- Back Postscript ---------------------------#
my @lineas;
{
   open my $FILE,'<',"$tempDir/$name-tmp$ext";
   @lineas = <$FILE>;
   close $FILE;
}
# reverse in postscript environment
for (@lineas) {
        if (/\\begin\{($POSTSCRIPT)(?{ $DEL = "\Q$^N" })\}/ .. /\\end\{$DEL\}/) {
                while (my($busco, $cambio) = each %cambios) {
                        s/\Q$busco\E/$cambio/g;
                }
        } # close postscript environment changes
}
   
# Write
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print   $SALIDA @lineas;
close   $SALIDA;
 
##---------------------------- PARTE 4 -------------------------------##
#--------------- Extract source code for PST/PGF/TIKZ -----------------#
open my $ENTRADA, '<',"$tempDir/$name-tmp$ext";
my $archivo;
{
        local $/;
        $archivo = <$ENTRADA>;
}
close $ENTRADA;
 
# Dividir el archivo
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.*?) (\\begin{document} .*?)(\\end{document}.*)\z/msx;
 
# Poner el atributo añadido a PostScript
while ($cuerpo =~ /\\begin\{postscript\}/gsm) {
 
        my $corchetes = $1;
        my($pos_inicial, $pos_final) = ($-[1], $+[1]);      # posición donde están los corchetes
 
        if (not $corchetes) {
                $pos_inicial = $pos_final = $+[0];              # si no hay corchetes, nos ponemos al final de \begin
        }
        if (not $corchetes  or  $corchetes =~ /\[\s*\]/) {  # si no hay corchetes, o están vacíos,
                $corchetes = "[$graphics-$exacount}]";          # ponemos los nuestros
        }
        substr($cuerpo, $pos_inicial, $pos_final - $pos_inicial) = $corchetes;    
        pos($cuerpo) = $pos_inicial + length $corchetes;    # reposicionamos la búsqueda de la exp. reg.
}
continue {
        $exacount++;
}
 
#---------------------- Extract source code in images -----------------#
while ($cuerpo =~ /$BP\[.+?(?<img_src_name>$imageDir\/.+?-\d+)\}\](?<code>.+?)(?=^$EP)/gsm) {
        open my $SALIDA, '>', "$+{'img_src_name'}$ext";
        print $SALIDA <<"EOC";
$cabeza\\pagestyle{empty}\n\\begin{document}$+{'code'}\\end{document}
EOC
close $SALIDA;
}
 
#----------------- Convert Postscript to includegraphics --------------#
my $grap="\\includegraphics[scale=1]{$name-fig-";
my $close = '}';
my $IMGno = 1;
$cuerpo =~ s/$BP.+?$EP/$grap.$IMGno++.$close/gemsx;
 
#------------------------ Clean output file  --------------------------#
# append postscript to hash
$cambios{'\begin{POSTRICKS}'} = '\begin{postscript}'; 
$cambios{'\end{POSTRICKS}'} = '\end{postscript}';
 
# Constantes 
my $BEGINDOC = quotemeta('\begin{document}');
my $USEPACK  = quotemeta('\usepackage');
my $REQPACK  = quotemeta('\usepackage');
my $GRAPHICX = quotemeta('{graphicx}');
 
# Exp. Reg.
my $CORCHETES = qr/\[ [^]]*? \]/x;
my $PALABRAS  = qr/\b (?: pst-\w+ | pstricks (?: -add )? | psfrag |psgo |vaucanson-g| auto-pst-pdf | graphicx )/x;
my $FAMILIA   = qr/\{ \s* $PALABRAS (?: \s* [,] \s* $PALABRAS )* \s* \}/x;
 
# comentar
$cabeza =~ s/ ^ ($USEPACK $CORCHETES $GRAPHICX) /%$1/msxg;
 
# eliminar líneas enteras
$cabeza =~ s/ ^ $USEPACK (?: $CORCHETES )? $FAMILIA \n//msxg;
 
# eliminar palabras sueltas
$cabeza =~ s/ (?: ^ $USEPACK \{ | \G) [^}]*? \K (,?) \s* $PALABRAS (\s*) (,?) /$1 and $3 ? ',' : $1 ? $2 : ''/gemsx;
     
# Añadir 
$cabeza .= <<"EXTRA";
\\usepackage{graphicx}
\\graphicspath{{$imageDir/}}
\\usepackage{grfext}
\\PrependGraphicsExtensions*{.pdf}
EXTRA
 
# Clear PST content in preamble
$cabeza =~ s/\\usepackage\{\}/% delete/gmsx;
$cabeza =~ s/\\psset\{.+?\}/% \\psset delete/gmsx;
$cabeza =~ s/\\SpecialCoor/% \\SpecialCoor/gmsx;
 
# Recorremos el archivo y realizamos los cambios
while (my($busco, $cambio) = each %cambios) {
            $cabeza =~ s/\Q$busco\E/$cambio/g;
                        $cuerpo =~ s/\Q$busco\E/$cambio/g;
            }
 
# write
open my $SALIDA, '>', "$tempDir/$name-out$ext";
print   $SALIDA "$cabeza$cuerpo$final";
close   $SALIDA;
 
__END__
 
Coloreado en 0.010 segundos,  usando GeSHi 1.0.8.4

La cual con el un archivo de entrada de la forma (test.tex):

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

\documentclass{article}
\begin{comment}
% Las líneas que están aquí no se deben modificar
\begin{tikzpicture}
code code
\end{tikzpicture}
\begin{document}
\end{comment}
%\begin{pspicture}      
\usepackage{pst-all} 
\usepackage[siunitx]{circuitikz}
\begin{document}
 
Lo que sigue no debe quedar dentro de Postscript, lo ignoramos
\begin{verbatim}
\begin{tikzpicture}
no tocar
\end{tikzpicture}
\end{verbatim}
 
Ésta línea \verb|\begin{pspicture*} o \begin{tikzpicture} \begin{other}| 
junto a las que comienzan con % no nos interesan
%\begin{tikzpicture}
% no tocar
%\end{tikzpicture}
 
Este entono no debe quedar anidado
\begin{postscript} 
\psset{code} 
\begin{pspicture}(-11,0)(11,0)  
Esta sera la figura 1
\end{pspicture} 
\end{postscript} 
 
Lo que sigue no debe quedar dentro de Postscript, lo ignoramos
\begin{ignore}
\begin{pspicture}(-11,0)(11,0)  
no tocar
\end{pspicture} 
\end{ignore}
 
Este entono no debe quedar anidado
\begin{postscript}
\begin{tikzpicture}[scale=2]
Esta sera la figura 2
\end{tikzpicture}
\end{postscript}
 
Esto debe quedar dentro de Postscript
\begin{tikzpicture}
Esta sera la figura 3
\end{tikzpicture}
 
Esto debe quedar dentro de Postscript
\begin{tikzpicture}
\begin{circuitikz}
Esta sera la figura 4
\end{circuitikz}
\end{tikzpicture} 
 
Esto debe quedar dentro de Postscript 
\begin{circuitikz}
Esta sera la figura 5
\end{circuitikz}
 
Final del archivo. 
\end{document} % de ésta línea en adelante no se debe tocar
\begin{pspicture}
no tocar
\end{pspicture}
\end{document}
 
\begin{pspicture}(-11,0)(11,0)  
no tocar
\end{pspicture}
 
\begin{circuitikz}
no tocar
\end{circuitikz}
 
 
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Genera test-tmp.tex:

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

\documentclass{article}
\begin{comment}
% Las líneas que están aquí no se deben modificar
\begin{TIKZPICTURE}
code code
\end{TIKZPICTURE}
\begin{DOCTRICKS}
\end{comment}
%\begin{TRICKS}         
\usepackage{pst-all} 
\usepackage[siunitx]{circuitikz}
\begin{document}
 
Lo que sigue no debe quedar dentro de Postscript, lo ignoramos
\begin{verbatim}
\begin{TIKZPICTURE}
no tocar
\end{TIKZPICTURE}
\end{verbatim}
 
Ésta línea \verb|\begin{TRICKS*} o \begin{TIKZPICTURE} \begin{OTHER}| 
junto a las que comienzan con % no nos interesan
%\begin{TIKZPICTURE}
% no tocar
%\end{TIKZPICTURE}
 
Este entono no debe quedar anidado
\begin{postscript} 
\psset{code} 
\begin{pspicture}(-11,0)(11,0)  
Esta sera la figura 1
\end{pspicture} 
\end{postscript} 
 
Lo que sigue no debe quedar dentro de Postscript, lo ignoramos
\begin{ignore}
\begin{TRICKS}(-11,0)(11,0)     
no tocar
\end{TRICKS} 
\end{ignore}
 
Este entono no debe quedar anidado
\begin{postscript}
\begin{tikzpicture}[scale=2]
Esta sera la figura 2
\end{tikzpicture}
\end{postscript}
 
Esto debe quedar dentro de Postscript
\begin{postscript}
\begin{tikzpicture}
Esta sera la figura 3
\end{tikzpicture}
\end{postscript}
 
Esto debe quedar dentro de Postscript
\begin{postscript}
\begin{tikzpicture}
\begin{circuitikz}
Esta sera la figura 4
\end{circuitikz}
\end{tikzpicture}
\end{postscript} 
 
Esto debe quedar dentro de Postscript 
\begin{postscript}
\begin{circuitikz}
Esta sera la figura 5
\end{circuitikz}
\end{postscript}
 
Final del archivo. 
\end{document} % de ésta línea en adelante no se debe tocar
\begin{pspicture}
no tocar
\end{pspicture}
\end{document}
 
\begin{pspicture}(-11,0)(11,0)  
no tocar
\end{pspicture}
 
\begin{circuitikz}
no tocar
\end{circuitikz}
 
 
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

y genera test-out.tex:

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

\documentclass{article}
\begin{comment}
% Las líneas que están aquí no se deben modificar
\begin{tikzpicture}
code code
\end{tikzpicture}
\begin{document}
\end{comment}
%\begin{pspicture}      
% delete 
\usepackage[siunitx]{circuitikz}
\usepackage{graphicx}
\graphicspath{{images/}}
\usepackage{grfext}
\PrependGraphicsExtensions*{.pdf}
\begin{document}
 
Lo que sigue no debe quedar dentro de Postscript, lo ignoramos
\begin{verbatim}
\begin{tikzpicture}
no tocar
\end{tikzpicture}
\end{verbatim}
 
Ésta línea \verb|\begin{pspicture*} o \begin{tikzpicture} \begin{other}| 
junto a las que comienzan con % no nos interesan
%\begin{tikzpicture}
% no tocar
%\end{tikzpicture}
 
Este entono no debe quedar anidado
\includegraphics[scale=1]{test-fig-1} 
 
Lo que sigue no debe quedar dentro de Postscript, lo ignoramos
\begin{ignore}
\begin{pspicture}(-11,0)(11,0)  
no tocar
\end{pspicture} 
\end{ignore}
 
Este entono no debe quedar anidado
\includegraphics[scale=1]{test-fig-2}
 
Esto debe quedar dentro de Postscript
\includegraphics[scale=1]{test-fig-3}
 
Esto debe quedar dentro de Postscript
\includegraphics[scale=1]{test-fig-4} 
 
Esto debe quedar dentro de Postscript 
\includegraphics[scale=1]{test-fig-5}
 
Final del archivo. 
\end{document} % de ésta línea en adelante no se debe tocar
\begin{pspicture}
no tocar
\end{pspicture}
\end{document}
 
\begin{pspicture}(-11,0)(11,0)  
no tocar
\end{pspicture}
 
\begin{circuitikz}
no tocar
\end{circuitikz}
 
 
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

juntos a los ficheros test-fig-1.tex, test-fig-2.tex, test-fig-3.tex, test-fig-4.tex y test-fig-5.tex
que son de ésta forma:

Sintáxis: [ Descargar ] [ Ocultar ]

Using latex Syntax Highlighting

\documentclass{article}
\begin{comment}
% Las líneas que están aquí no se deben modificar
\begin{TIKZPICTURE}
code code
\end{TIKZPICTURE}
\begin{DOCTRICKS}
\end{comment}
%\begin{TRICKS}         
\usepackage{pst-all} 
\usepackage[siunitx]{circuitikz}
\pagestyle{empty}
\begin{document}
\begin{tikzpicture}
Esta sera la figura 3
\end{tikzpicture}
\end{document}
 
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Me encantaría poder optimizar el código en el tema de la apertura y cierre de archivos, intenté hacer el cambio que me propusiste arriba y no hubo caso, no obtenía el fichero que deseaba.
Saludos nuevamente.
Pablo.

por **explorer** » 2015-01-08 11:47 @532

¿Para qué usas use re "eval"?

por **pablgonz** » 2015-01-08 14:26 @643

Parte del código es de un mensaje anterior: http://perlenespanol.com/foro/acotar-expresion-regular-t8380-50.html de cuando tenía Perl v5.14.2.

por **explorer** » 2015-01-08 14:47 @657

Ya... La pregunta es si sabes para qué sirve

por **pablgonz** » 2015-01-08 15:52 @703

Veamos si estoy en lo correcto, sirve para cambiar el significado de

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

(?{ $DEL = "\Q$^N" })
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

ya que no se puede interpolar una cadena en un patrón que contiene bloques de código.

por **pablgonz** » 2015-01-11 14:25 @642

Quité la línea de use re 'eval' y cambié un poco de código a esto:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

# por líneas
my @lineas = split /\n/, $archivo;
# completo
$archivo = join("\n", @lineas);  
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

y he logrado reducir la cantidad de veces que abro y cierro el archivo. ¿Se puede escribir distinto ésta parte del código?

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my $grap="\\includegraphics[scale=1]{$name-fig-";
my $close = '}';
my $IMGno = 1;
$cuerpo =~ s/$BP.+?$EP/$grap.$IMGno++.$close/gemsx;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Sé que con /e evalúo la parte izquierda y luego hago los cambios pero la única forma que encontré de "escribir la frase que necesito" fue concatenando, no pude interpolar "$IMGno++" en la expresión regular. Supongo que existe algo más "bonito".

Saludos.

por **explorer** » 2015-01-11 14:58 @665

Las líneas que usaste es la idea que te comenté unos mensajes antes: se puede evitar la escritura/lectura de los archivos intermedios porque la única diferencia es que pasas la información de formato array, con líneas, a un escalar, con todas las líneas concatenadas.

La parte derecha de la expresión regular se podría escribir así:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

$cuerpo =~ s/$BP.+?$EP/$grap@{[$IMGno++]}$close/msg;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

pero no sé si es más bonito... usa algo de magia

Foro - Perl en Español

Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Publicidad

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

Re: Expresión regular para texto anidado

¿Quién está conectado?