use strict;
use Moose;
=head1 NAME
Finance::Bank::ID::BCA - Check your BCA accounts with Perl
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.01';
=head1 SYNOPSIS
use Finance::Bank::ID::BCA;
# FBI::BCA uses Log4perl. the easiest way to show logs is with these 2 lines:
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init($DEBUG);
my $ibank = Finance::Bank::ID::BCA->new(
username => 'ABCDEFGH1234', # optional if you're only using parse_statement()
password => '123456', # idem
);
eval {
$ibank->login(); # dies on error
my @accts = $ibank->list_accounts();
my $bal = $ibank->check_balance($acct); # $acct is optional
my $stmt = $ibank->get_statement(
account => ..., # opt, default account will be used if not specified
days => 31, # opt
start_date => DateTime->new(year=>2009, month=>10, day=>6),
# opt, takes precedence over 'days'
end_date => DateTime->today, # opt, takes precedence over 'days'
);
print "Transactions: ";
for my $tx (@{ $stmt->{transactions} }) {
print "$tx->{date} $tx->{amount} $tx->{description}\n";
}
};
# remember to call this, otherwise you will have trouble logging in again
# for some time
if ($ibank->logged_in) { $ibank->logout() }
# utility routines
my $stmt = $ibank->parse_statement($html_or_copy_pasted_text);
Also see the examples/ subdirectory in the distribution for a sample script using
this module.
=head1 DESCRIPTION
This module provide a rudimentary interface to the web-based online banking
interface of the Indonesian B<Bank Central Asia> (BCA) at
https://ibank.klikbca.com. You will need either L<Crypt::SSLeay> or
L<IO::Socket::SSL> installed for HTTPS support to work. L<WWW::Mechanize> is
required but you can supply your own mech-like object.
This module can only login to the retail/personal version of the site (KlikBCA
perorangan) and not the corporate/business version (KlikBCA bisnis) as the later
requires VPN and token input on login. But this module can parse statement page
from both versions.
Warning: This module is neither offical nor is it tested to be 100% save!
Because of the nature of web-robots, everything may break from one day to the
other when the underlying web interface changes.
=head1 WARNING
This warning is from Simon Cozens' C<Finance::Bank::LloydsTSB>, and seems just
as apt here.
This is code for B<online banking>, and that means B<your money>, and that means
B<BE CAREFUL>. You are encouraged, nay, expected, to audit the source of this
module yourself to reassure yourself that I am not doing anything untoward with
your banking data. This software is useful to me, but is provided under B<NO
GUARANTEE>, explicit or implied.
=head1 ERROR HANDLING AND DEBUGGING
Most methods die() when encountering errors, so you can use eval() to trap them.
This module uses Log::Log4perl, so you can see more debugging statements on
your screen, log files, etc.
Full response headers and bodies are dumped to a separate logger. See
documentation on C<new()> below and the sample script in examples/ subdirectory
in the distribution.
=head1 ATTRIBUTES
=cut
has _variant => (is => 'rw'); # bisnis or perorangan
=head1 METHODS
=cut
=head2 new(%args)
Create a new instance. %args keys:
=over
=item * username
Optional if you are just using utility methods like C<parse_statement()> and not
C<login()> etc.
=item * password
Optional if you are just using utility methods like C<parse_statement()> and not
C<login()> etc.
=item * mech
Optional. A L<WWW::Mechanize>-like object. By default this module instantiate a
new WWW::Mechanize object to retrieve web pages, but if you want to use a
custom/different one, you are allowed to do so here. Use cases include: you want
to retry and increase timeout due to slow/unreliable network connection (using
L<WWW::Mechanize::Plugin::Retry>), you want to slow things down using
L<WWW::Mechanize::Sleepy>, you want to use IE engine using
L<Win32::IE::Mechanize>, etc.
=item * logger
Optional. You can supply a L<Log::Log4perl>-like logger object here. If not
specified, this module will use a default logger
(C<Log::Log4perl->get_logger()>).
=item * logger_dump
Optional. You can supply a L<Log::Log4perl>-like logger object here. This is
just like C<logger> but this module will log contents of response here
instead of to C<logger_dump> for debugging purposes. You can configure
Log4perl with something like L<Log::Dispatch::Dir> to save web pages more
conveniently as separate files. If unspecified, the default logger is used:
C<Log::Log4perl->get_logger()>.
Note that response contents are logged using the TRACE level.
=back
=cut
sub BUILD {
my ($self, $args) = @_;
$self->site("https://ibank.klikbca.com") unless $self->site;
}
=head2 login()
Login to the net banking site. You actually do not have to do this explicitly as
login() is called by other methods like C<check_balance()> or
C<get_statement()>.
If login is successful, C<logged_in> will be set to true and subsequent calls to
C<login()> will become a no-op until C<logout()> is called.
Dies on failure.
=cut
sub login {
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?
}
=head2 logout()
Logout from the net banking site. You need to call this at the end of your
program, otherwise the site will prevent you from re-logging in for some time
(e.g. 10 minutes).
If logout is successful, C<logged_in> will be set to false and subsequent calls
to C<logout()> will become a no-op until C<login()> is called.
Dies on failure.
=cut
sub logout {
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"]);
}
=head2 list_accounts()
Return an array containing all account numbers that are associated with the
current net banking login.
=cut
sub list_accounts {
my ($self) = @_;
$self->login;
$self->logger->info("Listing accounts");
map { $_->{account} } $self->_check_balances;
}
sub _check_balances {
my ($self) = @_;
my $s = $self->site;
my $re = qr!
<tr>\s*
<td[^>]+>\s*<div[^>]+>\s*<font[^>]+>\s*(\d+)\s*</font>\s*</div>\s*</td>\s*
<td[^>]+>\s*<div[^>]+>\s*<font[^>]+>\s*([^<]*?)\s*</font>\s*</div>\s*</td>\s*
<td[^>]+>\s*<div[^>]+>\s*<font[^>]+>\s*([A-Z]+)\s*</font>\s*</div>\s*</td>\s*
<td[^>]+>\s*<div[^>]+>\s*<font[^>]+>\s*([0-9,.]+)\.(\d\d)\s*</font>\s*</div>\s*</td>
!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;
}
=head2 check_balance([$account])
Return balance for specified account, or the default account if C<$account> is
not specified.
=cut
sub check_balance {
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;
}
=head2 get_statement(%args)
Get account statement. %args keys:
=over
=item * account
Optional. Select the account to get statement of. If not specified, will use the
already selected account.
=item * days
Optional. Number of days between 1 and 31. If days is 1, then start date and end
date will be the same. Default is 31.
=item * start_date
Optional. Default is end_date - days.
=item * end_date
Optional. Default is today (or some 1+ days from today if today is a
Saturday/Sunday/holiday, depending on the default value set by the site's form).
=back
=cut
sub get_statement {
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 =~ /<form/i or
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 ($res, $h, $stmt) = $self->parse_statement($self->mech->content);
return if $res != 200;
$stmt;
}
=head2 parse_statement($html_or_text, %opts)
Given the HTML/copy-pasted text of the account statement results page, parse it
into structured data:
$stmt = {
start_date => $start_dt, # a DateTime object
end_date => $end_dt, # a DateTime object
account_holder => STRING,
account => STRING, # account number
currency => STRING, # 3-digit currency code
transactions => [
# first transaction
{
date => $dt, # a DateTime object, book date ("tanggal pembukuan")
seq => INT, # a number >= 1 which marks the sequence of transactions for the day
amount => REAL, # a real number, positive means credit (deposit), negative means debit (withdrawal)
description => STRING,
is_pending => BOOL,
branch => STRING, # a 4-digit branch/ATM code
balance => REAL,
},
# second transaction
...
]
}
If parsing failed, will return undef.
In list context, this method will return HTTP-style response instead:
($status, $err_details, $stmt)
C<$status> is 200 if successful or some other 3-letter code if parsing failed.
C<$stmt> is the result (structure as above, or undef if parsing failed).
=cut
sub _ps_detect {
my ($self, $page) = @_;
unless ($page =~ /(?:^\s*|&nbsp;)INFORMASI REKENING - MUTASI REKENING/mi) {
return "No KlikBCA statement page signature found";
}
$self->_variant($page =~ /^Kode Mata Uang/m ? 'bisnis' : 'perorangan');
"";
}
sub _ps_get_metadata {
my ($self, $page, $stmt) = @_;
unless ($page =~ /\s*(?:Nomor|No\.) [Rr]ekening\s*(?:<[^>]+>\s*)*[:\t]\s*(?:<[^>]+>\s*)*([\d-]+)/m) {
return "can't get account number";
}
$stmt->{account} = $self->_stripD($1);
$stmt->{account} =~ s/\D+//g;
my $adv1 = "probably the statement format changed, or input incomplete";
unless ($page =~ m!(?:^\s*|>)Periode\s*(?:<[^>]+>\s*)*[:\t]\s*(?:<[^>]+>\s*)*(\d\d)/(\d\d)/(\d\d\d\d) - (\d\d)/(\d\d)/(\d\d\d\d)!m) {
return "can't get statement period, $adv1";
}
$stmt->{start_date} = DateTime->new(day=>$1, month=>$2, year=>$3);
$stmt->{end_date} = DateTime->new(day=>$4, month=>$5, year=>$6);
unless ($page =~ /(?:^|>)(?:Kode )?Mata Uang\s*(?:<[^>]+>\s*)*[:\t]\s*(?:<[^>]+>\s*)*(Rp|[A-Z]+)/m) {
return "can't get currency, $adv1";
}
$stmt->{currency} = ($1 eq 'Rp' ? 'IDR' : $1);
unless ($page =~ /(?:^|>)Nama\s*(?:<[^>]+>\s*)*[:\t]\s*(?:<[^>]+>\s*)*([^<\015\012]+)/m) {
return "can't get total credit, $adv1";
}
$stmt->{account_holder} = $1;
unless ($page =~ /(?:^|>)Mutasi Kredit\s*(?:<[^>]+>\s*)*[:\t]\s*(?:<[^>]+>\s*)*([0-9,.]+)\.(\d\d)(?:\s*\t\s*(\d+))?/m) {
return "can't get total credit, $adv1";
}
$stmt->{_total_credit_in_stmt} = $self->_stripD($1) + 0.01*$2;
$stmt->{_num_credit_tx_in_stmt} = $3 if $3;
unless ($page =~ /(?:^|>)Mutasi Debet\s*(?:<[^>]+>\s*)*[:\t]\s*(?:<[^>]+>\s*)*([0-9,.]+)\.(\d\d)(?:\s*\t\s*(\d+))?/m) {
return "can't get total credit, $adv1";
}
$stmt->{_total_debit_in_stmt} = $self->_stripD($1) + 0.01*$2;
$stmt->{_num_debit_tx_in_stmt} = $3 if $3;
"";
}
sub _ps_get_transactions {
my ($self, $page, $stmt) = @_;
my @e;
# text version
while ($page =~ m!^(\d\d/\d\d| ?PEND| ?NEXT)\s*\t\s*((?:[^\t]|\n)*?)\s*\t\s*(\d{4})\s*\t\s*([0-9,]+)\.(\d\d)\s*\t?\s*(CR|DB)\s*\t\s*([0-9,]+)\.(\d\d)!mg) {
push @e, {date=>$1, desc=>$2, br=>$3, amt=>$4, amtf=>$5, crdb=>$6, bal=>$7, balf=>$8};
}
if (!@e) {
# HTML version
while ($page =~ m!^
<tr>\s*
<td[^>]+>(?:<[^>]+>\s*)* (\d\d/\d\d|\s?PEND|\s?NEXT) (?:<[^>]+>\s*)*</td>\s*
<td[^>]+>(?:<[^>]+>\s*)* ((?:[^\t]|\n)*?) (?:<[^>]+>\s*)*</td>\s*
<td[^>]+>(?:<[^>]+>\s*)* (\d{4}) (?:<[^>]+>\s*)*</td>\s*
<td[^>]+>(?:<[^>]+>\s*)* ([0-9,]+)\.(\d\d) (?:<[^>]+>\s*)*</td>\s*
<td[^>]+>(?:<[^>]+>\s*)* (CR|DB) (?:<[^>]+>\s*)*</td>\s*
<td[^>]+>(?:<[^>]+>\s*)* ([0-9,]+)\.(\d\d) (?:<[^>]+>\s*)*</td>\s*
</tr>!smxg) {
push @e, {date=>$1, desc=>$2, br=>$3, amt=>$4, amtf=>$5, crdb=>$6, bal=>$7, balf=>$8};
}
for (@e) { $_->{desc} =~ s!<br ?/?>!\n!ig }
}
my @tx;
my $last_date;
my $seq;
my $i = 0;
for my $e (@e) {
$i++;
my $tx = {};
#$tx->{stmt_start_date} = $stmt->{start_date};
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) = split m!/!, $e->{date};
my $last_nonpend_date = DateTime->new(
year => ($mon < $stmt->{start_date}->month ?
$stmt->{end_date}->year :
$stmt->{start_date}->year),
month => $mon,
day => $day);
$tx->{date} = $last_nonpend_date;
$tx->{is_pending} = 0;
}
$tx->{description} = $e->{desc};
$tx->{branch} = $e->{br};
$tx->{amount} = ($e->{crdb} =~ /CR/ ? 1 : -1) * ($self->_stripD($e->{amt}) + 0.01*$e->{amtf});
$tx->{balance} = ($self->_stripD($e->{bal}) + 0.01*$e->{balf});
if (!$last_date || DateTime->compare($last_date, $tx->{date})) {
$seq = 1;
$last_date = $tx->{date};
} else {
$seq++;
}
$tx->{seq} = $seq;
if ($self->_variant eq 'perorangan' &&
$tx->{date}->dow =~ /6|7/ &&
$tx->{description} !~ /^(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";
# note: in KlikBCA perorangan, BIAYA ADM is set on Fridays
}
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
}
push @tx, $tx;
}
$stmt->{transactions} = \@tx;
"";
}
=head1 AUTHOR
Steven Haryanto, C<< <stevenharyanto at gmail.com> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-finance-bank-id-bca at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Finance-Bank-ID-BCA>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Finance::Bank::ID::BCA
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
=item * AnnoCPAN: Annotated CPAN documentation
=item * CPAN Ratings
=item * Search CPAN
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2009 Steven Haryanto.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
__PACKAGE__->meta->make_immutable;
1;