File Coverage

blib/lib/Finance/Bank/ID/Mandiri.pm
Criterion Covered Total %
statement 213 329 64.7
branch 97 176 55.1
condition 23 40 57.5
subroutine 16 29 55.1
pod 5 6 83.3
total 354 580 61.0


line stmt bran cond sub pod time code
1             package Finance::Bank::ID::Mandiri;
2              
3             our $DATE = '2019-05-13'; # DATE
4             our $VERSION = '0.382'; # VERSION
5              
6 1     1   685822 use 5.010001;
  1         12  
7              
8 1     1   543 use Moo;
  1         9424  
  1         4  
9              
10 1     1   2023 use HTTP::Headers;
  1         3998  
  1         40  
11 1     1   488 use HTTP::Headers::Patch::DontUseStorable -load_target=>0;
  1         10392  
  1         8  
12 1     1   772 use Parse::Number::EN qw(parse_number_en);
  1         381  
  1         3545  
13              
14             extends 'Finance::Bank::ID::Base';
15              
16             has _variant => (is => 'rw');
17             has _re_tx => (is => 'rw');
18              
19             my $re_acc = qr/(?:\d{13})/;
20             my $re_currency = qr/(?:\w{3})/;
21             my $re_money = qr/(?:\d+(?:\.\d\d?)?)/;
22             my $re_moneymin = qr/(?:-?\d+(?:\.\d\d?)?)/; # allow negative
23             my $re_money2 = qr/(?:[\d,]*(?:\.\d\d?)?)/; # allow starts with ., e.g. .00. formatted thousand=, decimal=.
24             my $re_date1 = qr!(?:\d{2}/\d{2}/\d{4})!; # 25/12/2010
25             my $re_txcode = qr!(?:\d{3,4})!;
26              
27             # original version when support first added
28             our $re_mcm_v201009 = qr!^(?<acc>$re_acc);(?<currency>$re_currency);
29             (?<date_d>\d\d)/(?<date_m>\d\d)/(?<date_y>\d\d\d\d)
30             (?<txcode>$re_txcode);
31             (?<desc1>[^;]+);(?<desc2>.*?);
32             (?<amount>$re_money)(?<amount_dbmarker>DR)?;
33             (?<bal>$re_money)(?<bal_dbmarker>DR)?$!mx;
34              
35             # what's new: third line argument
36             our $re_mcm_v201103 = qr!^(?<acc>$re_acc);(?<currency>$re_currency);
37             (?<date_d>\d\d)/(?<date_m>\d\d)/(?<date_y>\d\d\d\d)
38             (?<txcode>$re_txcode);
39             (?<desc1>[^;]+);(?<desc2>[^;]*);(?:(?<desc3>.*?);)?
40             (?<amount>$re_money)(?<amount_dbmarker>DR)?;
41             (?<bal>$re_money)(?<bal_dbmarker>DR)?$!mx;
42              
43             # what's new: txcode moved to 3rd column, credit & debit amount split into 2
44             # fields
45             our $re_mcm_v201107 = qr!^(?<acc>$re_acc);(?<currency>$re_currency);
46             (?<txcode>$re_txcode);
47             (?<date_d>\d\d)/(?<date_m>\d\d)/(?<date_y>\d\d\d\d);
48             (?<desc1>[^;]+);(?<desc2>[^;]*);(?:(?<desc3>.*?);)?
49             (?<amount_db>$re_money);
50             (?<amount_cr>$re_money);
51             (?<bal>$re_moneymin)!mx; # maybe? no more DR marker
52              
53             # what's different: a CSV (comma as field separator), a header field,
54             # no more currency field, two dates.
55             # header: Account No,Date,Val. Date,Transaction Code,Description,Description,Reference No.,Debit,Credit,
56             our $re_mcm_v201901 = qr!^(?<acc>$re_acc),
57             (?<date_d>\d\d)/(?<date_m>\d\d)/(?<date_y>\d\d),
58             (?<vdate_d>\d\d)/(?<vdate_m>\d\d)/(?<vdate_y>\d\d),
59             (?<txcode>$re_txcode),
60             "(?<desc1>[^"]*)","(?<desc2>[^"]*)",
61             (?<reference_no>[^,]*),
62             "(?<amount_db>$re_money2)",
63             "(?<amount_cr>$re_money2)",
64             !mx;
65              
66              
67             sub _make_readonly_inputs_rw {
68 0     0   0 my ($self, @forms) = @_;
69 0         0 for my $f (@forms) {
70 0         0 for my $i (@{ $f->{inputs} }) {
  0         0  
71 0 0       0 $i->{readonly} = 0 if $i->{readonly};
72             }
73             }
74             }
75              
76             sub BUILD {
77 1     1 0 4945 my ($self, $args) = @_;
78              
79 1 50       14 $self->site("https://ib.bankmandiri.co.id") unless $self->site;
80 1 50       24 $self->https_host("ib.bankmandiri.co.id") unless $self->https_host;
81             }
82              
83             sub login {
84 0     0 1 0 my ($self) = @_;
85              
86 0 0       0 return 1 if $self->logged_in;
87 0 0       0 die "400 Username not supplied" unless $self->username;
88 0 0       0 die "400 Password not supplied" unless $self->password;
89              
90 0         0 $self->logger->debug('Logging in ...');
91             $self->_req(get => [$self->site . "/retail/Login.do?action=form&lang=in_ID"],
92             {
93             id => 'login_form',
94             after_request => sub {
95 0     0   0 my ($mech) = @_;
96 0 0       0 $mech->content =~ /LoginForm/ or return "no login form";
97 0         0 "";
98             },
99 0         0 });
100 0         0 $self->mech->set_visible(
101             $self->username,
102             $self->password,
103             [image=>"x"]);
104             $self->_req(submit => [],
105             {
106             id => 'login',
107             after_request => sub {
108 0     0   0 my ($mech) = @_;
109 0 0       0 $mech->content =~ m!<font class="errorMessage">(.+?)</font>! and return $1;
110 0 0       0 $mech->content =~ /<frame\s.+Welcome/ and return; # success
111 0 0       0 $mech->content =~ m!<font class="alert">(\w.+?)</font>! and return $1;
112 0 0       0 $mech->content =~ /LoginForm/ and
113             return "submit failed, still getting login form, probably problem with image button";
114 0         0 "unknown login result page";
115             },
116 0         0 });
117             $self->_req(get => [$self->site . "/retail/Welcome.do?action=result"],
118             {
119             id => 'welcome',
120             after_request => sub {
121 0     0   0 my ($mech) = @_;
122 0 0       0 $mech->content !~ /SELAMAT DATANG/ and
123             return "failed getting welcome screen";
124 0         0 "";
125             },
126 0         0 });
127 0         0 $self->logged_in(1);
128             }
129              
130             sub logout {
131 0     0 1 0 my ($self) = @_;
132              
133 0 0       0 return 1 unless $self->logged_in;
134 0         0 $self->logger->debug('Logging out ...');
135 0         0 $self->_req(get => [$self->site . "/retail/Logout.do?action=result"],
136             {id => 'logout'});
137 0         0 $self->logged_in(0);
138             }
139              
140             sub _parse_accounts {
141 0     0   0 my ($self, $retrieve) = @_;
142 0         0 $self->login;
143 0         0 $self->logger->debug("Parsing accounts from transaction history form page ...");
144 0 0       0 $self->_req(get => [$self->site . "/retail/TrxHistoryInq.do?action=form"],
145             {id => 'txhist_form-parse_accounts'}) if $retrieve;
146 0         0 my $ct = $self->mech->content;
147 0 0       0 $ct =~ /(HISTORI TRANSAKSI|MUTASI REKENING)/ or
148             die "failed getting transaction history form page";
149 0 0       0 $ct =~ m!<select name="fromAccountID">(.+?)</select>!si or
150             die "failed getting the list of accounts select box (fromAccountID)";
151 0         0 my $opts = $1;
152 0         0 my $accts = {};
153 0         0 while ($opts =~ /<option value="(\d+)">(\d+)/g) {
154 0         0 $accts->{$2} = $1;
155             }
156 0         0 $accts;
157             }
158              
159             # if $account is not supplied, will choose the first id
160             sub _get_an_account_id {
161 0     0   0 my ($self, $account, $retrieve) = @_;
162 0         0 my $accts = $self->_parse_accounts($retrieve);
163 0         0 for (keys %$accts) {
164 0 0 0     0 if (!$account || $_ eq $account) {
165 0         0 return $accts->{$_};
166             }
167             }
168 0         0 die "cannot find any account ID";
169             }
170              
171             sub list_accounts {
172 0     0 1 0 my ($self) = @_;
173 0         0 keys %{ $self->_parse_accounts(1) };
  0         0  
174             }
175              
176             sub check_balance {
177 0     0 1 0 my ($self, $account) = @_;
178 0         0 my $s = $self->site;
179              
180 0         0 $self->login;
181 0         0 my $acctid = $self->_get_an_account_id($account, 1);
182 0         0 my $bal;
183             $self->_req(get => ["$s/retail/AccountDetail.do?action=result&ACCOUNTID=$acctid"],
184             {
185             id => "check_balance",
186             after_request => sub {
187 0     0   0 my ($mech) = @_;
188 0 0       0 $mech->content =~ m!>Informasi Saldo(?:<[^>]+>\s*)*:\s*(?:<[^>]+>\s*)*(?:Rp\.)&nbsp;([0-9.]+),(\d+)\s*<!s
189             or return "cannot grep balance in result page";
190 0         0 $bal = $self->_stripD($1)+0.01*$2;
191 0         0 "";
192             },
193 0         0 });
194 0         0 $bal;
195             }
196              
197             sub get_statement {
198 0     0 1 0 require DateTime;
199              
200 0         0 my ($self, %args) = @_;
201 0         0 my $s = $self->site;
202              
203 0         0 $self->login;
204              
205 0         0 $self->logger->debug('Getting statement ...');
206 0         0 my $mech = $self->mech;
207 0         0 $self->_req(get => ["$s/retail/TrxHistoryInq.do?action=form"],
208             {id=>"txhist_form-get_statement"});
209              
210 0         0 my $today = DateTime->today;
211 0   0     0 my $end_date = $args{end_date} || $today;
212 0         0 my $start_date = $args{start_date};
213 0 0       0 if (!$start_date) {
214 0 0       0 if (defined $args{days}) {
215 0         0 $start_date = $end_date->clone->subtract(days=>($args{days}-1));
216             $self->logger->debug(sprintf(
217             'Setting start_date to %04d-%02d-%02d (end_date - %d days)',
218             $start_date->year, $start_date->month, $start_date->day,
219 0         0 $args{days}));
220             } else {
221 0         0 $start_date = $end_date->clone->subtract(months=>1);
222 0         0 $self->logger->debug(sprintf(
223             'Setting start_date to %04d-%02d-%02d (end_date - 1mo)',
224             $start_date->year, $start_date->month, $start_date->day));
225             }
226             }
227              
228             $mech->set_fields(
229 0         0 fromAccountID => $self->_get_an_account_id($args{account}, 0),
230             fromDay => $start_date->day,
231             fromMonth => $start_date->month,
232             fromYear => $start_date->year,
233             toDay => $end_date->day,
234             toMonth => $end_date->month,
235             toYear => $end_date->year,
236             );
237              
238             # to shut up HTML::Form's read-only warning
239 0         0 $self->_make_readonly_inputs_rw($mech->forms);
240              
241 0         0 $mech->set_fields(action => "result");
242              
243             $self->_req(submit => [],
244             {
245             id => "get_statement",
246             after_request => sub {
247 0     0   0 my ($mech) = @_;
248 0 0       0 $mech->content =~ />Keterangan Transaksi</ and return "";
249 0 0       0 $mech->content =~ m!<font class="alert">(.+)</font>!
250             and return $1;
251 0         0 return "failed getting statement";
252             },
253 0         0 });
254              
255 0         0 my $resp = $self->parse_statement($self->mech->content);
256 0 0 0     0 return if !$resp || $resp->[0] != 200;
257 0         0 $resp->[2];
258             }
259              
260             sub _ps_detect {
261 7     7   150367 my ($self, $page) = @_;
262 7 100       562 if ($page =~ /(?:^|"header">)(HISTORI TRANSAKSI|MUTASI REKENING)/m) {
    100          
    100          
    100          
    50          
263 3         18 $self->_variant('ib');
264 3         11 return '';
265             } elsif ($page =~ /^CMS-Mandiri/ms) {
266 1         6 $self->_variant('cms');
267 1         4 return '';
268             #} elsif ($page =~ /$re_mcm_v201009/) {
269             # $self->_variant('mcm-v201009');
270             # $self->_re_tx($re_mcm_v201009);
271             # return '';
272             } elsif ($page =~ /$re_mcm_v201901/) {
273 1         6 $self->_variant('mcm-v201901');
274 1         4 $self->_re_tx($re_mcm_v201901);
275 1         4 return '';
276             } elsif ($page =~ /$re_mcm_v201103/) {
277 1         8 $self->_variant('mcm-v201103');
278 1         5 $self->_re_tx($re_mcm_v201103);
279 1         5 return '';
280             } elsif ($page =~ /$re_mcm_v201107/) {
281 1         9 $self->_variant('mcm-v201107');
282 1         5 $self->_re_tx($re_mcm_v201107);
283 1         4 return '';
284             } else {
285 0         0 return "No Mandiri statement page signature found";
286             }
287             }
288              
289             sub _ps_get_metadata {
290 7     7   50 my ($self, @args) = @_;
291 7 100       46 if ($self->_variant eq 'ib') {
    100          
    50          
292 3         13 $self->_ps_get_metadata_ib(@args);
293             } elsif ($self->_variant eq 'cms') {
294 1         5 $self->_ps_get_metadata_cms(@args);
295             } elsif ($self->_variant =~ /^mcm/) {
296 3         13 $self->_ps_get_metadata_mcm(@args);
297             } else {
298 0         0 return "internal bug: _variant not yet set";
299             }
300             }
301              
302             sub _ps_get_metadata_ib {
303 3     3   24 require DateTime;
304              
305 3         11 my ($self, $page, $stmt) = @_;
306              
307 3 50       48 unless ($page =~ /Tampilkan Berdasarkan(?:\s+|(?:<[^>]+>\s*)*):(?:\s+|(?:<[^>]+>\s*)*)Tanggal(?:\s+|(?:<[^>]+>\s*)*)Urutkan Berdasarkan(?:\s+|(?:<[^>]+>\s*)*):(?:\s+|(?:<[^>]+>\s*)*)Mulai dari yang kecil/s) {
308 0         0 return "currently only support descending order ('Mulai dari yang kecil')";
309             }
310              
311 3         7 my $adv1 = "maybe statement format changed or input incomplete";
312              
313 3 50       26 unless ($page =~ /(?:^|>)Nomor Rekening(?:\s+|(?:<[^>]+>\s*)*):(?:\s+|(?:<[^>]+>\s*)*)(\d+) (Rp\.|[A-Z]+)/m) {
314 0         0 return "can't get account number, $adv1";
315             }
316 3         14 $stmt->{account} = $1;
317 3 50       14 $stmt->{currency} = ($2 eq 'Rp.' ? 'IDR' : $2);
318              
319 3 50       20 my $empty_stmt = $page =~ />Tidak ditemukan catatan</ ? 1:0;
320              
321             # check completeness, because the latest transactions are displayed first
322 3 50 33     37 unless ($empty_stmt ||
323             $page =~ /(?:|>)Saldo Akhir(?:\s+|(?:<[^>]+>\s*)*):(?:\s+|(?:<[^>]+>\s*)*)\d/m) {
324 0         0 return "statement page probably truncated in the middle, try to input the whole page";
325             }
326              
327             # along with their common misspellings, these are not in DateTime::Locale
328 3         40 my %shortmon_id = (Jan=>1, Feb=>2, Peb=>2, Mar=>3, Apr=>4, Mei=>5, Jun=>6,
329             Jul=>7, Agu=>8, Agt=>8, Agus=>8, Agust=>8, Sep=>9,
330             Sept=>9, Okt=>10, Nov=>11, Nop=>11, Des=>12);
331 3         22 my %shortmon_en = (Jan=>1, Feb=>2, Mar=>3, Apr=>4, May=>5, Jun=>6,
332             Jul=>7, Aug=>8, Sep=>9, Oct=>10, Nov=>11, Dec=>12);
333 3         28 my %shortmon = (%shortmon_id, %shortmon_en);
334 3         24 my $shortmon_re = join "|", keys(%shortmon);
335 3         283 $shortmon_re = qr/(?:$shortmon_re)/;
336              
337 3 50       372 unless ($page =~ m!(?:^|>)Periode Transaksi(?:\s+|(?:<[^>]+>\s*)*):(?:\s+|(?:<[^>]+>\s*)*)(\d\d?) ($shortmon_re) (\d\d\d\d)\s*-\s*(\d\d?) ($shortmon_re) (\d\d\d\d)!m) {
338 0         0 return "can't get period, $adv1";
339             }
340 3 50       21 return "can't parse month name: $2" unless $shortmon{$2};
341 3 50       11 return "can't parse month name: $5" unless $shortmon{$5};
342 3         30 $stmt->{start_date} = DateTime->new(day=>$1, month=>$shortmon{$2}, year=>$3);
343 3         1217 $stmt->{end_date} = DateTime->new(day=>$4, month=>$shortmon{$5}, year=>$6);
344              
345             # for safety, but i forgot why
346 3         938 my $today = DateTime->today;
347 3 50       1809 if (DateTime->compare($stmt->{start_date}, $today) == 1) {
348 0         0 $stmt->{start_date} = $today;
349             }
350 3 50       717 if (DateTime->compare($stmt->{end_date}, $today) == 1) {
351 0         0 $stmt->{end_date} = $today;
352             }
353              
354 3 50       590 if ($empty_stmt) {
355 0         0 $stmt->{_total_credit_in_stmt} = 0;
356 0         0 $stmt->{_total_debit_in_stmt} = 0;
357             } else {
358 3 50       46 unless ($page =~ /(?:^|>)Total Kredit(?:\s+|(?:<[^>]+>\s*)*):(?:\s+|(?:<[^>]+>\s*)*)([0-9,.]+)[.,](\d\d)/m) {
359 0         0 return "can't get total credit, $adv1";
360             }
361 3         18 $stmt->{_total_credit_in_stmt} = $self->_stripD($1) + 0.01*$2;
362              
363 3 50       81 unless ($page =~ /(?:^|>)Total Debet(?:\s+|(?:<[^>]+>\s*)*):(?:\s+|(?:<[^>]+>\s*)*)([0-9,.]+)[.,](\d\d)/m) {
364 0         0 return "can't get total debit, $adv1";
365             }
366 3         9 $stmt->{_total_debit_in_stmt} = $self->_stripD($1) + 0.01*$2;
367             }
368              
369 3         72 "";
370             }
371              
372             sub _ps_get_metadata_cms {
373 1     1   8 require DateTime;
374              
375 1         6 my ($self, $page, $stmt) = @_;
376              
377 1 50       9 unless ($page =~ /^- End Of Statement -/m) {
378 0         0 return "statement page truncated in the middle, please input the whole page";
379             }
380              
381 1 50       10 unless ($page =~ /^Account No\s*:\s*(\d+)/m) {
382 0         0 return "can't get account number";
383             }
384 1         5 $stmt->{account} = $1;
385              
386 1 50       13 unless ($page =~ /^Account Name\s*:\s*(.+?)[\012\015]/m) {
387 0         0 return "can't get account holder";
388             }
389 1         3 $stmt->{account_holder} = $1;
390              
391 1 50       8 unless ($page =~ /^Currency\s*:\s*([A-Z]+)/m) {
392 0         0 return "can't get account holder";
393             }
394 1         3 $stmt->{currency} = $1;
395              
396 1         2 my $adv1 = "maybe statement format changed, or input incomplete";
397              
398 1 50       10 unless ($page =~ m!Period\s*:\s*(\d\d?)/(\d\d?)/(\d\d\d\d)\s*-\s*(\d\d?)/(\d\d?)/(\d\d\d\d)!m) {
399 0         0 return "can't get statement period, $adv1";
400             }
401 1         9 $stmt->{start_date} = DateTime->new(day=>$1, month=>$2, year=>$3);
402 1         311 $stmt->{end_date} = DateTime->new(day=>$4, month=>$5, year=>$6);
403              
404             # for safety, but i forgot why
405 1         288 my $today = DateTime->today;
406 1 50       599 if (DateTime->compare($stmt->{start_date}, $today) == 1) {
407 0         0 $stmt->{start_date} = $today;
408             }
409 1 50       211 if (DateTime->compare($stmt->{end_date}, $today) == 1) {
410 0         0 $stmt->{end_date} = $today;
411             }
412              
413             # Mandiri sucks, doesn't provide total credit/debit in statement
414 1         190 my $n = 0;
415 1         12 while ($page =~ m!^\d\d?/\d\d?\s!mg) { $n++ }
  3         12  
416 1         3 $stmt->{_num_tx_in_stmt} = $n;
417 1         8 "";
418             }
419              
420             sub _ps_get_metadata_mcm {
421 3     3   27 require DateTime;
422              
423 3         33 my ($self, $page, $stmt) = @_;
424              
425 3         12 my $re_tx = $self->_re_tx;
426              
427 3 50       41 $page =~ m!$re_tx!
428             or return "can't get account number & currency & date";
429 1     1   476 $stmt->{account} = $+{acc};
  1         463  
  1         2175  
  3         36  
430 3   100     25 $stmt->{currency} = $+{currency} // "IDR"; # assume if not given
431             $stmt->{start_date} = DateTime->new(
432 3 100       51 day=>$+{date_d}, month=>$+{date_m}, year=>($+{date_y} < 100 ? 2000:0)+$+{date_y});
433              
434             # we'll just assume the first and last transaction date to be start and
435             # end date of statement, because the semicolon format doesn't include
436             # any other metadata.
437 3 50       1363 $page =~ m!.*$re_tx!s or return "can't get end date";
438             $stmt->{end_date} = DateTime->new(
439 3 100       53 day=>$+{date_d}, month=>$+{date_m}, year=>($+{date_y} < 100 ? 2000:0)+$+{date_y});
440              
441             # Mandiri sucks, doesn't provide total credit/debit in statement
442 3         898 my $n = 0;
443 3         20 while ($page =~ m!^\d{13}[;,]!mg) { $n++ }
  13         40  
444 3         8 $stmt->{_num_tx_in_stmt} = $n;
445 3         16 "";
446             }
447              
448             sub _ps_get_transactions {
449 7     7   50 my ($self, @args) = @_;
450 7 100       52 if ($self->_variant eq 'ib') {
    100          
    50          
451 3         11 $self->_ps_get_transactions_ib(@args);
452             } elsif ($self->_variant eq 'cms') {
453 1         6 $self->_ps_get_transactions_cms(@args);
454             } elsif ($self->_variant =~ /^mcm/) {
455 3         91 $self->_ps_get_transactions_mcm(@args);
456             } else {
457 0         0 return "internal bug: _variant not yet set";
458             }
459             }
460              
461             sub _ps_get_transactions_ib {
462 3     3   20 require DateTime;
463              
464 3         10 my ($self, $page, $stmt) = @_;
465              
466 3         8 my @tx;
467             my @skipped_tx;
468              
469 3 50       21 goto DONE if $page =~ m!>Tidak ditemukan catatan<!;
470              
471 3         7 my @e;
472             # text version
473 3         126 while ($page =~ m!^(\d\d)/(\d\d)/(\d\d\d\d)\s*\t\s*((?:[^\t]|\n)*?)\s*\t\s*([0-9.]+),(\d\d)\s*\t\s*([0-9.]+),(\d\d)!mg) {
474 4         64 push @e, {day=>$1, mon=>$2, year=>$3, desc=>$4, db=>$5, dbf=>$6, cr=>$7, crf=>$8};
475             }
476 3 100       32 if (!@e) {
477             # HTML version
478 1         134 while ($page =~ m!^\s+<tr[^>]*>\s*
479             <td[^>]+> (\d\d)/(\d\d)/(\d\d\d\d) \s* </td>\s*
480             <td[^>]+> ((?:[^\t]|\n)*?) </td>\s*
481             <td[^>]+> ([0-9.]+),(\d\d) </td>\s*
482             <td[^>]+> ([0-9.]+),(\d\d) </td>\s*
483             </tr>!smxg) {
484 2         130 push @e, {day=>$1, mon=>$2, year=>$3, desc=>$4, db=>$5, dbf=>$6, cr=>$7, crf=>$8};
485             }
486 1         4 for (@e) { $_->{desc} =~ s!<br ?/?>!\n!ig }
  2         27  
487             }
488              
489             # when they say "kecil ke besar" they actually mean showing the latest transactions first
490 3         7 @e = reverse @e;
491              
492 3         6 my $seq;
493 3         4 my $i = 0;
494 3         6 my $last_date;
495 3         7 for my $e (@e) {
496 6         10 $i++;
497 6         12 my $tx = {};
498 6         27 $tx->{date} = DateTime->new(day=>$e->{day}, month=>$e->{mon}, year=>$e->{year});
499 6         1821 $tx->{description} = $e->{desc};
500 6         22 my $db = $self->_stripD($e->{db}) + 0.01*$e->{dbf};
501 6         74 my $cr = $self->_stripD($e->{cr}) + 0.01*$e->{crf};
502 6 100       70 if ($db == 0) { $tx->{amount} = $cr }
  3 50       6  
503 3         8 elsif ($cr == 0) { $tx->{amount} = -$db }
504 0         0 else { return "check failed in tx#$i: debit and credit both exist" }
505              
506 6 100 66     27 if (!$last_date || DateTime->compare($last_date, $tx->{date})) {
507 3         17 $seq = 1;
508 3         8 $last_date = $tx->{date};
509             } else {
510 3         244 $seq++;
511             }
512 6         13 $tx->{seq} = $seq;
513              
514             # skip reversal pair (tx + tx') because tx' is just a correction
515             # reversal and the pair will be removed anyway by Mandiri in the next
516             # day's statement. currently can only handle pair in the same day and in
517             # succession.
518 6 50 66     36 if ($seq > 1 && $tx->{description} =~ /^Reversal \(Error Correction\)/ &&
      33        
519             $tx->{amount} == -$tx[-1]{amount}) {
520 0         0 push @skipped_tx, pop(@tx);
521 0         0 push @skipped_tx, $tx;
522 0         0 $seq -= 2;
523             } else {
524 6         20 push @tx, $tx;
525             }
526             }
527              
528             DONE:
529 3         17 $stmt->{transactions} = \@tx;
530 3         12 $stmt->{skipped_transactions} = \@skipped_tx;
531 3         23 "";
532             }
533              
534             sub _ps_get_transactions_cms {
535 1     1   6 require DateTime;
536              
537 1         4 my ($self, $page, $stmt) = @_;
538              
539 1 50       28 if ($page =~ /<br|<p/i) {
540 0         0 return "sorry, HTML version is not yet supported";
541             }
542              
543 1         3 my @e;
544             # text version
545 1         19 while ($page =~ m!^(\d\d?)/(\d\d?)\s+(\d\d?)/(\d\d?)\s+(.*?)\t(.*)\s+([0-9.]+),(\d\d) ([CD])\s+([0-9.]+),(\d\d) ([CD])!mg) {
546             # date (=tgl transaksi), value date (=tgl pembukuan?), description ("Setor Tunai"), description 2 ("DARI Andi Budi"), amount, balance
547 3         72 push @e, {daytx=>$1, montx=>$2, daybk=>$3, monbk=>$4, desc1=>$5, desc2=>$6,
548             amt=>$7, amtf=>$8, amtc=>$9, bal=>$10, balf=>11, balc=>12};
549             }
550              
551 1         5 my @tx;
552             my $seq;
553 1         0 my $last_date;
554 1         4 for my $e (@e) {
555 3         7 my $tx = {};
556             $tx->{tx_date} = DateTime->new(
557             day => $e->{daytx},
558             month => $e->{montx},
559             year => (($e->{montx} < $stmt->{start_date}->mon ||
560             $e->{montx} == $stmt->{start_date}->mon && $e->{daytx} == $stmt->{start_date}->day) ?
561             $stmt->{end_date}->year : $stmt->{start_date}->year)
562 3 100 66     15 );
563             $tx->{book_date} = DateTime->new(
564             day => $e->{daybk},
565             month => $e->{monbk},
566             year => (($e->{monbk} < $stmt->{start_date}->mon ||
567             $e->{monbk} == $stmt->{start_date}->mon && $e->{daybk} == $stmt->{start_date}->day) ?
568             $stmt->{end_date}->year : $stmt->{start_date}->year)
569 3 100 66     935 );
570 3         895 $tx->{date} = $tx->{book_date};
571              
572 3 100       19 $tx->{amount} = ($e->{amtc} eq 'C' ? 1:-1) * $self->_stripD($e->{amt}) + 0.01 * $e->{amtf};
573 3 50       52 $tx->{balance} = ($e->{balc} eq 'C' ? 1:-1) * $self->_stripD($e->{bal}) + 0.01 * $e->{balf};
574 3         42 $tx->{description} = $e->{desc1} . "\n" . $e->{desc2};
575              
576 3 100 100     14 if (!$last_date || DateTime->compare($last_date, $tx->{date})) {
577 2         80 $seq = 1;
578 2         5 $last_date = $tx->{date};
579             } else {
580 1         145 $seq++;
581             }
582 3         7 $tx->{seq} = $seq;
583              
584 3         8 push @tx, $tx;
585             }
586 1         3 $stmt->{transactions} = \@tx;
587 1         10 "";
588             }
589              
590             sub _ps_get_transactions_mcm {
591 3     3   22 require DateTime;
592              
593 3         10 my ($self, $page, $stmt) = @_;
594              
595 3         12 my $re_tx = $self->_re_tx;
596              
597 3 100       18 my $skip_header = $self->_variant =~ /^mcm-v201901/ ? 1:0;
598 3 100       12 my $num_formatted = $self->_variant =~ /^mcm-v201901/ ? 1:0;
599              
600 3         6 my @rows;
601 3         6 my $i = 0;
602 3         46 for (split /\r?\n/, $page) {
603 14         28 $i++;
604 14 100 100     44 next if $skip_header && $i == 1;
605 13 50       48 next unless /\S/;
606 13 50       150 m!$re_tx! or die "Invalid data in line $i: '$_' doesn't match pattern".
607             " (variant = ".$self->_variant.")";
608             my $row = {
609             account => $+{acc},
610             currency => $+{currency} // "IDR", # assume if not given
611             txcode => $+{txcode},
612             day => $+{date_d},
613             month => $+{date_m},
614             year => ($+{date_y} < 100 ? 2000:0) + $+{date_y},
615             desc1 => $+{desc1},
616             desc2 => $+{desc2},
617 13 100 100     293 };
618 13 100       88 $row->{desc3} = $+{desc3} if defined($+{desc3});
619 13 100       55 if ($+{amount_cr}) {
620 9         30 my $cr = $+{amount_cr};
621 9         33 my $dr = $+{amount_db};
622 9 100       25 if ($num_formatted) {
623 5         15 $cr = parse_number_en(text => $cr);
624 5         169 $dr = parse_number_en(text => $dr);
625             } else {
626 4         10 $cr += 0;
627 4         11 $dr += 0;
628             }
629 9 100       99 $row->{amount} = $cr ? $cr : -$dr;
630             } else {
631 4 100       28 $row->{amount} = $+{amount} * ($+{amount_dbmarker} ? -1 : 1);
632             }
633 13 100       67 if (defined $+{bal}) {
634 8 50       48 $row->{balance} = $+{bal} * ($+{bal_dbmarker} ? -1 : 1);
635             }
636 13         41 push @rows, $row;
637             }
638              
639 3         13 my @tx;
640             my $seq;
641 3         0 my $last_date;
642 3         7 for my $row (@rows) {
643 13         22 my $tx = {};
644              
645             $row->{account} eq $stmt->{account} or
646 13 50       36 return "Can't handle multiple accounts in transactions yet";
647             $row->{currency} eq $stmt->{currency} or
648 13 50       31 return "Can't handle multiple currencies in transactions yet";
649              
650             $tx->{date} = DateTime->new(
651 13         46 day=>$row->{day}, month=>$row->{month}, year=>$row->{year});
652              
653 13         3830 $tx->{txcode} = $row->{txcode};
654              
655             $tx->{description} = $row->{desc1} .
656             ($row->{desc2} ? "\n" . $row->{desc2} : "") .
657 13 100       76 ($row->{desc3} ? "\n" . $row->{desc3} : "");
    100          
658              
659 13         34 $tx->{amount} = $row->{amount}+0;
660              
661 13 100 100     48 if (!$last_date || DateTime->compare($last_date, $tx->{date})) {
662 5         159 $seq = 1;
663 5         11 $last_date = $tx->{date};
664             } else {
665 8         633 $seq++;
666             }
667 13         26 $tx->{seq} = $seq;
668              
669 13         32 push @tx, $tx;
670             }
671 3         9 $stmt->{transactions} = \@tx;
672 3         30 "";
673             }
674              
675             1;
676             # ABSTRACT: Check your Bank Mandiri accounts from Perl
677              
678             __END__
679              
680             =pod
681              
682             =encoding UTF-8
683              
684             =head1 NAME
685              
686             Finance::Bank::ID::Mandiri - Check your Bank Mandiri accounts from Perl
687              
688             =head1 VERSION
689              
690             This document describes version 0.382 of Finance::Bank::ID::Mandiri (from Perl distribution Finance-Bank-ID-Mandiri), released on 2019-05-13.
691              
692             =head1 SYNOPSIS
693              
694             If you just want to download banking statements, and you use Linux/Unix, you
695             might want to use the L<download-mandiri> script instead of having to deal with
696             this library directly.
697              
698             If you want to use the library in your Perl application:
699              
700             use Finance::Bank::ID::Mandiri;
701              
702             # FBI::Mandiri uses Log::ger. to show logs, use something like:
703             use Log::ger::Output 'Screen';
704              
705             my $ibank = Finance::Bank::ID::Mandiri->new(
706             username => '....', # optional if you're only using parse_statement()
707             password => '....', # idem
708             verify_https => 1, # default is 0
709             #https_ca_dir => '/etc/ssl/certs', # default is already /etc/ssl/certs
710             );
711              
712             eval {
713             $ibank->login(); # dies on error
714              
715             my $accts = $ibank->list_accounts();
716              
717             my $bal = $ibank->check_balance($acct); # $acct is optional
718              
719             my $stmt = $ibank->get_statement(
720             account => ..., # opt, default account used if not undef
721             days => 30, # opt
722             start_date => DateTime->new(year=>2009, month=>10, day=>6),
723             # opt, takes precedence over 'days'
724             end_date => DateTime->today, # opt, takes precedence over 'days'
725             );
726              
727             print "Transactions: ";
728             for my $tx (@{ $stmt->{transactions} }) {
729             print "$tx->{date} $tx->{amount} $tx->{description}\n";
730             }
731             };
732             warn if $@;
733              
734             # remember to call this, otherwise you will have trouble logging in again
735             # for some time
736             $ibank->logout;
737              
738             Utility routines:
739              
740             # parse HTML statement directly
741             my $res = $ibank->parse_statement($html);
742              
743             =head1 DESCRIPTION
744              
745             This module provide a rudimentary interface to the web-based online banking
746             interface of the Indonesian B<Bank Mandiri> at https://ib.bankmandiri.co.id
747             (henceforth IB). You will need either L<Crypt::SSLeay> or L<IO::Socket::SSL>
748             installed for HTTPS support to work (and strictly L<Crypt::SSLeay> to enable
749             certificate verification). L<WWW::Mechanize> is required but you can supply your
750             own mech-like object.
751              
752             Aside from the above site for invididual accounts, there are also 2 other sites
753             for corporate accounts: https://cms.bankmandiri.co.id/ecbanking/ (henceforth
754             CMS) and https://mcm.bankmandiri.co.id/ (henceforth MCM). CMS is the older
755             version and as of the end of Sept, 2010 has been discontinued.
756              
757             This module currently can only login to IB and not CMS/MCM, but this module can
758             parse statement page from all 3 sites. For CMS version, only text version [copy
759             paste result] is currently supported and not HTML. For MCM, only semicolon
760             format is currently supported.
761              
762             Warning: This module is neither offical nor is it tested to be 100% safe!
763             Because of the nature of web-robots, everything may break from one day to the
764             other when the underlying web interface changes.
765              
766             =head1 WARNING
767              
768             This warning is from Simon Cozens' C<Finance::Bank::LloydsTSB>, and seems just
769             as apt here.
770              
771             This is code for B<online banking>, and that means B<your money>, and that means
772             B<BE CAREFUL>. You are encouraged, nay, expected, to audit the source of this
773             module yourself to reassure yourself that I am not doing anything untoward with
774             your banking data. This software is useful to me, but is provided under B<NO
775             GUARANTEE>, explicit or implied.
776              
777             =head1 ERROR HANDLING AND DEBUGGING
778              
779             Most methods die() when encountering errors, so you can use eval() to trap them.
780              
781             Full response headers and bodies are dumped to a separate logger. See
782             documentation on C<new()> below and the sample script in examples/ subdirectory
783             in the distribution.
784              
785             =head1 ATTRIBUTES
786              
787             =head1 METHODS
788              
789             =head2 new(%args)
790              
791             Create a new instance. %args keys:
792              
793             =over
794              
795             =item * username
796              
797             Optional if you are just using utility methods like C<parse_statement()> and not
798             C<login()> etc.
799              
800             =item * password
801              
802             Optional if you are just using utility methods like C<parse_statement()> and not
803             C<login()> etc.
804              
805             =item * mech
806              
807             Optional. A L<WWW::Mechanize>-like object. By default this module instantiate a
808             new L<Finance::BankUtils::ID::Mechanize> (a WWW::Mechanize subclass) object to
809             retrieve web pages, but if you want to use a custom/different one, you are
810             allowed to do so here. Use cases include: you want to retry and increase timeout
811             due to slow/unreliable network connection (using
812             L<WWW::Mechanize::Plugin::Retry>), you want to slow things down using
813             L<WWW::Mechanize::Sleepy>, you want to use IE engine using
814             L<Win32::IE::Mechanize>, etc.
815              
816             =item * verify_https
817              
818             Optional. If you are using the default mech object (see previous option), you
819             can set this option to 1 to enable SSL certificate verification (recommended for
820             security). Default is 0.
821              
822             SSL verification will require a CA bundle directory, default is /etc/ssl/certs.
823             Adjust B<https_ca_dir> option if your CA bundle is not located in that
824             directory.
825              
826             =item * https_ca_dir
827              
828             Optional. Default is /etc/ssl/certs. Used to set HTTPS_CA_DIR environment
829             variable for enabling certificate checking in Crypt::SSLeay. Only used if
830             B<verify_https> is on.
831              
832             =item * logger
833              
834             Optional. You can supply a L<Log::Any>-like object here. If not specified,
835             this module will use a default logger.
836              
837             =item * logger_dump
838              
839             Optional. You can supply a L<Log::Any>-like object here. This is just
840             like C<logger> but this module will log contents of response bodies
841             here for debugging purposes. You can use with something like
842             L<Log::Dispatch::Dir> to save web pages more conveniently as separate
843             files.
844              
845             =back
846              
847             =head2 login()
848              
849             Login to the net banking site. You actually do not have to do this explicitly as
850             login() is called by other methods like C<check_balance()> or
851             C<get_statement()>.
852              
853             If login is successful, C<logged_in> will be set to true and subsequent calls to
854             C<login()> will become a no-op until C<logout()> is called.
855              
856             Dies on failure.
857              
858             =head2 logout()
859              
860             Logout from the net banking site. You need to call this at the end of your
861             program, otherwise the site will prevent you from re-logging in for some time
862             (e.g. 10 minutes).
863              
864             If logout is successful, C<logged_in> will be set to false and subsequent calls
865             to C<logout()> will become a no-op until C<login()> is called.
866              
867             Dies on failure.
868              
869             =head2 list_accounts()
870              
871             =head2 check_balance([$acct])
872              
873             =head2 get_statement(%args) => $stmt
874              
875             Get account statement. %args keys:
876              
877             =over
878              
879             =item * account
880              
881             Optional. Select the account to get statement of. If not specified, will use the
882             already selected account.
883              
884             =item * days
885              
886             Optional. Number of days. If days is 1, then start date and end date will be the
887             same.
888              
889             =item * start_date
890              
891             Optional. Default is C<end_date> - 1 month, which seems to be the current limit
892             set by the bank (for example, if C<end_date> is 2013-03-08, then C<start_date>
893             will be set to 2013-02-08). If not set and C<days> is set, will be set to
894             C<end_date> - C<days>.
895              
896             =item * end_date
897              
898             Optional. Default is today (or some 1+ days from today if today is a
899             Saturday/Sunday/holiday, depending on the default value set by the site's form).
900              
901             =back
902              
903             =head2 parse_statement($html, %opts) => $res
904              
905             Given the HTML of the account statement results page, parse it into structured
906             data:
907              
908             $stmt = {
909             start_date => $start_dt, # a DateTime object
910             end_date => $end_dt, # a DateTime object
911             account_holder => STRING,
912             account => STRING, # account number
913             currency => STRING, # 3-digit currency code
914             transactions => [
915             # first transaction
916             {
917             date => $dt, # a DateTime object, book date ("tanggal pembukuan")
918             seq => INT, # a number >= 1 which marks the sequence of transactions for the day
919             amount => REAL, # a real number, positive means credit (deposit), negative means debit (withdrawal)
920             description => STRING,
921             branch => STRING, # 4-digit branch/ATM code, only for MCM
922             },
923             # second transaction
924             ...
925             ]
926             }
927              
928             Returns:
929              
930             [$status, $err_details, $stmt]
931              
932             C<$status> is 200 if successful or some other 3-letter code if parsing failed.
933             C<$stmt> is the result (structure as above, or undef if parsing failed).
934              
935             Options:
936              
937             =over 4
938              
939             =item * return_datetime_obj => BOOL
940              
941             Default is true. If set to false, the method will return dates as strings with
942             this format: 'YYYY-MM-DD HH::mm::SS' (produced by DateTime->dmy . ' ' .
943             DateTime->hms). This is to make it easy to pass the data structure into YAML,
944             JSON, MySQL, etc. Nevertheless, internally DateTime objects are still used.
945              
946             =back
947              
948             Additional notes:
949              
950             The method can also (or used to) handle copy-pasted text from the GUI browser,
951             but this is no longer documented or guaranteed to keep working.
952              
953             =head1 FAQ
954              
955             =head2 (2014) I'm getting error message: "Can't connect to ib.bankmandiri.co.id:443 at ..."
956              
957             Try upgrading your IO::Socket::SSL. It stalls with IO::Socket::SSL version 1.76,
958             but works with newer versions (e.g. 1.989).
959              
960             =head1 HOMEPAGE
961              
962             Please visit the project's homepage at L<https://metacpan.org/release/Finance-Bank-ID-Mandiri>.
963              
964             =head1 SOURCE
965              
966             Source repository is at L<https://github.com/perlancar/perl-Finance-Bank-ID-Mandiri>.
967              
968             =head1 BUGS
969              
970             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Finance-Bank-ID-Mandiri>
971              
972             When submitting a bug or request, please include a test-file or a
973             patch to an existing test-file that illustrates the bug or desired
974             feature.
975              
976             =head1 AUTHOR
977              
978             perlancar <perlancar@cpan.org>
979              
980             =head1 COPYRIGHT AND LICENSE
981              
982             This software is copyright (c) 2019, 2017, 2016, 2015, 2014, 2013, 2012, 2011, 2010 by perlancar@cpan.org.
983              
984             This is free software; you can redistribute it and/or modify it under
985             the same terms as the Perl 5 programming language system itself.
986              
987             =cut