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__ |