File Coverage

blib/lib/Finance/Bank/ID/BPRKS.pm

Criterion	Covered	Total	%
statement	74	201	36.8
branch	21	90	23.3
condition	2	14	14.2
subroutine	12	24	50.0
pod	5	6	83.3
total	114	335	34.0

package Finance::Bank::ID::BPRKS;

our $DATE = '2015-08-17'; # DATE
our $VERSION = '0.04'; # VERSION

use 5.010001;
use Moo;
use DateTime;
use Log::Any::IfLOG '$log';

use Parse::Number::ID qw(parse_number_id);

extends 'Finance::Bank::ID::Base';

has _variant => (is => 'rw'); # 'individual' only, for now
###bca
###has skip_NEXT => (is => 'rw');

sub BUILD {
    my ($self, $args) = @_;

    $self->site("https://ib.bprks.co.id") unless $self->site;
    $self->https_host("ib.bprks.co.id")   unless $self->https_host;
}

sub _req {
    my ($self, @args) = @_;

    # 2012-03-12 - KlikBCA server since a few week ago rejects TE request
    # header, so we do not send them.
    ###bca
    ###local @LWP::Protocol::http::EXTRA_SOCK_OPTS =
    ###    @LWP::Protocol::http::EXTRA_SOCK_OPTS;
    ###push(@LWP::Protocol::http::EXTRA_SOCK_OPTS, SendTE => 0);
    #$log->tracef("EXTRA_SOCK_OPTS=%s", \@LWP::Protocol::http::EXTRA_SOCK_OPTS);

    $self->SUPER::_req(@args);
}

# XXX tmp, should be in an indo date utility module
sub _parse_mon {
    my $self = shift;
    local $_ = lc(shift);
    if (/^(?:jan|januar[iy])$/) {
        return 1;
    } elsif (/^(?:[fp]eb|[fp]ebruar[iy])$/) {
        return 2;
    } elsif (/^(?:mar|mrt|maret|march)$/) {
        return 3;
    } elsif (/^(?:apr|april)$/) {
        return 4;
    } elsif (/^(?:mei|may)$/) {
        return 5;
    } elsif (/^(?:jun|jun[eiy])$/) {
        return 6;
    } elsif (/^(?:jul|jul[iy])$/) {
        return 7;
    } elsif (/^(?:agu|aug|ags?t|august|agustus)$/) {
        return 8;
    } elsif (/^(?:sep|september)$/) {
        return 9;
    } elsif (/^(?:o[kc]t|o[ct]ober)$/) {
        return 10;
    } elsif (/^(?:no[pv]|no[pv]ember)$/) {
        return 11;
    } elsif (/^(?:de[sc]|de[sc]ember)$/) {
        return 12;
    } else {
        die "Can't parse month: $_";
        #return 0;
    }
}

sub _parse_num {
    my ($self, $s) = @_;
    my $neg = $s =~ s/^\((.+)\)$/$1/;
    my $n = parse_number_id(text => $s);
    $neg ? -$n : $n;
}

sub login {
    die "Not yet implemented";
    my ($self) = @_;
    my $s = $self->site;

    return 1 if $self->logged_in;
    die "400 Username not supplied" unless $self->username;
    die "400 Password not supplied" unless $self->password;

    $self->logger->debug('Logging in ...');
    $self->_req(get => [$s]);
    $self->_req(submit_form => [
                                form_number => 1,
                                fields => {'value(user_id)'=>$self->username,
                                           'value(pswd)'=>$self->password,
                                           },
                                button => 'value(Submit)',
                                ],
                sub {
                    my ($mech) = @_;
                    $mech->content =~ /var err='(.+?)'/ and return $1;
                    $mech->content =~ /=logout"/ and return;
                    "unknown login result page";
                }
                                );
    $self->logged_in(1);
    $self->_req(get => ["$s/authentication.do?value(actions)=welcome"]);
    #$self->_req(get => ["$s/nav_bar_indo/menu_nav.htm"]); # failed?
}

