perl compare two file and print the matching lines

问题

I have this script which is compare 2 files and print out the diff result. now I want to change the script instead of print out the diff lines, i want to print the matching lines. and also to count how many time matched every time running the script. would you please any one can give me a suggestion. thanks!

#! /usr/local/bin/perl 
# compare 
my $f1 = "/opt/test.txt";
my $f2 = "/opt/test1.txt";
my $outfile = "/opt/final_result.txt";
my %results = (); 
open FILE1, "$f1" or die "Could not open file: $! \n";
while(my $line = <FILE1>){   $results{$line}=1;
}
close(FILE1); 
open FILE2, "$f2" or die "Could not open file: $! \n";
while(my $line =<FILE2>) {  
$results{$line}++;
}
close(FILE2);  
open (OUTFILE, ">$outfile") or die "Cannot open $outfile for writing \n";
foreach my $line (keys %results) { print OUTFILE $line if $results{$line} == 1;
}
close OUTFILE;

回答1:

This isn't the cleanest way to do things... but the hard work has been done. Reverse the logic to make it print everything unless $results{$line} == 1, or if $results{$line} != 1.

To add the count:

print OUTFILE "Count: $results{$line} - $line" if $results{$line} != 1;

Alternatively, you could filter out the unwanted with a grep, avoiding the if condition totally:

foreach my $line ( grep { $results{$_} != 1 } keys %results ) {

    print OUTFILE "Count: $results{$line} - $line";
}

回答2:

print OUTFILE $line if $results{$line} == 1;

This will print lines that occur only one time.

print OUTFILE $line if $results{$line} > 1;

One small change (== to >), and it will now print lines that occur more than one time. That should print identical duplicate lines.

Oh, also if you want the count, simply do:

if ( $results{$line} > 1 ) {
    print OUTFILE "$results{$line}: ", $line;
}

---

I wrote a more concise and more flexible version here. It takes optional filenames and prints to STDOUT.

You can put 0 in place of one of the names to compare one of the files against another. Use shell redirection to save it to a file.

Usage:

$ script.pl file1.txt file2.txt > outfile.txt

Code:

use strict;
use warnings;
use autodie;

my $f1 = shift || "/opt/test.txt";
my $f2 = shift || "/opt/test1.txt";
my %results;
open my $file1, '<', $f1;
while (my $line = <$file1>) { $results{$line} = 1 }
open my $file2, '<', $f2;
while (my $line = <$file2>) { $results{$line}++ }
foreach my $line (sort { $results{$b} <=> $results{$a} } keys %results) {
    print "$results{$line}: ", $line if $results{$line} > 1;
}

回答3:

Try Test::Differences. See here for code sample and how the output would look like:

http://metacpan.org/pod/Test::Differences

来源：https://stackoverflow.com/questions/6862054/perl-compare-two-file-and-print-the-matching-lines