File Coverage

blib/lib/HTTP/MobileAgent/DoCoMo.pm
Criterion Covered Total %
statement 87 90 96.6
branch 37 42 88.1
condition 7 9 77.7
subroutine 17 17 100.0
pod 7 9 77.7
total 155 167 92.8


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__