File Coverage

blib/lib/HTTP/MobileAgent/Vodafone.pm
Criterion Covered Total %
statement 88 92 95.6
branch 33 44 75.0
condition 1 3 33.3
subroutine 18 18 100.0
pod 7 10 70.0
total 147 167 88.0


line stmt bran cond sub pod time code
1             package HTTP::MobileAgent::Vodafone;
2              
3 10     10   52 use strict;
  10         13  
  10         314  
4 10     10   39 use vars qw($VERSION);
  10         13  
  10         461  
5             $VERSION = 0.21;
6              
7 10     10   43 use base qw(HTTP::MobileAgent);
  10         10  
  10         15212  
8              
9             __PACKAGE__->make_accessors(
10             qw(name version model type packet_compliant
11             serial_number vendor vendor_version java_info)
12             );
13              
14 73     73 0 248 sub is_j_phone { shift->is_vodafone }
15              
16 90     90 1 147 sub is_vodafone { 1 }
17              
18 2     2 0 13 sub is_softbank { shift->is_vodafone }
19              
20 6     6 1 954 sub carrier { 'V' }
21              
22 6     6 1 15 sub carrier_longname { 'Vodafone' }
23              
24 10     10 1 427 sub is_type_c { shift->{type} =~ /^C/ }
25 10     10 1 70 sub is_type_p { shift->{type} =~ /^P/ }
26 10     10 1 71 sub is_type_w { shift->{type} =~ /^W/ }
27 9     9 1 34 sub is_type_3gc { shift->{type} eq '3GC' }
28              
29             sub parse {
30 77     77 0 80 my $self = shift;
31              
32 77 100       156 return $self->_parse_3gc if($self->user_agent =~ /^Vodafone/);
33 74 100       162 return $self->_parse_softbank_3gc if($self->user_agent =~ /^SoftBank/);
34 71 100       142 return $self->_parse_motorola_3gc if($self->user_agent =~ /^MOT-/);
35 69 100       110 return $self->_parse_crawler if($self->user_agent =~ /^Nokia/); # ad hoc
36              
37 68         120 my($main, @rest) = split / /, _subtract_ua($self->user_agent);
38              
39 68 100       111 if (@rest) {
40             # J-PHONE/4.0/J-SH51/SNJSHA3029293 SH/0001aa Profile/MIDP-1.0 Configuration/CLDC-1.0 Ext-Profile/JSCL-1.1.0
41 21         29 $self->{packet_compliant} = 1;
42 21         44 @{$self}{qw(name version model serial_number)} = split m!/!, $main;
  21         44  
43 21 100       39 if ($self->{serial_number}) {
44 20 50       82 $self->{serial_number} =~ s/^SN// or return $self->no_match;
45             }
46              
47 21         25 my $vendor = shift @rest;
48 21         34 @{$self}{qw(vendor vendor_version)} = split m!/!, $vendor;
  21         45  
49              
50 21         116 my %java_info = map split(m!/!), @rest;
51 21         38 $self->{java_info} = \%java_info;
52             } else {
53             # J-PHONE/2.0/J-DN02
54 47         93 @{$self}{qw(name version model)} = split m!/!, $main;
  47         96  
55 47 100       118 $self->{name} = 'J-PHONE' if $self->{name} eq 'J-Phone'; # for J-Phone/5.0/J-SH03 (YahooSeeker)
56 47 100       223 $self->{vendor} = ($self->{model} =~ /J-([A-Z]+)/)[0] if $self->{model};
57             }
58              
59 68 100       400 if ($self->version =~ /^2\./) {
    100          
    100          
    100          
60 12         32 $self->{type} = 'C2';
61             } elsif ($self->version =~ /^3\./) {
62 32 50       51 if ($self->get_header('x-jphone-java')) {
63 0         0 $self->{type} = 'C4';
64             } else {
65 32         62 $self->{type} = 'C3';
66             }
67             } elsif ($self->version =~ /^4\./) {
68 21         68 my($jscl_ver) = ($self->{java_info}->{'Ext-Profile'} =~ /JSCL-(\d.+)/);
69              
70 21 50       40 if ($jscl_ver =~ /^1\.1\./) {
    0          
    0          
71 21         51 $self->{type} = 'P4';
72             } elsif ($jscl_ver eq '1.2.1') {
73 0         0 $self->{type} = 'P5';
74             } elsif ($jscl_ver eq '1.2.2') {
75 0         0 $self->{type} = 'P6';
76             } else {
77 0         0 $self->{type} = 'P7';
78             }
79             } elsif ($self->version =~ /^5\./) {
80 2         4 $self->{type} = 'W';
81             }
82             }
83              
84             # for 3gc
85             sub _parse_3gc {
86 6     6   10 my $self = shift;
87              
88             # Vodafone/1.0/V802SE/SEJ001 Browser/SEMC-Browser/4.1 Profile/MIDP-2.0 Configuration/CLDC-1.1
89             # Vodafone/1.0/V702NK/NKJ001 Series60/2.6 Profile/MIDP-2.0 Configuration/CLDC-1.1
90             # SoftBank/1.0/910T/TJ001 Browser/NetFront/3.3 Profile/MIDP-2.0 Configuration/CLDC-1.1
91 6         21 my($main, @rest) = split / /, $self->user_agent;
92 6         18 $self->{packet_compliant} = 1;
93 6         15 $self->{type} = '3GC';
94              
95 6         22 @{$self}{qw(name version model _maker serial_number)} = split m!/!, $main;
  6         36  
96 6 100       18 if ($self->{serial_number}) {
97 4 50       28 $self->{serial_number} =~ s/^SN// or return $self->no_match;
98             }
99              
100 6         22 my($java_info) = $self->user_agent =~ /(Profile.*)$/;
101 6         57 my %java_info = map split(m!/!), split / /,$java_info;
102 6         29 $self->{java_info} = \%java_info;
103             }
104              
105             # for softbank 3gc
106             *_parse_softbank_3gc = \&_parse_3gc;
107              
108             # for motorola 3gc
109             sub _parse_motorola_3gc{
110 2     2   4 my $self = shift;
111 2         8 my($main, @rest) = split / /, $self->user_agent;
112              
113             #MOT-V980/80.2B.04I MIB/2.2.1 Profile/MIDP-2.0 Configuration/CLDC-1.1
114              
115 2         7 $self->{packet_compliant} = 1;
116 2         6 $self->{type} = '3GC';
117              
118 2         7 @{$self}{qw(name)} = split m!/!, $main;
  2         7  
119              
120 2         4 shift @rest;
121 2         18 my %java_info = map split(m!/!), @rest;
122 2         8 $self->{java_info} = \%java_info;
123              
124 2 50       10 $self->{model} = 'V702MO' if $self->{name} eq 'MOT-V980';
125 2 50       7 $self->{model} = 'V702sMO' if $self->{name} eq 'MOT-C980';
126 2   33     11 $self->{model} ||= $self->get_header('x-jphone-msname');
127             }
128              
129             # for crawler
130             sub _parse_crawler {
131 1     1   3 my $self = shift;
132 1         5 my($main, @rest) = split / /, _subtract_ua($self->user_agent);
133              
134             # Nokia6820/2.0 (4.83) Profile/MIDP-1.0 Configuration/CLDC-1.0
135 1         5 @{$self}{qw(model)} = split m!/!, $main;
  1         4  
136 1         4 $self->{name} = 'Vodafone';
137 1         2 $self->{type} = '3GC';
138              
139 1         3 shift @rest;
140 1         11 my %java_info = map split(m!/!), @rest;
141 1         6 $self->{java_info} = \%java_info;
142             }
143              
144             sub _make_display {
145 1     1   2 my $self = shift;
146 1         6 my($width, $height) = split /\*/, $self->get_header('x-jphone-display');
147              
148 1         26 my($color, $depth);
149 1 50       4 if (my $c_str = $self->get_header('x-jphone-color')) {
150 1         6 ($color, $depth) = $c_str =~ /^([CG])(\d+)$/;
151             }
152              
153 1         9 return HTTP::MobileAgent::Display->new(
154             width => $width,
155             height => $height,
156             color => $color eq 'C',
157             depth => $depth,
158             );
159             }
160              
161             sub _subtract_ua {
162 69     69   68 my $user_agent = shift;
163 69         104 $user_agent =~ s/\s*\(compatible\s*[^\)]+\)//i;
164 69         240 return $user_agent;
165             }
166              
167             1;
168             __END__