Perl双文件遍历：按匹配字段实现列递减输出的需求与代码修正

Let's get your Perl script generating the exact FileNewC output you need. First, let's recap the input files and desired output to make sure we're on the same page:

Input FileA #

DistA,1010101,a_0200,Address,11,7
DistA,1010101,a_0200,Address,12,7
DistA,1010101,a_0200,Address,09,3
DistA,1010101,a_0200,Address,10,3
DistA,1010101,a_0200,Address,13,2
DistA,1010101,a_0300,Address,11,6
DistA,1010101,a_0300,Address,12,6
DistA,1010101,a_0300,Address,09,3
DistA,1010101,a_0300,Address,10,3
DistA,1010101,a_0300,Address,13,2
DistA,1010101,b_0200,Address,11,6
DistA,1010101,b_0200,Address,12,6
DistA,1010101,b_0200,Address,09,3
DistA,1010101,b_0200,Address,10,3
DistA,1010101,b_0200,Address,13,2
DistA,1010101,b_0300,Address,11,6
DistA,1010101,b_0300,Address,12,6
DistA,1010101,b_0300,Address,09,3
DistA,1010101,b_0300,Address,10,3
DistA,1010101,b_0300,Address,13,2

Input FileB #

DistA,1010101,a_0200,23
DistA,1010101,a_0300,21
DistA,1010101,b_0200,21
DistA,1010101,b_0300,19

Desired Output FileNewC (Example Snippet) #

Loop-1
DistA,1010101,a_0200,Address,11,7
DistA,1010101,a_0200,Address,12,7
DistA,1010101,a_0200,Address,09,3
DistA,1010101,a_0200,Address,10,3
DistA,1010101,a_0200,Address,13,2
Loop-2
DistA,1010101,a_0200,Address,11,6
DistA,1010101,a_0200,Address,12,6
DistA,1010101,a_0200,Address,09,2
DistA,1010101,a_0200,Address,10,2
DistA,1010101,a_0200,Address,13,1
Loop-3
DistA,1010101,a_0200,Address,11,5
DistA,1010101,a_0200,Address,12,5
DistA,1010101,a_0200,Address,09,1
DistA,1010101,a_0200,Address,10,1
Loop-4
DistA,1010101,a_0200,Address,11,4
DistA,1010101,a_0200,Address,12,4
Loop-5
DistA,1010101,a_0200,Address,11,3
DistA,1010101,a_0200,Address,12,3
Loop-6
DistA,1010101,a_0200,Address,11,2
DistA,1010101,a_0200,Address,12,2
Loop-7
DistA,1010101,a_0200,Address,11,1
DistA,1010101,a_0200,Address,12,1

Issues with Your Current Script #

Your current code only decrements each value once instead of looping until it hits 0, doesn't add the Loop-N markers, and doesn't skip rows where the decremented value becomes 0. It also doesn't group rows from FileA by their matching key (first three columns) to handle each group's full set of rows per loop.

Fixed Perl Script #

Here's the revised script that implements all your requirements:

#!/usr/bin/perl
use strict;
use warnings;
$|=1;

die "Usage: $0 <FileA> <FileB> [FileNewC]\n" unless @ARGV >= 2;
my ($filea, $fileb, $filec) = @ARGV;

# Open input files with modern filehandle syntax
open my $fa_fh, '<', $filea or die "Can't open $filea: $!";
open my $fb_fh, '<', $fileb or die "Can't open $fileb: $!";

# Open output file if provided, default to STDOUT
my $fc_fh;
if ($filec) {
    open $fc_fh, '>', $filec or die "Can't open $filec: $!";
} else {
    $fc_fh = \*STDOUT;
}

# Store max loop count per group from FileB
my %max_loops;
while (<$fb_fh>) {
    chomp;
    my ($dist, $sec, $cls, $max) = split /,/;
    my $key = join(',', $dist, $sec, $cls);
    $max_loops{$key} = $max;
}

# Group FileA rows by their matching key (first 3 columns)
my %filea_groups;
while (<$fa_fh>) {
    chomp;
    my @fields = split /,/;
    my $key = join(',', @fields[0,1,2]);
    # Only process groups listed in FileB
    next unless exists $max_loops{$key};
    push @{ $filea_groups{$key} }, \@fields;
}

# Generate looped output for each group
foreach my $key (sort keys %filea_groups) {
    my $max_loop = $max_loops{$key};
    for my $loop_num (1..$max_loop) {
        print $fc_fh "Loop-$loop_num\n";
        my $has_output = 0;
        
        foreach my $row (@{ $filea_groups{$key} }) {
            # Calculate current quantity: original minus completed loops
            my $current_qtd = $row->[5] - ($loop_num - 1);
            if ($current_qtd > 0) {
                # Create output row with updated quantity
                my @output = @$row;
                $output[5] = $current_qtd;
                print $fc_fh join(',', @output) . "\n";
                $has_output = 1;
            }
        }
        
        # Stop early if no rows are left to output (all quantities hit 0)
        last unless $has_output;
    }
}

# Clean up filehandles
close $fa_fh;
close $fb_fh;
close $fc_fh if $filec;

Key Improvements Explained #

• Row Grouping: We group FileA rows by their matching key (first three columns) so we can process the entire set of rows for each group in every loop.
• Loop Markers: Each iteration starts with a Loop-N marker to separate blocks of output.
• Decrement & Filter: For each row, we calculate the current quantity by subtracting completed loops from the original value. Rows with a quantity of 0 are skipped.
• Early Termination: If a loop produces no output (all rows in the group hit 0), we stop processing further loops for that group (even if FileB's max count isn't reached).
• Flexible Output: The script writes to a specified file or prints to your terminal if no output file is provided.
• Robust Error Handling: Added command-line argument checks and modern filehandle practices for better reliability.

Run the script like this:

perl script.pl FileA FileB FileNewC

内容的提问来源于stack exchange，提问作者ebk