sub logout {
    die "Not yet implemented";
    my ($self) = @_;

    return 1 unless $self->logged_in;
    $self->logger->debug('Logging out ...');
    $self->_req(get => [$self->site . "/authentication.do?value(actions)=logout"]);
    $self->logged_in(0);
}

sub _menu {
    my ($self) = @_;
    my $s = $self->site;
    $self->_req(get => ["$s/nav_bar_indo/account_information_menu.htm"]);
}

sub list_cards {
    die "Not yet implemented";
    my ($self) = @_;
    $self->login;
    $self->logger->info("Listing ATM cards");
    map { $_->{account} } $self->_check_balances;
}

sub _check_balances {
    my ($self) = @_;
    my $s = $self->site;

    my $re = qr!

  ]+>\s*]+>\s*]+>\s*(\d+)\s*\s*\s*
  ]+>\s*]+>\s*]+>\s*([^<]*?)\s*\s*\s*
  ]+>\s*]+>\s*]+>\s*([A-Z]+)\s*\s*\s*
  ]+>\s*]+>\s*]+>\s*([0-9,.]+)\.(\d\d)\s*\s*\s*
!x;

    $self->login;
    $self->_menu;
    $self->_req(post => ["$s/balanceinquiry.do"],
                sub {
                    my ($mech) = @_;
                    $mech->content =~ $re or
                        return "can't find balances, maybe page layout changed?";
                    '';
                }
    );

    my @res;
    my $content = $self->mech->content;
    while ($content =~ m/$re/og) {
        push @res, { account => $1,
                     account_type => $2,
                     currency => $3,
                     balance => $self->_stripD($4) + 0.01*$5,
                 };
    }
    @res;
}

sub check_balance {
    die "Not yet implemented";
    my ($self, $account) = @_;
    my @bals = $self->_check_balances;
    return unless @bals;
    return $bals[0]{balance} if !$account;
    for (@bals) {
        return $_->{balance} if $_->{account} eq $account;
    }
    return;
}

