view release on metacpan or  search on metacpan

lib/Parse/PayPal/TxDetailReport.pm  view on Meta::CPAN

sub _parse_date {
    DateTime::Format::Flexible->parse_datetime(shift)->epoch;
}

$SPEC{parse_paypal_txdetail_report} = {
    v => 1.1,
    summary => 'Parse PayPal transaction detail report into data structure',
    description => <<'_',

The result will be a hashref. The main key is `transactions` which will be an
arrayref of hashrefs.

Dates will be converted into Unix timestamps.

_
    args => {
        files => {
            schema => ['array*', of=>'filename*', min_len=>1],
            description => <<'_',

Files can all be in tab-separated or comma-separated (CSV) format but cannot be
mixed. If there are multiple files, they must be ordered.

_
            pos => 0,
            greedy => 1,
        },
        strings => {
            schema => ['array*', of=>'str*', min_len=>1],
            description => <<'_',

Instead of `files`, you can alternatively provide the file contents in
`strings`.

_
        },
        format => {
            schema => ['str*', in=>[qw/tsv csv/]],
            description => <<'_',

If unspecified, will be deduced from the first filename's extension (/csv/ for
CSV, or /txt|tsv/ for tab-separated).

_
        },
    },
    args_rels => {
        req_one => ['files', 'strings'],
    },
};
sub parse_paypal_txdetail_report {
    my %args = @_;

    my $format = $args{format};

    my @handles;
    my @files;
    if (my $strings = $args{strings}) {
        require IO::Scalar;
        require String::BOM;

        if (!$format) {
            $format = $strings->[0] =~ /\t/ ? 'tsv' : 'csv';
        }
        for my $str0 (@{ $strings }) {
            my $str = String::BOM::strip_bom_from_string($str0);
            my $fh = IO::Scalar->new(\$str);
            push @handles, $fh;
            push @files, "string";
        }
    } elsif (my $files = $args{files}) {
        require File::BOM;

        if (!$format) {
            $format = $files->[0] =~ /\.(csv)\z/i ? 'csv' : 'tsv';
        }
        for my $file (@{ $files }) {
            open my($fh), "<:encoding(utf8):via(File::BOM)", $file
                or return [500, "Can't open file '$file': $!"];

            push @handles, $fh;
            push @files, $file;
        }
    } else {
        return [400, "Please specify files (or strings)"];
    }

    my $res = [200, "OK", {
        format => "txdetail_v11",
        transactions => [],
    }];

    my $code_parse_row = sub {
        my $row = shift;

        if ($row->[0] eq 'RH') { # row header
            $res->[2]{RH_seen}++ and do {
                $res = [400, "RH row seen twice in a file"];
                goto RETURN_RES;
            };
            $res->[2]{report_generation_date} //= _parse_date($row->[1]);
            $res->[2]{reporting_window} //= $row->[2];
            $res->[2]{account_id} //= $row->[3];
            $res->[2]{report_version} //= $row->[4];
            $row->[4] == 11 or do {
                $res = [400, "Version ($row->[4]) not supported, only version 11 is supported"];
                goto RETURN_RES;
            };
        } elsif ($row->[0] eq 'FH') { # file header
            $res->[2]{FH_seen}++ and do {
                $res = [400, "FH row seen twice in a file"];
                goto RETURN_RES;
            };
            $res->[2]{cur_file_seq} == $row->[1] or do {
                $res = [400, "Unexpected file sequence, expected sequence ".
                            "$res->[2]{cur_file_seq} for file ".
                            "$res->[2]{cur_file}"];
                goto RETURN_RES;
            };
        } elsif ($row->[0] eq 'SH') { # section header
            $res->[2]{SH_seen}++ and do {
                $res = [400, "SH row seen twice in a file"];
                goto RETURN_RES;
            };
        } elsif ($row->[0] eq 'CH') { # column header
            $res->[2]{transaction_columns} //= [@{$row}[1..$#{$row}]];
        } elsif ($row->[0] eq 'SB') { # section body
            my $tx = {};
            my $txcols = $res->[2]{transaction_columns};
            for (1..$#{$row}) {
                my $header = $txcols->[$_-1];
                if ($header =~ /Date$/ && $row->[$_]) {
                    $tx->{$header} = _parse_date($row->[$_]);
                } else {
                    $tx->{$header} = $row->[$_];
                }
            }
            push @{ $res->[2]{transactions} }, $tx;