与 Perl 正则表达式的虚假匹配

Question

The goal of this Perl program is to consume a spreadsheet, trim it to only the two desired columns, then do a find-and-replace of the entries from the first column with the entries from the second column. The eventual goal will be to make it so that in the event of the spreadsheet having duplicates of a given value in the first column paired with distinct values in the second column (eg the term 'foo' appears in one row paired with 'bar' and it appears in a second row paired with 'baz'), the user will be asked to adjudicate each replacement. For now, however, I'm simply trying to get the blunt-force 'traverse a whole directory tree and find-and-replace' functionality working. Here is the code in its current state:

use strict;
use warnings;
use diagnostics;
use Text::CSV_XS;
use File::Find;

my $spreadsheet = Text::CSV_XS->new ({ binary => 1, auto_diag => 1 });

open my $fh, "<", $ARGV[0];
my @table;
while (my $row = $spreadsheet->getline($fh)) {
   push @table, $row;
}
close $fh;

@table = sort { length $b->[0] <=> length $a->[0] } @table; 

find({ 
    preprocess => \&filter, 
    wanted => \&search_and_replace 
    }, 
    $ARGV[1]
);

sub filter {
    return grep { -d or (-f and ( /\.txt$/ or /\.rst$/ or /\.yaml$/))} @_;
}

sub search_and_replace {
        open my $target_file, "<", $_;
        while (my $target_string = <$target_file>) {
            for my $row (@table) {
                my $search = $row->[0];
                my $replace = $row->[1];
                if ($target_string =~ $search) {
                    print "Found $search!\n"
                }
            }
        }
        print "Finished checking $_\n";
        close $target_file;
}

The CSV it consumes obeys this format:

Search String         Context         Replacement
old phrase            redacted        new phrase
some old words        redacted        some new words
word                  redacted        morpheme
word                  redacted        speak
words                 redacted        morphemes

The sort in the beginning is intended to arrange this such that keys which might be substrings of other keys come later and thus I don't run the risk of interfering with the replacement of longer strings by having already replaced some substring.

The $replace is obviously not doing anything currently. I had earlier thought I was close to a solution, only to realize that I do not even have the matching down right.

I included the print "Found $search!\n" at this stage as a sanity check; checking the STDOUT indicates that I'm getting a lot of spurious matches, and without any regard for ordering. In one file, it reports finding 8 instances of the $search key from the 1st non-header row of the spreadsheet, then 3 instances of the $search key from the 53rd row of the spreadsheet,then another 8 instances of the $search key from the 1st row. In reality, that files contains 0 instances of the the $search key from the 1st row, and only 1 instance of the the $search key from the 53rd row.

It most frequently claims to have found matches against the $search key from the 1st row which turn out to be false, so I'm wondering if it's something to do with how the loops in the subroutine are constructed. I am a Perl novice and thus don't have a clear sense of what other information might be needed to diagnose this issue; please let me know what other information I should supply. Currently I am only concerned with getting the matches to happen correctly; I will worry about replacement later. Thank you.

Answer 1

in situations like these you should try to narrow down the problem as much as possible:

• take a look at @table after it has been filled: does it contains what you expect?

• test your search_and_replace sub in isolation (ie by feeding it a test file and a test @table ): does it report the matches correctly?

Sorry it's not really an answer, but take it more as a long-term advice Cheers!