File Coverage

blib/lib/HTTP/MobileAttribute/Agent/ThirdForce.pm
Criterion Covered Total %
statement 75 79 94.9
branch 34 44 77.2
condition 1 3 33.3
subroutine 8 8 100.0
pod 0 1 0.0
total 118 135 87.4


line stmt bran cond sub pod time code
1             package HTTP::MobileAttribute::Agent::ThirdForce;
2 26     26   164 use strict;
  26         60  
  26         1118  
3 26     26   151 use warnings;
  26         55  
  26         746  
4 26     26   136 use HTTP::MobileAttribute::Agent::Base;
  26         63  
  26         4563  
5              
6             __PACKAGE__->mk_accessors(qw(name version model type packet_compliant serial_number vendor vendor_version java_info));
7              
8             sub parse {
9 118     118 0 201 my ($self, ) = @_;
10              
11 118         421 my $user_agent = $self->user_agent;
12              
13 118 100       413 return $self->_parse_3gc() if($user_agent =~ /^Vodafone/);
14 111 100       348 return $self->_parse_softbank_3gc() if($user_agent =~ /^SoftBank/);
15 95 100       216 return $self->_parse_motorola_3gc() if($user_agent =~ /^MOT-/);
16 92 100       225 return $self->_parse_crawler() if($user_agent =~ /^Nokia/); # ad hoc
17              
18 91         232 my($main, @rest) = split / /, _subtract_ua($user_agent);
19              
20 91 100       241 if (@rest) {
21             # J-PHONE/4.0/J-SH51/SNJSHA3029293 SH/0001aa Profile/MIDP-1.0 Configuration/CLDC-1.0 Ext-Profile/JSCL-1.1.0
22 26         70 $self->{packet_compliant} = 1;
23 26         76 @{$self}{qw(name version model serial_number)} = split m!/!, $main;
  26         101  
24 26 100       119 if ($self->{serial_number}) {
25 24 50       128 $self->{serial_number} =~ s/^SN// or return $self->no_match;
26             }
27              
28 26         46 my $vendor = shift @rest;
29 26         59 @{$self}{qw(vendor vendor_version)} = split m!/!, $vendor;
  26         78  
30              
31 26         199 my %java_info = map split(m!/!), @rest;
32 26         110 $self->{java_info} = \%java_info;
33             } else {
34             # J-PHONE/2.0/J-DN02
35 65         191 @{$self}{qw(name version model)} = split m!/!, $main;
  65         263  
36 65 100       240 $self->{name} = 'J-PHONE' if $self->{name} eq 'J-Phone'; # for J-Phone/5.0/J-SH03 (YahooSeeker)
37 65 100       417 $self->{vendor} = ($self->{model} =~ /J-([A-Z]+)/)[0] if $self->{model};
38             }
39              
40 91 100       331 if ($self->version =~ /^2\./) {
    100          
    100          
    100          
41 29         111 $self->{type} = 'C2';
42             } elsif ($self->version =~ /^3\./) {
43 32 50       84 if ($self->request->get('x-jphone-java')) {
44 0         0 $self->{type} = 'C4';
45             } else {
46 32         105 $self->{type} = 'C3';
47             }
48             } elsif ($self->version =~ /^4\./) {
49 25         128 my($jscl_ver) = ($self->{java_info}->{'Ext-Profile'} =~ /JSCL-(\d.+)/);
50              
51 25 50       90 if ($jscl_ver =~ /^1\.1\./) {
    0          
    0          
52 25         110 $self->{type} = 'P4';
53             } elsif ($jscl_ver eq '1.2.1') {
54 0         0 $self->{type} = 'P5';
55             } elsif ($jscl_ver eq '1.2.2') {
56 0         0 $self->{type} = 'P6';
57             } else {
58 0         0 $self->{type} = 'P7';
59             }
60             } elsif ($self->version =~ /^5\./) {
61 4         49 $self->{type} = 'W';
62             }
63             }
64              
65             # for 3gc
66             sub _parse_3gc {
67 23     23   43 my ($self, ) = @_;
68              
69             # Vodafone/1.0/V802SE/SEJ001 Browser/SEMC-Browser/4.1 Profile/MIDP-2.0 Configuration/CLDC-1.1
70             # Vodafone/1.0/V702NK/NKJ001 Series60/2.6 Profile/MIDP-2.0 Configuration/CLDC-1.1
71             # SoftBank/1.0/910T/TJ001 Browser/NetFront/3.3 Profile/MIDP-2.0 Configuration/CLDC-1.1
72 23         85 my($main, @rest) = split / /, $self->user_agent;
73 23         70 $self->{packet_compliant} = 1;
74 23         52 $self->{type} = '3GC';
75              
76 23         86 @{$self}{qw(name version model _maker serial_number)} = split m!/!, $main;
  23         172  
77 23 100       108 if ($self->{serial_number}) {
78 9 50       62 $self->{serial_number} =~ s/^SN// or return $self->no_match;
79             }
80              
81 23         79 my($java_info) = $self->user_agent =~ /(Profile.*)$/;
82 23 100       82 if ($java_info) {
83 22         217 my %java_info = map split(m!/!), split / /,$java_info;
84 22         172 $self->{java_info} = \%java_info;
85             }
86             }
87              
88             # for softbank 3gc
89             *_parse_softbank_3gc = \&_parse_3gc;
90              
91             # for motorola 3gc
92             sub _parse_motorola_3gc{
93 3     3   7 my ($self, ) = @_;
94              
95 3         11 my($main, @rest) = split / /, $self->user_agent;
96              
97             #MOT-V980/80.2B.04I MIB/2.2.1 Profile/MIDP-2.0 Configuration/CLDC-1.1
98              
99 3         8 $self->{packet_compliant} = 1;
100 3         6 $self->{type} = '3GC';
101              
102 3         8 @{$self}{qw(name)} = split m!/!, $main;
  3         9  
103              
104 3         5 shift @rest;
105 3         19 my %java_info = map split(m!/!), @rest;
106 3         8 $self->{java_info} = \%java_info;
107              
108 3 50       14 $self->{model} = 'V702MO' if $self->{name} eq 'MOT-V980';
109 3 50       12 $self->{model} = 'V702sMO' if $self->{name} eq 'MOT-C980';
110 3   33     14 $self->{model} ||= $self->request->get('x-jphone-msname');
111             }
112              
113             # for crawler
114             sub _parse_crawler {
115 1     1   3 my ($self, ) = @_;
116              
117 1         4 my($main, @rest) = split / /, _subtract_ua($self->user_agent);
118              
119             # Nokia6820/2.0 (4.83) Profile/MIDP-1.0 Configuration/CLDC-1.0
120 1         4 @{$self}{qw(model)} = split m!/!, $main;
  1         4  
121 1         2 $self->{name} = 'Vodafone';
122 1         3 $self->{type} = '3GC';
123              
124 1         1 shift @rest;
125 1         7 my %java_info = map split(m!/!), @rest;
126 1         6 $self->{java_info} = \%java_info;
127             }
128              
129             sub _subtract_ua {
130 92     92   146 my $user_agent = shift;
131 92         178 $user_agent =~ s/\s*\(compatible\s*[^\)]+\)//i;
132 92         378 return $user_agent;
133             }
134              
135             1;