Problemas com um script perl que deve remover strings nas linhas de um arquivo de outro arquivo

0

Eu tenho um arquivo ~/foo e outro arquivo ~/remove.txt . Gostaria de escrever um script perl que faça um loop em cada linha de ~/remove.txt e remova todas as instâncias da string (<LINE>) de ~/foo (onde <LINE> é a linha em ~/remove.txt ). Meu código é

#! /usr/bin/perl 

use strict;
use warnings;

sub main
{
    my $infile  = "remove.txt";

    open(INPUT, $infile) or die "cannot open $infile";

    while(my $line = <INPUT>)
    {
    chomp($line);

    my $bad_string = "($line)";

    system( q( perl -p -i -e 's/$bad_string//g' foo ) );
    }

    close(INPUT);

}

main();

Mas a execução deste script não parece alterar meu arquivo. O que há de errado com o meu roteiro?

    
por Brian Fitzpatrick 20.09.2015 / 03:41

3 respostas

3

Além do problema que você está perguntando, seu script tem uma grande falha, pois faz uma passagem completa através de 'foo' para cada linha em 'remove.txt'. Isso é extremamente ineficiente. A melhor maneira de fazer isso é ler em 'remove.txt', construir uma única expressão regular longa e usá-la uma vez para editar 'foo'.

A maneira mais simples de fazer isso é empurrar as strings de busca para um array e então 'join ()' o array com um '|' (regexp "ou") para criar uma string que possa ser usada como expressão regular.

Aqui está um script que faz isso e corrige seu problema original.

#! /usr/bin/perl 

use strict;
use warnings;

# first construct a regular expression containing every
# line that needs to be removed.  This is so we only have
# to run a single pass through $infile rather than one
# pass per line in $removefile.
my @remove = ();

my $removefile='remove.txt';
open(REMFILE,"<",$removefile) || die "couldn't open $removefile: $!\n";
while(<REMFILE>) {
    chomp;
    next if (/^\s*$/);
    push @remove, $_;
};
close(REMFILE);

# choose one of the following two lines depending on
# whether you want to remove only entire lines or text
# within a line:
my $remove = '^(' . join("|",@remove) . ')$';
#my $remove = join("|",@remove);

# now remove the unwanted text from all lines in $infile
my $infile = 'foo';
system('perl','-p','-i','-e',"s/$remove//g",$infile);

# if you want to delete matching lines, try this instead:
#system('perl','-n','-i','-e',"print unless /$remove/",$infile);
    
por 20.09.2015 / 04:22
2

Você precisa usar qq() e escapar dos meta-caracteres regex ( ( e ) ) em $bad_string .

            my $bad_string = "\($line\)";
            system( qq( perl -p -i -e 's/$bad_string//g' foo ) );
    
por 20.09.2015 / 03:57
0

Existem 3 elementos para o seu problema:

  • criando uma 'lista de exclusão' - observe que os caracteres 'especiais' em sua lista de exclusão podem causar problemas.
  • lendo seu arquivo, excluindo uma linha, se "corresponder".
  • escrevendo seu novo arquivo.

Na sua pergunta - acho que há algumas coisas que eu chamaria de "estilo ruim".

    Os filehandles lexicais com 3 argumentos abertos são bons estilos.
  • chamar system para executar perl de dentro de perl é ineficiente.
  • interpolação de cotação é um incômodo melhor evitado
  • você está reprocessando seu arquivo de saída repetidamente, o que é terrivelmente ineficiente. (Lembre-se - disco IO é a coisa mais lenta que você fará no seu sistema).

Então, com isso em mente - aqui está como eu faria:

#!/usr/bin/env perl
use strict;
use warnings;

my $infile = "remove.txt";
open( my $pattern_fh, '<', $infile ) or die "cannot open $infile $!";

#quotemeta escapes meta characters that'll break your pattern matching. 
my $regex = join( '|', map {quotemeta} <$pattern_fh> );
#compile the regex
$regex = qr/^($regex)$/;    #whole lines
close($input_fh);

print "Using regular expression: $regex\n"; 

open( my $input_fh,  '<', "foo" )     or die $!;
open( my $output_fh, '>', "foo.new" ) or die $!;

#tell print where to print by default. 
#could instead print {$output_fh} $_; 
select($output_fh);
while (<$input_fh>) {
    print unless m/$regex/;
}
close($input_fh);
close($output_fh);

#rename/copy if it worked

(NB: Não testado exaustivamente - se você puder fornecer alguns dados de amostra, testarei / atualizarei conforme necessário)

    
por 21.09.2015 / 17:37

Tags