sub get_statement {
    die "Not yet implemented";
    my ($self, %args) = @_;
    my $s = $self->site;
    my $max_days = 31;

    $self->login;
    $self->_menu;
    $self->logger->info("Getting statement for ".
        ($args{account} ? "account `$args{account}'" : "default account")." ...");
    $self->_req(post => ["$s/accountstmt.do?value(actions)=acct_stmt"],
                sub {
                    my ($mech) = @_;
                    $mech->content =~ /
                        return "no form found, maybe we got logged out?";
                    '';
                });

    my $form = $self->mech->form_number(1);

    # in the site this is done by javascript onSubmit(), so we emulate it here
    $form->action("$s/accountstmt.do?value(actions)=acctstmtview");

    # in the case of the current date being a saturday/sunday/holiday, end
    # date will be forwarded 1 or more days from the current date by the site,
    # so we need to know end date and optionally forward start date when needed,
    # to avoid total number of days being > 31.

    my $today = DateTime->today;
    my $max_dt = DateTime->new(day   => $form->value("value(endDt)"),
                               month => $form->value("value(endMt)"),
                               year  => $form->value("value(endYr)"));
    my $cmp = DateTime->compare($today, $max_dt);
    my $delta_days = $cmp * $today->subtract_datetime($max_dt, $today)->days;
    if ($delta_days > 0) {
        $self->logger->warn("Something weird is going on, end date is being ".
                            "set less than today's date by the site (".
                            $self->_fmtdate($max_dt)."). ".
                            "Please check your computer's date setting. ".
                            "Continuing anyway.");
    }
    my $min_dt = $max_dt->clone->subtract(days => ($max_days-1));

    my $end_dt = $args{end_date} || $max_dt;
    my $start_dt = $args{start_date} ||
        $end_dt->clone->subtract(days => (($args{days} || $max_days)-1));
    if (DateTime->compare($start_dt, $min_dt) == -1) {
        $self->logger->warn("Start date ".$self->_fmtdate($start_dt)." is less than ".
                            "minimum date ".$self->_fmtdate($min_dt).". Setting to ".
                            "minimum date instead.");
        $start_dt = $min_dt;
    }
    if (DateTime->compare($start_dt, $max_dt) == 1) {
        $self->logger->warn("Start date ".$self->_fmtdate($start_dt)." is greater than ".
                            "maximum date ".$self->_fmtdate($max_dt).". Setting to ".
                            "maximum date instead.");
        $start_dt = $max_dt;
    }
    if (DateTime->compare($end_dt, $min_dt) == -1) {
        $self->logger->warn("End date ".$self->_fmtdate($end_dt)." is less than ".
                            "minimum date ".$self->_fmtdate($min_dt).". Setting to ".
                            "minimum date instead.");
        $end_dt = $min_dt;
    }
    if (DateTime->compare($end_dt, $max_dt) == 1) {
        $self->logger->warn("End date ".$self->_fmtdate($end_dt)." is greater than ".
                            "maximum date ".$self->_fmtdate($max_dt).". Setting to ".
                            "maximum date instead.");
        $end_dt = $max_dt;
    }
    if (DateTime->compare($start_dt, $end_dt) == 1) {
        $self->logger->warn("Start date ".$self->_fmtdate($start_dt)." is greater than ".
                            "end date ".$self->_fmtdate($end_dt).". Setting to ".
                            "end date instead.");
        $start_dt = $end_dt;
    }

    my $select = $form->find_input("value(D1)");
    my $d1 = $select->value;
    if ($args{account}) {
        my @d1 = $select->possible_values;
        my @accts = $select->value_names;
        for (0..$#accts) {
            if ($args{account} eq $accts[$_]) {
                $d1 = $d1[$_];
                last;
            }
        }
    }

    $self->_req(submit_form => [
                                form_number => 1,
                                fields => {
                                    "value(D1)" => $d1,
                                    "value(startDt)" => $start_dt->day,
                                    "value(startMt)" => $start_dt->month,
                                    "value(startYr)" => $start_dt->year,
                                    "value(endDt)" => $end_dt->day,
                                    "value(endMt)" => $end_dt->month,
                                    "value(endYr)" => $end_dt->year,
                                          },
                                ],
                sub {
                    my ($mech) = @_;
                    ''; # XXX check for error
                });
    my $parse_opts = $args{parse_opts} // {};
    my $resp = $self->parse_statement($self->mech->content, %$parse_opts);
    return if !$resp || $resp->[0] != 200;
    $resp->[2];
}

sub _ps_detect {
    my ($self, $page) = @_;
    unless ($page =~ />Detail Informasi Mutasi Rekening
        return "No BPR KS statement page signature found";
    }
    $self->_variant('individual');
    "";
}

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

    unless ($page =~ m!]*>No\. Rekening
        return "can't get account number";
    }
    $stmt->{account} = $1;

    my $adv1 = "probably the statement format changed, or input incomplete";

    unless ($page =~ m!]*>Periode Mutasi Rekening
        return "can't get statement period, $adv1";
    }
    $stmt->{start_date} = DateTime->new(day=>$+{d1}, month=>$self->_parse_mon($+{m1}), year=>$+{y1});
    $stmt->{end_date}   = DateTime->new(day=>$+{d2}, month=>$self->_parse_mon($+{m2}), year=>$+{y2});

    unless ($page =~ m!]*>Mata Uang
        return "can't get currency, $adv1";
    }
    $stmt->{currency} = ($1 eq 'Rp' ? 'IDR' : $1);

    unless ($page =~ m!]*>Nama
        return "can't get account holder, $adv1";
    }
    $stmt->{account_holder} = $1;

    # additional: Tipe: Tabungan

    unless ($page =~ m!]*>Mutasi Kredit
        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!]*>Mutasi Debet
        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!

  ]+>\s* (?\d\d/\d\d/\d\d\d\d) \s*
  ]+>\s* (?[^<]+?) \s*
  ]+>\s* (?[^<]+?) \s*
  ]+>\s* (?[^<]+?) \s*
  ]+>\s* (?[^<]+?) \s*

        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

__END__