File Coverage

blib/lib/Finance/Bank/JP/MUFG.pm
Criterion Covered Total %
statement 243 265 91.7
branch 60 88 68.1
condition 11 18 61.1
subroutine 42 44 95.4
pod 5 10 50.0
total 361 425 84.9


line stmt bran cond sub pod time code
1             package Finance::Bank::JP::MUFG;
2              
3 9     9   405137 use strict;
  9         22  
  9         378  
4 9     9   45 use warnings;
  9         18  
  9         316  
5 9     9   224 use 5.008_001;
  9         31  
  9         556  
6             our $VERSION = '0.07';
7              
8 9     9   12796 use WWW::Mechanize;
  9         1654106  
  9         381  
9 9     9   9279 use HTML::TreeBuilder::XPath;
  9         615645  
  9         141  
10 9     9   6692 use HTML::Selector::XPath 'selector_to_xpath';
  9         18362  
  9         593  
11 9     9   9572 use List::MoreUtils qw(all any);
  9         12304  
  9         883  
12 9     9   60 use Cwd qw(getcwd);
  9         18  
  9         361  
13 9     9   47 use Carp ();
  9         18  
  9         136  
14 9     9   15042 use Time::Piece ();
  9         76090  
  9         291  
15 9     9   92 use Encode qw(encode_utf8 from_to);
  9         21  
  9         1052  
16 9     9   56 use Encode::Alias;
  9         20  
  9         507  
17              
18 9     9   6498 use Finance::Bank::JP::MUFG::Account;
  9         26  
  9         260  
19 9     9   5531 use Finance::Bank::JP::MUFG::Transaction;
  9         21  
  9         36667  
