line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WebService::NiigataUnyu; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
37850
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
40
|
|
4
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
37
|
|
5
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
99
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
1355
|
use version; our $VERSION = qv('0.0.6'); |
|
1
|
|
|
|
|
2632
|
|
|
1
|
|
|
|
|
6
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Other recommended modules (uncomment to use): |
10
|
|
|
|
|
|
|
# use IO::Prompt; |
11
|
|
|
|
|
|
|
# use Perl6::Export; |
12
|
|
|
|
|
|
|
# use Perl6::Slurp; |
13
|
|
|
|
|
|
|
# use Perl6::Say; |
14
|
1
|
|
|
1
|
|
1060
|
use Encode; |
|
1
|
|
|
|
|
15541
|
|
|
1
|
|
|
|
|
125
|
|
15
|
1
|
|
|
1
|
|
11
|
use Encode::Alias; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
194
|
|
16
|
|
|
|
|
|
|
define_alias( qr/shift.*jis$/i => '"cp932"' ); |
17
|
|
|
|
|
|
|
define_alias( qr/sjis$/i => '"cp932"' ); |
18
|
1
|
|
|
1
|
|
820
|
use WWW::Mechanize; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Web::Scraper; |
20
|
|
|
|
|
|
|
use YAML; |
21
|
|
|
|
|
|
|
use utf8; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# Module implementation here |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# コンストラクタ |
27
|
|
|
|
|
|
|
sub new { |
28
|
|
|
|
|
|
|
my $class = shift; |
29
|
|
|
|
|
|
|
my $self; |
30
|
|
|
|
|
|
|
my $mech = WWW::Mechanize->new(); |
31
|
|
|
|
|
|
|
$self->{start_url} = 'http://www2.nuis.co.jp/kzz80011.htm'; |
32
|
|
|
|
|
|
|
$mech->agent_alias( 'Windows IE 6' ); |
33
|
|
|
|
|
|
|
$self->{mech} = $mech; |
34
|
|
|
|
|
|
|
$self->{user_agent} = __PACKAGE__; |
35
|
|
|
|
|
|
|
return bless $self, $class; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# 新潟運輸に問い合わせ |
39
|
|
|
|
|
|
|
sub check { |
40
|
|
|
|
|
|
|
my $self = shift; |
41
|
|
|
|
|
|
|
my $numbers = shift; # 荷物問い合わせ番号のリストのリファレンス |
42
|
|
|
|
|
|
|
# フォームの問い合わせは5件ごとなので5件ごとのリストのリストにする |
43
|
|
|
|
|
|
|
my $list; # 5件ごとに分割されたリストのリストが入る |
44
|
|
|
|
|
|
|
my $j = -1; #添え字調整 |
45
|
|
|
|
|
|
|
foreach ( my $i = 0; $i < $#$numbers + 1; $i++ ) { |
46
|
|
|
|
|
|
|
$j++ unless $i % 5; |
47
|
|
|
|
|
|
|
push @{$list->[$j]}, $numbers->[$i]; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
# _requestを呼んで実際にWebアクセスする |
50
|
|
|
|
|
|
|
my $result = []; |
51
|
|
|
|
|
|
|
foreach my $item( @$list ) { |
52
|
|
|
|
|
|
|
sleep 5 if $#$result != -1; # 2回目のアクセスの前に5秒ウェイト |
53
|
|
|
|
|
|
|
my $res = _request($self, $item); |
54
|
|
|
|
|
|
|
push @$result, @$res; # 返答は最大10件なので、$resultにためていく |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
return $result; # 集まったリストを返す |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# 実際にリストからアクセスする |
60
|
|
|
|
|
|
|
sub _request { |
61
|
|
|
|
|
|
|
my $self = shift; |
62
|
|
|
|
|
|
|
my $list = shift; |
63
|
|
|
|
|
|
|
$self->{mech}->get( $self->{start_url} ); |
64
|
|
|
|
|
|
|
$self->{mech}->form_name('form1'); |
65
|
|
|
|
|
|
|
for ( my $i = 0; $i < $#$list + 1; $i++) { |
66
|
|
|
|
|
|
|
my $field = sprintf "toino%d", $i+1; |
67
|
|
|
|
|
|
|
$self->{mech}->set_fields( $field => $list->[$i]); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
$self->{mech}->click('submit'); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Web::Scraper による解析 |
72
|
|
|
|
|
|
|
my $s = scraper { |
73
|
|
|
|
|
|
|
process '//div[3]/div/div/div[2]/div/table', |
74
|
|
|
|
|
|
|
'results[]' => scraper { |
75
|
|
|
|
|
|
|
process q{//tr/th/font[text() =~ /お問合せ番号/]/../../td}, |
76
|
|
|
|
|
|
|
number => 'TEXT', |
77
|
|
|
|
|
|
|
process '//tr/th/font[text() =~ /日付/ and @size = 4]/../../td', |
78
|
|
|
|
|
|
|
date => [ 'TEXT', sub { s/\s//g; return $_; } ], |
79
|
|
|
|
|
|
|
process '//tr/th/font[text() =~ /時間/ and @size = 4]/../../td', |
80
|
|
|
|
|
|
|
time => [ 'TEXT', sub { s/\s//g; return $_; } ], |
81
|
|
|
|
|
|
|
process '//tr/th[@rowspan != 5]/font[text() =~ /状況/]/../../td', |
82
|
|
|
|
|
|
|
status => [ 'TEXT', sub { s/\s//g; return $_; } ], |
83
|
|
|
|
|
|
|
process '//tr/th/font[text() =~ /個数/]/../../td', |
84
|
|
|
|
|
|
|
items => [ 'TEXT', sub { s/\s//g; return $_; } ], |
85
|
|
|
|
|
|
|
process '//tr/th/font[text() =~ /取扱店名/ and @size = 4]/../../td', |
86
|
|
|
|
|
|
|
shop => [ 'TEXT', sub { s/\s//g; return $_; } ], |
87
|
|
|
|
|
|
|
process '//tr[3]/td', |
88
|
|
|
|
|
|
|
line3 => [ 'TEXT', sub { s/\s//g; return $_; } ], |
89
|
|
|
|
|
|
|
process '//tr/th/font[text() =~ /日付/ and @size != 4]/../../td', |
90
|
|
|
|
|
|
|
adate => [ 'TEXT', sub { s/\s//g; return $_; } ], |
91
|
|
|
|
|
|
|
}, |
92
|
|
|
|
|
|
|
}; |
93
|
|
|
|
|
|
|
my $res = $s->scrape( |
94
|
|
|
|
|
|
|
$self->{mech}->content() |
95
|
|
|
|
|
|
|
); |
96
|
|
|
|
|
|
|
# 得られた結果をリストで返す |
97
|
|
|
|
|
|
|
my $res2 = []; |
98
|
|
|
|
|
|
|
foreach my $item ( @{$res->{results}} ) { |
99
|
|
|
|
|
|
|
my $item2 = {}; |
100
|
|
|
|
|
|
|
foreach my $key ( keys %$item ) { |
101
|
|
|
|
|
|
|
$item2->{$key} = encode_utf8( $item->{$key} ); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
# 状況が取得できない場合(番号間違いなど)、3行目を入れる |
104
|
|
|
|
|
|
|
unless ( $item2->{status} ) { |
105
|
|
|
|
|
|
|
$item2->{status} = $item2->{line3}; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
delete $item2->{line3}; |
108
|
|
|
|
|
|
|
# 最新状況の日付が取得できない場合、荷物引受の日付けを入れる |
109
|
|
|
|
|
|
|
unless ( $item2->{date} ) { |
110
|
|
|
|
|
|
|
$item2->{date} = $item2->{adate}; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
delete $item2->{adate}; |
113
|
|
|
|
|
|
|
$item2->{user_agent} = $self->{user_agent}; |
114
|
|
|
|
|
|
|
push @$res2, $item2; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
$res->{results} = $res2; |
117
|
|
|
|
|
|
|
return $res->{results}; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub dump { |
121
|
|
|
|
|
|
|
my $self = shift; |
122
|
|
|
|
|
|
|
print Dump($self); |
123
|
|
|
|
|
|
|
return; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
1; # Magic true value required at end of module |
127
|
|
|
|
|
|
|
__END__ |