File Coverage

blib/lib/HTTP/MobileAttribute/Agent/DoCoMo.pm
Criterion Covered Total %
statement 51 52 98.0
branch 31 34 91.1
condition 4 6 66.6
subroutine 6 6 100.0
pod 0 1 0.0
total 92 99 92.9


line stmt bran cond sub pod time code
1             package HTTP::MobileAttribute::Agent::DoCoMo;
2 26     26   152 use strict;
  26         58  
  26         1079  
3 26     26   137 use warnings;
  26         59  
  26         622  
4 26     26   21865 use HTTP::MobileAttribute::Agent::Base;
  26         103  
  26         312  
5              
6             __PACKAGE__->mk_accessors(qw/version model status bandwidth serial_number card_id comment name cache_size/);
7              
8             sub parse {
9 241     241 0 402 my ( $self, ) = @_;
10              
11 241         1128 my ( $main, $foma_or_comment ) = split / /, $self->user_agent, 2;
12              
13 241 100 100     1337 if ( $foma_or_comment && $foma_or_comment =~ s/^\((.*)\)$/$1/ ) {
    100          
14             # DoCoMo/1.0/P209is (Google CHTML Proxy/1.0)
15 4         15 $self->{comment} = $1;
16 4         12 $self->_parse_main($main);
17             }
18             elsif ($foma_or_comment) {
19             # DoCoMo/2.0 N2001(c10;ser0123456789abcde;icc01234567890123456789)
20 61         176 @{$self}{qw(name version)} = split m!/!, $main;
  61         1558  
21 61         273 $self->_parse_foma($foma_or_comment);
22             }
23             else {
24             # DoCoMo/1.0/R692i/c10
25 176         665 $self->_parse_main($main);
26             }
27              
28             }
29              
30             sub _parse_main {
31 180     180   292 my ( $self, $main ) = @_;
32 180         825 my ( $name, $version, $model, $selfache, @rest ) = split m!/!, $main;
33 180         375 $self->{name} = $name;
34 180         359 $self->{version} = $version;
35 180         316 $self->{model} = $model;
36 180 100       655 $self->{model} = 'SH505i' if $self->{model} eq 'SH505i2';
37              
38 180 100       372 if ($selfache) {
39 119 50       1675 $selfache =~ s/^c// or return $self->no_match;
40 119         270 $self->{cache_size} = $selfache;
41             }
42              
43 180         656 for (@rest) {
44 42 100       147 /^ser(\w{11})$/ and do { $self->{serial_number} = $1; next };
  7         24  
  7         35  
45 35 100       131 /^(T[CDBJ])$/ and do { $self->{status} = $1; next };
  21         60  
  21         89  
46 14 100       72 /^s(\d+)$/ and do { $self->{bandwidth} = $1; next };
  5         18  
  5         8  
47 9 100       54 /^W(\d+)H(\d+)$/ and do { $self->{display_bytes} = "$1*$2"; next; };
  3         13  
  3         13  
48             }
49             }
50              
51             sub _parse_foma {
52 61     61   312 my ( $self, $foma ) = @_;
53              
54 61 50       365 $foma =~ s/^([^\(]+)// or return $self->no_match;
55 61         209 $self->{model} = $1;
56 61 100       227 $self->{model} = 'SH2101V' if $1 eq 'MST_v_SH2101V'; # Huh?
57              
58 61 100       298 $foma =~ /^\(/g or return;
59 59         306 while ($foma =~ /\G
60             (?:
61             c(\d+) | # cache size
62             ser(\w{15}) | # serial_number
63             icc(\w{20}) | # card_id
64             (T[CDBJ]) | # status
65             W(\d+)H(\d+) # display_bytes
66             )
67             [;\)]/gx)
68             {
69 147 100       726 $1 and $self->{cache_size} = $1, next;
70 88 100       282 $2 and $self->{serial_number} = $2, next;
71 71 100       298 $3 and $self->{card_id} = $3, next;
72 54 100       333 $4 and $self->{status} = $4, next;
73 26 50 33     311 ($5 && $6) and $self->{display_bytes} = "$5*$6", next;
74 0           $self->no_match;
75             }
76             }
77              
78             1;
79