File Coverage

blib/lib/HTTP/MobileAgent/DoCoMo.pm
Criterion Covered Total %
statement 95 96 98.9
branch 41 44 93.1
condition 12 15 80.0
subroutine 20 20 100.0
pod 10 12 83.3
total 178 187 95.1


line stmt bran cond sub pod time code
1             package HTTP::MobileAgent::DoCoMo;
2              
3 14     14   83 use strict;
  14         31  
  14         506  
4 14     14   72 use vars qw($VERSION);
  14         29  
  14         658  
5             $VERSION = 0.24;
6              
7 14     14   75 use base qw(HTTP::MobileAgent);
  14         58  
  14         1681  
8              
9             __PACKAGE__->make_accessors(
10             qw(version model status bandwidth
11             serial_number is_foma card_id xhtml_compliant comment)
12             );
13              
14 14     14   10381 use HTTP::MobileAgent::DoCoMoDisplayMap qw($DisplayMap);
  14         101  
  14         3512  
15              
16             # various preferences
17 14     14   103 use vars qw($DefaultCacheSize $HTMLVerMap $GPSModelsRe);
  14         32  
  14         59023  
18             $DefaultCacheSize = 5;
19              
20             # http://www.nttdocomo.co.jp/service/developer/make/content/spec/useragent/index.html
21             $HTMLVerMap = [
22             qr/(?i-xsm:^(?:D501i|F501i|N501i|P501i)$)/,
23             '1.0',
24             qr/(?i-xsm:^(?:D209i|D502i|ER209i|F209i|F210i|F502i|F502it|F671i|KO209i|KO210i|N209i|N210i|N502i|N502it|N821i|NM502i|P209i|P209iS|P210i|P502i|P651ps|P821i|R209i|R691i|SH821i|SO502i|SO502iWM)$)/,
25             '2.0',
26             qr/(?i-xsm:^(?:D2101V|D210i|D211i|D503i|D503iS|F211i|F503i|F503iS|N2001|N2002|N211i|N211iS|N503i|N503iS|P2002|P2101V|P211i|P211iS|P503i|P503iS|R211i|R692i|SH2101V|SH251i|SH251iS|SO210i|SO211i|SO503i|SO503iS|T2101V)$)/,
27             '3.0',
28             qr/(?i-xsm:^(?:eggy|P751v)$)/,
29             '3.2',
30             qr/(?i-xsm:^(?:D251i|D251iS|D504i|F2051|F2102V|F212i|F251i|F504i|F504iS|F661i|F671iS|F672i|N2051|N2102V|N251i|N251iS|N2701|N504i|N504iS|NM705i|NM706i|NM850iG|P2102V|P251iS|P504i|P504iS|SO212i|SO213i|SO213iS|SO213iWR|SO504i)$)/,
31             '4.0',
32             qr/(?i-xsm:^(?:D252i|D253i|D253iWM|D505i|D505iS|D506i|D701i|D701iWM|D900i|D901i|D901iS|F505i|F505iGPS|F506i|F700i|F700iS|F880iES|F881iES|F900i|F900iC|F900iT|F901iC|F901iS|L600i|L601i|L602i|M702iG|M702iS|N252i|N253i|N505i|N505iS|N506i|N506iS|N506iSII|N600i|N700i|N701i|N701iECO|N900i|N900iG|N900iL|N900iS|N901iC|N901iS|P213i|P252i|P252iS|P253i|P253iS|P505i|P505iS|P506iC|P506iCII|P700i|P701iD|P851i|P900i|P900iV|P901i|P901iS|P901iTV|SA700iS|SA800i|SH252i|SH505i|SH505iS|SH506iC|SH700i|SH700iS|SH851i|SH900i|SH901iC|SH901iS|SO505i|SO505iS|SO506i|SO506iC|SO506iS)$)/,
33             '5.0',
34             qr/(?i-xsm:^(?:D702i|D702iBCL|D702iF|D800iDS|D851iWM|D902i|D902iS|F702iD|F882iES|F883i|F883iS|F902i|F902iS|L01A|L01C|L02B|L03A|L03B|L04A|L04B|L06A|L704i|L705i|L705iX|L706ie|L852i|N601i|N702iD|N702iS|N902i|N902iL|N902iS|N902iX|P702i|P702iD|P703imyu|P704imyu|P902i|P902iS|SA702i|SH702iD|SH702iS|SH902i|SH902iS|SH902iSL|SO702i|SO902i|SO902iWP+)$)/,
35             '6.0',
36             qr/(?i-xsm:^(?:D703i|D704i|D705i|D705imyu|D903i|D903iTV|D904i|F05A|F703i|F704i|F705i|F801i|F883iES|F883iESS|F903i|F903iBSC|F903iX|F904i|L10C|N703iD|N703imyu|N704imyu|N903i|N904i|P703i|P704i|P903i|P903iTV|P903iX|P904i|SH703i|SH704i|SH705i|SH705iII|SH706ie|SH903i|SH903iTV|SH904i|SO703i|SO704i|SO903i|SO903iTV)$)/,
37             '7.0',
38             qr/(?i-xsm:^(?:D905i|F07A|F10A|F884i|F884iES|F905i|F905iBiz|N03A|N05A|N06B|N705i|N705imyu|N706i|N706iII|N706ie|N905i|N905iBiz|N905imyu|N906iL|P705i|P705iCL|P705imyu|P706imyu|P905i|P905iTV|SH905i|SH905iTV|SO705i|SO706i|SO905i|SO905iCS)$)/,
39             '7.1',
40             qr/(?i-xsm:^(?:F01A|F02A|F03A|F04A|F06A|F08C|F09B|F706i|F906i|N01A|N02A|N04A|N906i|N906imyu|P01A|P02A|P03A|P04A|P05A|P06A|P10A|P706ie|P906i|SH01A|SH02A|SH03A|SH04A|SH706i|SH706iw|SH906i|SH906iTV|SO906i)$)/,
41             '7.2',
42             ];
43              
44             # http://www.nttdocomo.co.jp/binary/pdf/service/developer/make/content/spec/imode_spec.pdf
45             $GPSModelsRe = qr/SH03D|P03D|N03D|N02D|F04D|F02D|F10C|F09C|F07C|F03C|F02C|F01C|SH11C|SH10C|SH09C|SH06C|SH05C|SH04C|SH02C|SH01C|CA01C|N05C|N03C|N02C|N01C|P05C|P04C|P03C|L01B|N05B|N04B|N02B|N01B|P06B|P04B|P02B|P01B|F09B|F07B|F06B|F04B|F03B|F02B|F01B|SH08B|SH07B|SH04B|SH03B|SH02B|SH01B|SH08A|SH07A3|SH06A3|SH05A3|SH04A|SH03A|SH02A|SH01A|N09A3|N08A3|N06A3|N02A|N01A|P09A3|P08A3|P07A3|P02A|P01A|F10A|F09A3|F06A|F05A|F03A|F01A|N906iL|N906i|F906i|N906imyu|SH906i|SO906i|P906i|F884iES|F884i|F801i|F905iBiz|SO905iCS|N905iBiz|N905imyu|SO905i|F905i|P905i|N905i|D905i|SH905i(?!TV)|P904i|D904i|F904i|N904i|SH904i|F883iESS|F883iES|F903iBSC|SO903i|F903i|D903i|N903i|P903i(?!TV|X)|SH903i|SA800i|SA702i|SA700iS|F505iGPS|F661i/;
46              
47 178     178 1 483 sub is_docomo { 1 }
48              
49 39     39 1 353 sub carrier { 'I' }
50              
51 36     36 1 133 sub carrier_longname { 'DoCoMo' }
52              
53             sub parse {
54 185     185 0 261 my $self = shift;
55 185         587 my($main, $foma_or_comment) = split / /, $self->user_agent, 2;
56              
57 185 100 100     1042 if ($foma_or_comment && $foma_or_comment =~ s/^\((.*)\)$/$1/) {
    100          
58             # DoCoMo/1.0/P209is (Google CHTML Proxy/1.0)
59 4         14 $self->{comment} = $1;
60 4         14 $self->_parse_main($main);
61             } elsif ($foma_or_comment) {
62             # DoCoMo/2.0 N2001(c10;ser0123456789abcde;icc01234567890123456789)
63 31         81 $self->{is_foma} = 1;
64 31         102 @{$self}{qw(name version)} = split m!/!, $main;
  31         107  
65 31         166 $self->_parse_foma($foma_or_comment);
66             } else {
67             # DoCoMo/1.0/R692i/c10
68 150         350 $self->_parse_main($main);
69             }
70              
71 185 100 100     935 $self->{xhtml_compliant} =
72             ( $self->is_foma && !( $self->html_version && $self->html_version == 3.0 ) )
73             ? 1
74             : 0;
75             }
76              
77             sub _parse_main {
78 154     154   233 my($self, $main) = @_;
79 154         719 my($name, $version, $model, $cache, @rest) = split m!/!, $main;
80 154         381 $self->{name} = $name;
81 154         288 $self->{version} = $version;
82 154         292 $self->{model} = $model;
83 154 100       378 $self->{model} = 'SH505i' if $self->{model} eq 'SH505i2';
84              
85 154 100       301 if ($cache) {
86 105 50       732 $cache =~ s/^c// or return $self->no_match;
87 105         316 $self->{cache_size} = $cache;
88             }
89              
90 154         430 for (@rest) {
91 37 100       118 /^ser(\w{11})$/ and do { $self->{serial_number} = $1; next };
  5         17  
  5         21  
92 32 100       121 /^(T[CDBJ])$/ and do { $self->{status} = $1; next };
  19         52  
  19         4062  
93 13 100       49 /^s(\d+)$/ and do { $self->{bandwidth} = $1; next };
  5         18  
  5         9  
94 8 100       46 /^W(\d+)H(\d+)$/ and do { $self->{display_bytes} = "$1*$2"; next; };
  2         10  
  2         8  
95             }
96             }
97              
98             sub _parse_foma {
99 31     31   78 my($self, $foma) = @_;
100              
101 31 50       195 $foma =~ s/^([^\(]+)// or return $self->no_match;
102 31         100 $self->{model} = $1;
103 31 100       202 $self->{model} = 'SH2101V' if $1 eq 'MST_v_SH2101V'; # Huh?
104              
105 31 100       292 if ($foma =~ s/^\((.*?)\)//) {
106 28         114 my @options = split /;/, $1;
107 28         67 for (@options) {
108 57 100       291 /^c(\d+)$/ and $self->{cache_size} = $1, next;
109 29 100       88 /^ser(\w{15})$/ and $self->{serial_number} = $1, next;
110 27 100       79 /^icc(\w{20})$/ and $self->{card_id} = $1, next;
111 25 100       129 /^(T[CDBJ])$/ and $self->{status} = $1, next;
112 12 50       145 /^W(\d+)H(\d+)$/ and $self->{display_bytes} = "$1*$2", next;
113 0         0 $self->no_match;
114             }
115             }
116             }
117              
118             sub html_version {
119 92     92 1 139 my $self = shift;
120              
121 92         535 my @map = @$HTMLVerMap;
122 92         355 while (my($re, $version) = splice(@map, 0, 2)) {
123 480 100       1609 return $version if $self->model =~ /$re/;
124             }
125 7         67 return undef;
126             }
127              
128             sub cache_size {
129 41     41 1 63 my $self = shift;
130 41   66     315 return $self->{cache_size} || $DefaultCacheSize;
131             }
132              
133             sub series {
134 36     36 1 60 my $self = shift;
135 36         103 my $model = $self->model;
136              
137 36 100 66     108 if ($self->is_foma && $model =~ /(?:\d{4}|\w\d{2}\w\d?)/) {
138 13         78 return 'FOMA';
139             }
140              
141 23         115 $model =~ /(\d{3}i)/;
142 23         122 return $1;
143             }
144              
145             sub vendor {
146 36     36 1 61 my $self = shift;
147 36         110 my $model = $self->model;
148 36         141 $model =~ /^([A-Z]+)\d/;
149 36         186 return $1;
150             }
151              
152             sub _make_display {
153 5     5   9 my $self = shift;
154 5         21 my $display = $DisplayMap->{uc($self->model)};
155 5 100       21 if ($self->{display_bytes}) {
156 3         14 my($w, $h) = split /\*/, $self->{display_bytes};
157 3         8 $display->{width_bytes} = $w;
158 3         16 $display->{height_bytes} = $h;
159             }
160 5         73 return HTTP::MobileAgent::Display->new(%$display);
161             }
162              
163             sub is_gps {
164 4     4 0 15 my $self = shift;
165 4         16 return $self->gps_compliant;
166             }
167              
168             sub gps_compliant {
169 4     4 1 8 my $self = shift;
170 4         15 return $self->model =~ qr/$GPSModelsRe/;
171             }
172              
173             sub user_id {
174 2     2 1 17 my $self = shift;
175 2         9 return $self->get_header( 'x-dcmguid' );
176             }
177              
178             sub browser_version {
179 5     5 1 35 my $self = shift;
180 5 100 66     21 return $self->is_foma && $self->cache_size >= 500 ? '2.0' : '1.0';
181             }
182              
183             1;
184             __END__