view release on metacpan or  search on metacpan

lib/Finance/Bank/ID/BPRKS.pm  view on Meta::CPAN

    unless ($page =~ m!<label[^>]*>Mata Uang</label></td>\s*<td[^>]*>(\w+)</td>!s) {
        return "can't get currency, $adv1";
    }
    $stmt->{currency} = ($1 eq 'Rp' ? 'IDR' : $1);

    unless ($page =~ m!<label[^>]*>Nama</label></td>\s*<td[^>]*>([^<]+?)\s*</td>!s) {
        return "can't get account holder, $adv1";
    }
    $stmt->{account_holder} = $1;

    # additional: Tipe: Tabungan

    unless ($page =~ m!<label[^>]*>Mutasi Kredit</label></td>\s*<td[^>]*>([^<]+)</td>!s) {
        return "can't get total credit, $adv1";
    }
    $stmt->{_total_credit_in_stmt}  = $self->_parse_num($1);
    # no _num_credit_tx_in_stmt, pity cause it's required for proper checking

    unless ($page =~ m!<label[^>]*>Mutasi Debet</label></td>\s*<td[^>]*>([^<]+)</td>!s) {
        return "can't get total credit, $adv1";
    }
    $stmt->{_total_debit_in_stmt}  = -$self->_parse_num($1);
    # no _num_debit_tx_in_stmt, pity cause it's required for proper checking
    "";
}

sub _ps_get_transactions {
    my ($self, $page, $stmt) = @_;

    my @e;
    while ($page =~ m!
<tr \s+ class="(?:odd|even)" \s+ id="informal_(?<seq>\d+)"[^>]*>\s*
  <td[^>]+>\s* (?<date>\d\d/\d\d/\d\d\d\d) \s*</td>\s*
  <td[^>]+>\s* (?<desc>[^<]+?) \s*</td>\s*
  <td[^>]+>\s* (?<ref>[^<]+?) \s*</td>\s*
  <td[^>]+>\s* (?<amt>[^<]+?) \s*</td>\s*
  <td[^>]+>\s* (?<bal>[^<]+?) \s*</td>\s*
</tr>!sxg) {
        my %m = %+;
        push @e, \%m;
    }

    my @tx;
    my @skipped_tx;
    my $last_date;
    my $seq;
    my $i = 0;
    for my $e (@e) {
        $i++;
        my $tx = {};
        #$tx->{stmt_start_date} = $stmt->{start_date};

        ### bca
        ###if ($e->{date} =~ /NEXT/) {
        ###    $tx->{date} = $stmt->{end_date};
        ###    $tx->{is_next} = 1;
        ###} elsif ($e->{date} =~ /PEND/) {
        ###    $tx->{date} = $stmt->{end_date};
        ###    $tx->{is_pending} = 1;
        ###} else {
        my ($day, $mon, $year) = split m!/!, $e->{date};
        my $last_nonpend_date = DateTime->new(
            year => $year,
            month => $mon,
            day => $day);
        $tx->{date} = $last_nonpend_date;
        ###$tx->{is_pending} = 0;
        ###}

        $tx->{description} = $e->{desc};

        $tx->{amount}  = $self->_parse_num($e->{amt});
        $tx->{balance} = $self->_parse_num($e->{bal});

        ### bca
        ###if ($tx->{is_next} && $self->skip_NEXT) {
        ###}

        if (!$last_date || DateTime->compare($last_date, $tx->{date})) {
            $seq = 1;
            $last_date = $tx->{date};
        } else {
            $seq++;
        }
        $tx->{seq} = $seq;

        ### bca
        ###if ($self->_variant eq 'individual' &&
        ###    $tx->{date}->dow =~ /6|7/ &&
        ###    $tx->{description} !~ /^(BIAYA ADM|BUNGA|CR KOREKSI BUNGA|PAJAK BUNGA)$/) {
        ###    return "check failed in tx#$i: In KlikBCA Perorangan, all ".
        ###        "transactions must not be in Sat/Sun except for Interest and ".
        ###        "Admin Fee";
        ###    # note: in Tahapan perorangan, BIAYA ADM is set on
        ###    # Fridays, but for Tapres (?) on last day of the month
        ###}

        ###if ($self->_variant eq 'bisnis' &&
        ###    $tx->{date}->dow =~ /6|7/ &&
        ###    $tx->{description} !~ /^(BIAYA ADM|BUNGA|CR KOREKSI BUNGA|PAJAK BUNGA)$/) {
        ###    return "check failed in tx#$i: In KlikBCA Bisnis, all ".
        ###        "transactions must not be in Sat/Sun except for Interest and ".
        ###        "Admin Fee";
        ###    # note: in KlikBCA bisnis, BIAYA ADM is set on the last day of the
        ###    # month, regardless of whether it's Sat/Sun or not
        ###}

        ###if ($tx->{is_next} && $self->skip_NEXT) {
        ###    push @skipped_tx, $tx;
        ###    $seq--;
        ###} else {
        push @tx, $tx;
        ###}
    }
    $stmt->{transactions} = \@tx;
    $stmt->{skipped_transactions} = \@skipped_tx;
    "";
}

1;
# ABSTRACT: Check your BPR KS accounts from Perl