line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTTP::MobileAgent::DoCoMo; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
42
|
use strict; |
|
10
|
|
|
|
|
14
|
|
|
10
|
|
|
|
|
322
|
|
4
|
10
|
|
|
10
|
|
42
|
use vars qw($VERSION); |
|
10
|
|
|
|
|
16
|
|
|
10
|
|
|
|
|
528
|
|
5
|
|
|
|
|
|
|
$VERSION = 0.19; |
6
|
|
|
|
|
|
|
|
7
|
10
|
|
|
10
|
|
131
|
use base qw(HTTP::MobileAgent); |
|
10
|
|
|
|
|
12
|
|
|
10
|
|
|
|
|
1163
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
__PACKAGE__->make_accessors( |
10
|
|
|
|
|
|
|
qw(version model status bandwidth |
11
|
|
|
|
|
|
|
serial_number is_foma card_id xhtml_compliant comment) |
12
|
|
|
|
|
|
|
); |
13
|
|
|
|
|
|
|
|
14
|
10
|
|
|
10
|
|
4237
|
use HTTP::MobileAgent::DoCoMoDisplayMap qw($DisplayMap); |
|
10
|
|
|
|
|
28
|
|
|
10
|
|
|
|
|
2146
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# various preferences |
17
|
10
|
|
|
10
|
|
63
|
use vars qw($DefaultCacheSize $HTMLVerMap $GPSModels); |
|
10
|
|
|
|
|
13
|
|
|
10
|
|
|
|
|
15015
|
|
18
|
|
|
|
|
|
|
$DefaultCacheSize = 5; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# http://www.nttdocomo.co.jp/p_s/imode/spec/useragent.html |
21
|
|
|
|
|
|
|
$HTMLVerMap = [ |
22
|
|
|
|
|
|
|
# regex => version |
23
|
|
|
|
|
|
|
qr/[DFNP]501i/ => '1.0', |
24
|
|
|
|
|
|
|
qr/502i|821i|209i|691i|(F|N|P|KO)210i|^F671i$/ => '2.0', |
25
|
|
|
|
|
|
|
qr/(D210i|SO210i)|503i|211i|SH251i|692i|200[12]|2101V/ => '3.0', |
26
|
|
|
|
|
|
|
qr/504i|251i|^F671iS$|^F661i$|^F672i$|212i|SO213i|2051|2102V|2701|850i/ => '4.0', |
27
|
|
|
|
|
|
|
qr/eggy|P751v/ => '3.2', |
28
|
|
|
|
|
|
|
qr/505i|506i|252i|253i|P213i|600i|700i|701i|800i|880i|SH851i|P851i|881i|900i|901i/ => '5.0', |
29
|
|
|
|
|
|
|
qr/702i|D851iWM|902i/ => '6.0', |
30
|
|
|
|
|
|
|
]; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$GPSModels = { map { $_ => 1 } qw(F661i F505iGPS) }; |
33
|
|
|
|
|
|
|
|
34
|
170
|
|
|
170
|
1
|
25455
|
sub is_docomo { 1 } |
35
|
|
|
|
|
|
|
|
36
|
32
|
|
|
32
|
1
|
5324
|
sub carrier { 'I' } |
37
|
|
|
|
|
|
|
|
38
|
32
|
|
|
32
|
1
|
92
|
sub carrier_longname { 'DoCoMo' } |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub parse { |
41
|
174
|
|
|
174
|
0
|
180
|
my $self = shift; |
42
|
174
|
|
|
|
|
368
|
my($main, $foma_or_comment) = split / /, $self->user_agent, 2; |
43
|
|
|
|
|
|
|
|
44
|
174
|
100
|
100
|
|
|
735
|
if ($foma_or_comment && $foma_or_comment =~ s/^\((.*)\)$/$1/) { |
|
|
100
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# DoCoMo/1.0/P209is (Google CHTML Proxy/1.0) |
46
|
4
|
|
|
|
|
12
|
$self->{comment} = $1; |
47
|
4
|
|
|
|
|
12
|
$self->_parse_main($main); |
48
|
|
|
|
|
|
|
} elsif ($foma_or_comment) { |
49
|
|
|
|
|
|
|
# DoCoMo/2.0 N2001(c10;ser0123456789abcde;icc01234567890123456789) |
50
|
17
|
|
|
|
|
35
|
$self->{is_foma} = 1; |
51
|
17
|
|
|
|
|
48
|
@{$self}{qw(name version)} = split m!/!, $main; |
|
17
|
|
|
|
|
52
|
|
52
|
17
|
|
|
|
|
53
|
$self->_parse_foma($foma_or_comment); |
53
|
|
|
|
|
|
|
} else { |
54
|
|
|
|
|
|
|
# DoCoMo/1.0/R692i/c10 |
55
|
153
|
|
|
|
|
501
|
$self->_parse_main($main); |
56
|
|
|
|
|
|
|
} |
57
|
174
|
100
|
|
|
|
455
|
$self->{xhtml_compliant} = $self->version eq '2.0' ? 1 : 0; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _parse_main { |
61
|
157
|
|
|
157
|
|
196
|
my($self, $main) = @_; |
62
|
157
|
|
|
|
|
527
|
my($name, $version, $model, $cache, @rest) = split m!/!, $main; |
63
|
157
|
|
|
|
|
256
|
$self->{name} = $name; |
64
|
157
|
|
|
|
|
212
|
$self->{version} = $version; |
65
|
157
|
|
|
|
|
217
|
$self->{model} = $model; |
66
|
157
|
100
|
|
|
|
320
|
$self->{model} = 'SH505i' if $self->{model} eq 'SH505i2'; |
67
|
|
|
|
|
|
|
|
68
|
157
|
100
|
|
|
|
255
|
if ($cache) { |
69
|
105
|
50
|
|
|
|
515
|
$cache =~ s/^c// or return $self->no_match; |
70
|
105
|
|
|
|
|
194
|
$self->{cache_size} = $cache; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
157
|
|
|
|
|
364
|
for (@rest) { |
74
|
38
|
100
|
|
|
|
115
|
/^ser(\w{11})$/ and do { $self->{serial_number} = $1; next }; |
|
5
|
|
|
|
|
16
|
|
|
5
|
|
|
|
|
12
|
|
75
|
33
|
100
|
|
|
|
122
|
/^(T[CDBJ])$/ and do { $self->{status} = $1; next }; |
|
19
|
|
|
|
|
51
|
|
|
19
|
|
|
|
|
43
|
|
76
|
14
|
100
|
|
|
|
49
|
/^s(\d+)$/ and do { $self->{bandwidth} = $1; next }; |
|
5
|
|
|
|
|
16
|
|
|
5
|
|
|
|
|
8
|
|
77
|
9
|
100
|
|
|
|
42
|
/^W(\d+)H(\d+)$/ and do { $self->{display_bytes} = "$1*$2"; next; }; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
7
|
|
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _parse_foma { |
82
|
17
|
|
|
17
|
|
29
|
my($self, $foma) = @_; |
83
|
|
|
|
|
|
|
|
84
|
17
|
50
|
|
|
|
95
|
$foma =~ s/^([^\(]+)// or return $self->no_match; |
85
|
17
|
|
|
|
|
57
|
$self->{model} = $1; |
86
|
17
|
100
|
|
|
|
57
|
$self->{model} = 'SH2101V' if $1 eq 'MST_v_SH2101V'; # Huh? |
87
|
|
|
|
|
|
|
|
88
|
17
|
100
|
|
|
|
106
|
if ($foma =~ s/^\((.*?)\)$//) { |
89
|
16
|
|
|
|
|
53
|
my @options = split /;/, $1; |
90
|
16
|
|
|
|
|
39
|
for (@options) { |
91
|
21
|
100
|
|
|
|
125
|
/^c(\d+)$/ and $self->{cache_size} = $1, next; |
92
|
5
|
100
|
|
|
|
22
|
/^ser(\w{15})$/ and $self->{serial_number} = $1, next; |
93
|
3
|
100
|
|
|
|
17
|
/^icc(\w{20})$/ and $self->{card_id} = $1, next; |
94
|
1
|
50
|
|
|
|
7
|
/^(T[CDBJ])$/ and $self->{status} = $1, next; |
95
|
0
|
0
|
|
|
|
0
|
/^W(\d+)H(\d+)$/ and $self->{display_bytes} = "$1*$2", next; |
96
|
0
|
|
|
|
|
0
|
$self->no_match; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub html_version { |
102
|
32
|
|
|
32
|
1
|
57
|
my $self = shift; |
103
|
|
|
|
|
|
|
|
104
|
32
|
|
|
|
|
190
|
my @map = @$HTMLVerMap; |
105
|
32
|
|
|
|
|
168
|
while (my($re, $version) = splice(@map, 0, 2)) { |
106
|
111
|
100
|
|
|
|
261
|
return $version if $self->model =~ /$re/; |
107
|
|
|
|
|
|
|
} |
108
|
0
|
|
|
|
|
0
|
return undef; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub cache_size { |
112
|
32
|
|
|
32
|
1
|
65
|
my $self = shift; |
113
|
32
|
|
66
|
|
|
260
|
return $self->{cache_size} || $DefaultCacheSize; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub series { |
117
|
32
|
|
|
32
|
1
|
52
|
my $self = shift; |
118
|
32
|
|
|
|
|
93
|
my $model = $self->model; |
119
|
|
|
|
|
|
|
|
120
|
32
|
100
|
66
|
|
|
75
|
if ($self->is_foma && $model =~ /\d{4}/) { |
121
|
9
|
|
|
|
|
42
|
return 'FOMA'; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
23
|
|
|
|
|
109
|
$model =~ /(\d{3}i)/; |
125
|
23
|
|
|
|
|
105
|
return $1; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub vendor { |
129
|
32
|
|
|
32
|
1
|
55
|
my $self = shift; |
130
|
32
|
|
|
|
|
376
|
my $model = $self->model; |
131
|
32
|
|
|
|
|
179
|
$model =~ /^([A-Z]+)\d/; |
132
|
32
|
|
|
|
|
144
|
return $1; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _make_display { |
136
|
4
|
|
|
4
|
|
6
|
my $self = shift; |
137
|
4
|
|
|
|
|
13
|
my $display = $DisplayMap->{uc($self->model)}; |
138
|
4
|
100
|
|
|
|
10
|
if ($self->{display_bytes}) { |
139
|
1
|
|
|
|
|
4
|
my($w, $h) = split /\*/, $self->{display_bytes}; |
140
|
1
|
|
|
|
|
2
|
$display->{width_bytes} = $w; |
141
|
1
|
|
|
|
|
3
|
$display->{height_bytes} = $h; |
142
|
|
|
|
|
|
|
} |
143
|
4
|
|
|
|
|
24
|
return HTTP::MobileAgent::Display->new(%$display); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub is_gps { |
147
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
148
|
1
|
|
|
|
|
5
|
return exists $GPSModels->{$self->model}; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
1; |
152
|
|
|
|
|
|
|
__END__ |