20              
21             define_alias(shift_jis => 'cp932');
22              
23             my %urls = (
24             login => 'https://entry11.bk.mufg.jp/ibg/dfw/APLIN/loginib/login?_TRANID=AA000_001',
25             );
26              
27             my %xpaths = (
28             account_balances => '/html/body/div/form[2]/div[3]/div[2]/div[3]/table/tbody/tr',
29             transaction => '/html/body/div/form[2]/div[3]/div[2]/div[5]/table/tbody/tr',
30             transaction_i => '/html/body/div/form[2]/div[3]/div[2]/div[6]/table/tbody/tr',
31             hidden => selector_to_xpath('div#container input[type=hidden]'),
32             attention => selector_to_xpath('div#contents div.serviceContents div.msgArea p.attention'),
33             attention_i => selector_to_xpath('div#contents div.serviceContents div.infoArea p.attention'),
34             unread_info => selector_to_xpath('div#contents form[name=informationShousaiActionForm]'),
35             );
36              
37             my %transaction_ids = (
38             login => 'AA011_001',
39             top => 'AW001_028',
40             logout => 'AD001_022',
41             account_balances => 'AD001_001',
42             search_condition => 'AD001_002',
43             transaction => 'CG016_001',
44             download => 'CG016_002',
45             exec_download => 'CG019_001',
46             );
47              
48 20     20 0 80 sub mech { shift->{mech} }
49 24     24 0 139 sub agent { shift->{agent} }
50 5     5   295 sub _logged_in { shift->{_logged_in} }
51              
52 0     0 0 0 sub xpath_keys { sort keys %xpaths }
53 1     1 0 20 sub transaction_id_keys { sort keys %transaction_ids }
54              
55 4     4   1099 sub _get_url { $urls{$_[0]} }
56 23     23   185688 sub _get_xpath { $xpaths{$_[0]} }
57 10     10   5265 sub _get_transaction_id { $transaction_ids{$_[0]} }
58              
59             sub new {
60 20     20 1 13110 my ($class, %args) = @_;
61              
62 20 100   38   224 unless (all { defined $_ } $args{contract_no}, $args{password}) {
  38         101  
63 3         485 Carp::croak "Contract number and password are required.";
64             }
65              
66 17         115 my $self = bless {%args}, $class;
67              
68 17 100       99 $self->{agent} = 'Mac Mozilla' unless _check_agent($self->{agent});
69 17         158 $self->{mech} = WWW::Mechanize->new(
70             autocheck => 1,
71             stack_depth => 1,
72             );
73 17         80797 $self->mech()->agent_alias($self->agent());
74 17         1129 $self->{_logged_in} = 0;
75              
76 17         82 return $self;
77             }
78              
79             sub _check_agent {
80 17     17   47 my $agent = shift;
81 17 100       91 return 0 unless defined $agent;
82 6 50   21   34 if (any { $_ eq $agent } WWW::Mechanize::known_agent_aliases()) {
  21         97  
83 6         21 return 1;
84             }
85 0         0 return 0;
86             }
87              
88             sub login {
89 3     3 1 21 my $self = shift;
90 3         13 my $mech = $self->mech();
91              
92 3         11 $mech->get(_get_url('login'));
93              
94 3         6265989 my $top_page = $self->_transition(
95             'login',
96             +{ KEIYAKU_NO => $self->{contract_no},
97             PASSWORD => $self->{password},
98             }
99             );
100              
101 3         262 my ($login_error, $exists_unread_info) = (
102             _exists_element($top_page, _get_xpath('attention')),
103             _exists_element($top_page, _get_xpath('unread_info')),
104             );
105              
106 3 100       14212 if ($login_error) {
    50          
107 1         167 Carp::croak "Login error.";
108             }
109             elsif ($exists_unread_info) {
110 0         0 Carp::croak "Exist unread information in the top page. Please check it.";
111             }
112              
113 2         8 $self->{_logged_in} = 1;
114              
115 2         14 return $self;
116             }
117              
118             sub _exists_element {
119 12     12   34 my ($content, $xpath) = @_;
120 12         43 my $tree = _build_tree($content);
121 12         112 return $tree->exists($xpath);
122             }
123              
124             sub accounts {
125 2     2 1 17 my $self = shift;
126 2         13 $self->_check_login;
127              
128 1         5 my $account_page = $self->_transition('account_balances', +{});
129 1         7 my $tree = _build_tree($account_page);
130 1         20 my @names = Finance::Bank::JP::MUFG::Account->columns;
131 1         6 my @rows = $tree->findnodes(_get_xpath('account_balances'));
132 1         8274 my @accounts = ();
133              
134 1         4 for my $row (@rows) {
135 2         32 my %columns = ();
136 2         58 my @values = ();
137 2         12 my @data = $row->find_by_tag_name('td');
138              
139 2         178 for my $datum (@data) {
140 12         36 my $text = $datum->as_trimmed_text();
141 12         436 push @values, $text;
142             }
143              
144 2         13 @columns{@names} = @values;
145              
146 2         9 for my $key (keys %columns) {
147 10 100       76 if ($key =~ /balance|withdrawal_limit/) {
148 4         35 $columns{$key} =~ s/^([\d,]+).*$/$1/;
149 4         13 $columns{$key} =~ s/,//g;
150 4         13 $columns{$key} =~ s/\*{1,3}/0/;
151             }
152 10         44 $columns{$key} = encode_utf8($columns{$key});
153             }
154              
155 2         23 push @accounts, Finance::Bank::JP::MUFG::Account->new(%columns);
156             }
157              
158 1         225 return @accounts;
159             }
160              
161             sub transactions {
162 2     2 1 392 my ($self, %args) = @_;
163 2         15 $self->_check_login;
164 1         44 $self->_transition('search_condition', +{});
165              
166 1         11 my $search_condition = _build_condition(%args);
167 1         5 my $page = $self->_transition('transaction', $search_condition);
168              
169 1 50       7 if (_exists_element($page, _get_xpath('attention'))) {
170 0         0 Carp::croak "Invalid search condition.";
171             }
172              
173 1         88622 my $exists_info = _exists_element($page, _get_xpath('attention_i'));
174              
175 1 50       90368 if ($exists_info) {
176 0         0 Carp::carp "Views the details since the beginning of the month of the previous.";
177             }
178              
179 1         6 my $tree = _build_tree($page);
180 1 50       9 my $xpath = $exists_info ? _get_xpath('transaction_i') : _get_xpath('transaction');
181 1         9 my @rows = $tree->findnodes($xpath);
182 1         7561 my @names = Finance::Bank::JP::MUFG::Transaction->columns;
183 1         3 my @transactions = ();
184              
185 1         4 for my $row (@rows) {
186 3         35 my %columns = ();
187 3         3 my @values = ();
188 3         15 my @data = $row->find_by_tag_name('td');
189              
190 3         250 for my $datum (@data) {
191 21         63 my $text = $datum->as_trimmed_text();
192 21         643 push @values, $text;
193             }
194              
195 3         18 @columns{@names} = @values;
196              
197 3         10 for my $key (keys %columns) {
198              
199             # no-break space code point.
200 21         64 my $nbsp = "\xA0";
201 21         71 $columns{$key} =~ s/$nbsp//g;
202 21 100       64 if ($key =~ /date/) {
203 3         14 my $t = Time::Piece->strptime($columns{$key}, '%Y年%m月%d日');
204 3         100 $columns{$key} = $t;
205 3         8 next;
206             }
207 18 100       80 if ($key =~ /outlay|income|balance/) {
208 9 100       26 $columns{$key} = 0 unless $columns{$key};
209 9         55 $columns{$key} =~ s/^([\d,]+).*$/$1/;
210 9         30 $columns{$key} =~ s/,//g;
211 9         18 next;
212             }
213 9         29 $columns{$key} = encode_utf8($columns{$key});
214             }
215              
216 3         30 push @transactions, Finance::Bank::JP::MUFG::Transaction->new(%columns);
217             }
218              
219 1         310 return @transactions;
220             }
221              
222             sub download_transactions {
223 4     4 1 372 my ($self, %args) = @_;
224 4         32 $self->_check_login;
225              
226 3   33     17 my $save_dir = delete $args{save_dir} || getcwd;
227 3   100     23 my $to_utf8 = delete $args{to_utf8} || 0;
228              
229 3 100       132 if (not -d $save_dir) {
    50          
230 1         33 Carp::croak "Save dir doesn't exist: $save_dir";
231             }
232             elsif (not $to_utf8 =~ /^[01]$/) {
233 0         0 Carp::carp "Set the 0 or 1 in the `to_utf8`.";
234             }
235              
236 2         12 $self->_transition('search_condition', +{});
237              
238 2         16 my $search_condition = _build_condition(%args);
239 2         11 my $page = $self->_transition('download', $search_condition);
240              
241 2 50       14 if (_exists_element($page, _get_xpath('attention'))) {
    50          
242 0         0 Carp::croak "Invalid search condition.";
243             }
244             elsif (_exists_element($page, _get_xpath('attention_i'))) {
245 0         0 Carp::carp "Views the details since the beginning of the month of the previous.";
246             }
247              
248 2         121725 $self->_transition('exec_download', +{});
249 2 50       13 if ($self->mech()->is_html) {
250 0         0 Carp::croak "Unexpected content type.";
251             }
252              
253 2         19 my $filename = $self->_get_filename_from_response;
254              
255             # Not flagged utf8 content.
256 2         14 my $content = $self->mech()->content;
257 2 50       18 $save_dir .= '/' unless $save_dir =~ m!/$!;
258 2         8 my $filepath = $save_dir . $filename;
259              
260 2 50       155 if (-e $filepath) {
261 0         0 Carp::croak "Already exists the file.";
262             }
263              
264 2 100       17 if ($to_utf8 =~ /^[1]$/) {
265 1         8 from_to($content, 'cp932', 'utf8');
266             }
267              
268 2         105 _save_content($content, $filepath);
269              
270             # Back to the before page.
271 2         10 $self->mech()->back;
272              
273 2         24 return $filepath;
274             }
275              
276             sub _get_filename_from_response {
277 0     0   0 my $self = shift;
278 0         0 my $response = $self->mech()->response();
279 0 0       0 return $response->filename or Carp::croak "Couldn't get file name.";
280             }
281              
282             sub _build_condition {
283 15     15   4490 my %args = @_;
284              
285 15 50       134 unless (%args) {
286 0         0 Carp::croak "Not specify search condition.";
287             }
288              
289 15         102 my $account_no = _default_value(delete $args{account_no}, 1, qr/^[1-9]$/);
290 15         85 my $transaction_kind = _default_value(delete $args{transaction_kind}, 1, qr/^[1-4]$/);
291 15         96 my $period = _default_value(delete $args{period}, 1, qr/^[1-4]$/);
292              
293             return +{
294 15 100 100     113 KOUZA_RADIO => _convert_value_to_order($account_no),
295             SHURUI_RADIO => _convert_value_to_order($transaction_kind),
296             KIKAN_RADIO => _convert_value_to_order($period),
297             } if ($period == 1 || $period == 2);
298              
299 7         19 my $condition = +{};
300              
301 7 100       30 if ($period == 3) {
    50          
302              
303 4 100       14 unless (exists $args{date}) {
304 1         23 Carp::carp "If the value of period is 3, `date` is required. Changes to today.";
305             }
306              
307 4         647 my $regexp_date = qr!^([\d]{4,4})/(0?[1-9]|1[012])/(0?[1-9]|[12][0-9]|3[01])$!;
308 4         23 my $date = _default_value(delete $args{date}, Time::Piece->localtime->ymd('/'),
309             qr!$regexp_date!);
310 4         55 my $t = Time::Piece->strptime($date, '%Y/%m/%d');
311              
312 4         127 $condition = +{
313             KOUZA_RADIO => _convert_value_to_order($account_no),
314             SHURUI_RADIO => _convert_value_to_order($transaction_kind),
315             KIKAN_RADIO => _convert_value_to_order($period),
316             HIZUKESHITEI_Y => _convert_year_to_order($t->year),
317             HIZUKESHITEI_M => _convert_value_to_order($t->mon),
318             HIZUKESHITEI_D => _convert_value_to_order($t->mday),
319             };
320             }
321             elsif ($period == 4) {
322              
323 3 50       13 unless (exists $args{from}) {
324 0         0 Carp::croak "If the value of period is 4, `from` is required.";
325             }
326              
327 3         32 my $t = Time::Piece->localtime;
328 3         552 my $from = delete $args{from};
329 3   66     22 my $to = delete $args{to} || $t->ymd('/');
330 3         31 my $regexp_date = qr!^([\d]{4,4})/(0?[1-9]|1[012])/(0?[1-9]|[12][0-9]|3[01])$!;
331              
332 3 50 33     37 if (!$from =~ /$regexp_date/ || !$to =~ /$regexp_date/) {
333 0         0 Carp::croak "Invalid date formart: $from - $to";
334             }
335              
336 3         23 my $t_from = Time::Piece->strptime($from, '%Y/%m/%d');
337 3         277 my $t_to = Time::Piece->strptime($to, '%Y/%m/%d');
338              
339 3 50       82 if ($t_from > $t_to) {
    50          
340 0         0 my ($t_from_ymd, $t_to_ymd) = ($t_from->ymd('/'), $t_to->ymd('/'));
341 0         0 Carp::croak "Needs to change the from_date before the to_date: $t_from_ymd > $t_to_ymd";
342             }
343             elsif ($t_to > $t) {
344 0         0 my ($t_to_ymd, $t_ymd) = ($t_to->ymd('/'), $t->ymd('/'));
345 0         0 Carp::croak "Can't specify a date in the future: $t_to_ymd > $t_ymd";
346             }
347              
348             $condition = +{
349 3         705 KOUZA_RADIO => _convert_value_to_order($account_no),
350             SHURUI_RADIO => _convert_value_to_order($transaction_kind),
351             KIKAN_RADIO => _convert_value_to_order($period),
352             KIKANSHITEI_Y_FROM => _convert_year_to_order($t_from->year),
353             KIKANSHITEI_M_FROM => _convert_value_to_order($t_from->mon),
354             KIKANSHITEI_D_FROM => _convert_value_to_order($t_from->mday),
355             KIKANSHITEI_Y_TO => _convert_year_to_order($t_to->year),
356             KIKANSHITEI_M_TO => _convert_value_to_order($t_to->mon),
357             KIKANSHITEI_D_TO => _convert_value_to_order($t_to->mday),
358             };
359             }
360              
361 7         31 return $condition;
362             }
363              
364             sub _default_value {
365 68     68   721 my ($value, $default, $regexp) = @_;
366 68 100       159 return $default unless defined $value;
367 65 100       365 if ($value =~ /$regexp/) {
368 58         147 return $value;
369             }
370 7         130 Carp::carp "Unexpected argment: $value";
371 7         3923 Carp::carp "Changes to default value: $value -> $default";
372 7         3705 return $default;
373             }
374              
375             sub _convert_year_to_order {
376 19     19   196 my $year = shift;
377 19         62 my $t = Time::Piece->localtime;
378 19         1382 my $current_year = $t->year;
379 19         148 my %year_map = (
380             $current_year - 2 => 0,
381             $current_year - 1 => 1,
382             $current_year => 2,
383             );
384 19         62 my $order = $year_map{_default_value($year, $t->year, qr/^[\d]{4,4}$/)};
385              
386 19 100       68 unless (defined $order) {
387 2         39 Carp::carp "Unexpected year's value. Changes to current year.";
388 2         1539 $order = 2;
389             }
390              
391 19         116 return $order;
392             }
393              
394             sub _convert_value_to_order {
395 96     96   770 my $value = shift;
396 96         552 return --$value;
397             }
398              
399             sub _save_content {
400 2     2   6 my ($content, $filepath) = @_;
401 2 50       301 open(my $fh, '>', $filepath) or Carp::croak "Unable to create $filepath: $!";
402 2         10 binmode $fh;
403 2 50       5 print {$fh} $content or Carp::croak "Unable to write to $filepath: $!";
  2         76  
404 2 50       154 close $fh or Carp::croak "Unable to close $filepath: $!";
405 2         13 return;
406             }
407              
408             sub _transition {
409 1     1   3 my ($self, $transaction_key, $fields) = @_;
410              
411 1   50     7 $fields ||= +{};
412 1 50       5 Carp::croak "Trnsaction Key is required." unless defined $transaction_key;
413 1 50       4 Carp::croak "Trnsaction Key is invalid." unless _check_transaction_key($transaction_key);
414 1 50       9 Carp::croak "Not a HASH reference." unless (ref $fields eq 'HASH');
415              
416 1         5 my $mech = $self->mech();
417 1         6 my $tree = _build_tree($mech->content);
418 1         6 my @nodes = $tree->findnodes(_get_xpath('hidden'));
419              
420 1         56792 $fields = _create_form_fields($transaction_key, $fields, \@nodes);
421 1         8 $mech->submit_form(
422             form_name => 'MainForm',
423             fields => $fields,
424             );
425              
426 1 50       1468840 if ($mech->content =~ /IW052/) {
427 0         0 Carp::croak "Login session has expired.";
428             }
429              
430 1         44 return $mech->content;
431             }
432              
433             sub _build_tree {
434 15     15   57 my $html = shift;
435 15         165 my $tree = HTML::TreeBuilder::XPath->new;
436 15         4783 $tree->parse($html);
437 15         578820 $tree->eof;
438 15         19979 return $tree;
439             }
440              
441             sub _check_transaction_key {
442 1     1   2 my $transaction_key = shift;
443 1 50       4 return 0 unless defined $transaction_key;
444 1 50   4   10 if (any { $_ eq $transaction_key } transaction_id_keys()) {
  4         7  
445 1         5 return 1;
446             }
447 0         0 return 0;
448             }
449              
450             sub _create_form_fields {
451 2     2   65287 my ($transaction_key, $fields, $hidden_tags) = @_;
452 2   50     16 $fields ||= +{};
453 2         14 map { $fields->{$_->attr('name')} = $_->attr('value') } @{$hidden_tags};
  18         271  
  2         4  
454 2         37 $fields->{_TRANID} = _get_transaction_id($transaction_key);
455 2         6 return $fields;
456             }
457              
458             sub _check_login {
459 8     8   15 my $self = shift;
460 8 100       27 Carp::croak "Not logged in." unless $self->_logged_in();
461 5         31 return 1;
462             }
463              
464             sub logout {
465 1     1 0 12 my $self = shift;
466 1         6 $self->_transition('logout', +{});
467 1         5 $self->{_logged_in} = 0;
468 1         4 return;
469             }
470              
471             1;
472             __END__