#!/usr/bin/perl
use v5.14;
use autodie; # muere si ocurre un error
use File::Basename; # separa el archivo de entrada
### Argumentos --------------------------------------------------------------
@ARGV == 1 or die "Uso: $0 <archivo TeX a procesar>\n";
my $nombre_archivo = shift;
-f $nombre_archivo or die "ERROR: No encuentro [$nombre_archivo]\n";
### Arreglo de la extensión -------------------------------------------------
my @SuffixList = ('.tex', '', '.ltx'); # posible extensión
my ($name, $path, $ext) = fileparse($nombre_archivo, @SuffixList);
$ext = '.tex' if not $ext; # fijamos la extensión
### Abrimos el archivo de entrada a modificar -------------------------------
open my $ENTRADA, '<', $nombre_archivo;
my $archivo;
{
local $/;
$archivo = <$ENTRADA>;
}
close $ENTRADA;
## Partición del documento
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+? ^\\begin{document}) (.+) (^ \\end{document} .*) \z/msx;
## Cambios a realizar
my %cambios = (
'\pspicture' => '\TRICKS',
'\endpspicture' => '\ENDTRICKS',
'\begin{MYexample' => '\begin{MYEXAMPLE',
'\end{MYexample' => '\end{MYEXAMPLE',
'\begin{pspicture' => '\begin{TRICKS',
'\end{pspicture' => '\end{TRICKS',
'\begin{postscript}' => '\begin{POSTRICKS}',
'\end{postscript}' => '\end{POSTRICKS}',
);
## 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/verb [*]? /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;
## Cambiar
while ($cuerpo =~
/ $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 $cuerpo, $pos_inicial, $pos_final-$pos_inicial, $encontrado; # insertamos los nuevos cambios
pos($cuerpo)= $pos_inicial + length $encontrado; # re posicionamos la siguiente búsqueda
}
}
## Escritura del resultado
open my $SALIDA, '>', "$name-out$ext";
print $SALIDA "$cabeza$cuerpo$final";
close $SALIDA;
__END__