view release on metacpan or  search on metacpan

lib/App/CSVUtils/csv_lookup_fields.pm  view on Meta::CPAN

        $r->{target_fields_idx} = [];
        $r->{target_fields} = [];
        $r->{target_data_rows} = [];
    },

    on_input_header_row => sub {
        my $r = shift;

        if ($r->{input_filenum} == 1) {
            $r->{target_fields}     = $r->{input_fields};
            $r->{target_fields_idx} = $r->{input_fields_idx};
            $r->{output_fields}     = $r->{input_fields};
        } else {
            $r->{source_fields}     = $r->{input_fields};
            $r->{source_fields_idx} = $r->{input_fields_idx};
        }
    },

    on_input_data_row => sub {
        my $r = shift;

        if ($r->{input_filenum} == 1) {
            push @{ $r->{target_data_rows} }, $r->{input_row};
        } else {
            push @{ $r->{source_data_rows} }, $r->{input_row};
        }
    },

    after_close_input_files => sub {
        my $r = shift;

        my $ci = $r->{util_args}{ignore_case};

        # build lookup table
        my %lookup_table; # key = joined lookup fields, val = source row idx
        for my $row_idx (0..$#{$r->{source_data_rows}}) {
            my $row = $r->{source_data_rows}[$row_idx];
            my $key = join "|", map {
                my $field = $r->{lookup_fields}[$_][1];
                my $field_idx = $r->{source_fields_idx}{$field};
                my $val = defined $field_idx ? $row->[$field_idx] : "";
                $val = lc $val if $ci;
                $val;
            } 0..$#{ $r->{lookup_fields} };
            $lookup_table{$key} //= $row_idx;
        }
        #use DD; dd { lookup_fields=>$r->{lookup_fields}, fill_fields=>$r->{fill_fields}, lookup_table=>\%lookup_table };

        # fill target csv
        my $num_filled = 0;

        for my $row (@{ $r->{target_data_rows} }) {
            my $key = join "|", map {
                my $field = $r->{lookup_fields}[$_][0];
                my $field_idx = $r->{target_fields_idx}{$field};
                my $val = defined $field_idx ? $row->[$field_idx] : "";
                $val = lc $val if $ci;
                $val;
            } 0..$#{ $r->{lookup_fields} };

            #say "D:looking up '$key' ...";
            if (defined(my $row_idx = $lookup_table{$key})) {
                #say "  D:found";
                my $row_filled;
                my $source_row = $r->{source_data_rows}[$row_idx];
                for my $field (keys %{$r->{fill_fields}}) {
                    my $target_field_idx = $r->{target_fields_idx}{$field};
                    next unless defined $target_field_idx;
                    my $source_field_idx = $r->{source_fields_idx}{ $r->{fill_fields}{$field} };
                    next unless defined $source_field_idx;
                    $row->[$target_field_idx] =
                        $source_row->[$source_field_idx];
                    $row_filled++;
                }
                $num_filled++ if $row_filled;
            }
            unless ($r->{util_args}{count}) {
                $r->{code_print_row}->($row);
            }
        } # for target data row

        if ($r->{util_args}{count}) {
            $r->{result} = [200, "OK", $num_filled];
        }
    },
);

1;
# ABSTRACT: Fill fields of a CSV file from another

__END__

=pod

=encoding UTF-8

=head1 NAME

App::CSVUtils::csv_lookup_fields - Fill fields of a CSV file from another

=head1 VERSION

This document describes version 1.036 of App::CSVUtils::csv_lookup_fields (from Perl distribution App-CSVUtils), released on 2025-02-04.

=head1 FUNCTIONS


=head2 csv_lookup_fields

Usage:

 csv_lookup_fields(%args) -> [$status_code, $reason, $payload, \%result_meta]

Fill fields of a CSV file from another.

Example input:

 # report.csv
 client_id,followup_staff,followup_note,client_email,client_phone
 101,Jerry,not renewing,
 299,Jerry,still thinking over,
 734,Elaine,renewing,