File Coverage

blib/lib/HTTP/MobileAgent/Plugin/Locator.pm
Criterion Covered Total %
statement 61 64 95.3
branch 33 36 91.6
condition 12 12 100.0
subroutine 15 16 93.7
pod 1 2 50.0
total 122 130 93.8


line stmt bran cond sub pod time code
1             package HTTP::MobileAgent::Plugin::Locator;
2              
3 11     11   409093 use warnings;
  11         62  
  11         356  
4 11     11   56 use strict;
  11         18  
  11         297  
5 11     11   4925 use HTTP::MobileAgent;
  11         133514  
  11         261  
6 11     11   76 use Carp;
  11         20  
  11         927  
7 11     11   8329 use UNIVERSAL::require;
  11         22499  
  11         105  
8 11     11   8173 use UNIVERSAL::can;
  11         9379  
  11         58  
9              
10 11     11   315 use base qw( Exporter );
  11         24  
  11         1994  
11             our @EXPORT_OK = qw( $LOCATOR_AUTO_FROM_COMPLIANT $LOCATOR_AUTO $LOCATOR_GPS $LOCATOR_BASIC );
12             our %EXPORT_TAGS = (locator => [@EXPORT_OK]);
13              
14             our $VERSION = '0.04';
15              
16             our $LOCATOR_AUTO_FROM_COMPLIANT = 1;
17             our $LOCATOR_AUTO = 2;
18             our $LOCATOR_GPS = 3;
19             our $LOCATOR_BASIC = 4;
20              
21              
22             sub import {
23 11     11   80 my ( $class ) = @_;
24 11     11   85 no strict 'refs';
  11         23  
  11         8042  
25 11     42   150 *HTTP::MobileAgent::locator = sub { $class->new( @_ ) };
  42         323  
26             *HTTP::MobileAgent::get_location = sub {
27 41     41   131835 my ( $self, $stuff, $option_ref ) = @_;
28 41         105 my $params = _prepare_params( $stuff );
29 41         145 $self->locator( $params, $option_ref )->get_location( $params );
30 11         97 };
31 11         18999 $class->export_to_level( 1, @_ );
32             }
33              
34             sub new {
35 42     42 0 68 my ( $class, $agent, $params, $option_ref ) = @_;
36 42         87 my $carrier_locator = _get_carrier_locator( $agent, $params, $option_ref );
37 41         78 my $locator_class = "HTTP::MobileAgent::Plugin::Locator::$carrier_locator";
38 41 50       249 $locator_class->require or die $!;
39 41         1286 return bless {}, $locator_class;
40             }
41              
42 0     0 1 0 sub get_location { die "ABSTRACT METHOD" }
43              
44             sub _get_carrier_locator {
45 90     90   20801 my ( $agent, $params, $option_ref ) = @_;
46              
47 90 100       259 my $carrier = $agent->is_docomo ? 'DoCoMo'
    100          
    100          
    100          
48             : $agent->is_ezweb ? 'EZweb'
49             : $agent->is_softbank ? 'SoftBank'
50             : $agent->is_airh_phone ? 'Willcom'
51             : undef;
52 90 100       827 croak( "Invalid mobile user agent: " . $agent->user_agent ) if !$carrier;
53              
54 89         90 my $locator;
55 89 100 100     694 if ( !defined $option_ref
    100 100        
    100          
    50          
56             || !defined $option_ref->{locator}
57             || $option_ref->{locator} eq $LOCATOR_AUTO_FROM_COMPLIANT ) {
58 38 100       122 $locator = $agent->gps_compliant ? 'GPS' : 'BasicLocation';
59             }
60             elsif ( $option_ref->{locator} eq $LOCATOR_AUTO ) {
61 25 100       57 $locator = _is_gps_parameter( $agent, $params ) ? 'GPS' : 'BasicLocation';
62             }
63             elsif ( $option_ref->{locator} eq $LOCATOR_GPS ) {
64 10         17 $locator = 'GPS';
65             }
66             elsif ( $option_ref->{locator} eq $LOCATOR_BASIC ) {
67 16         29 $locator = 'BasicLocation';
68             }
69             else {
70 0         0 croak( "Invalid locator: " . $option_ref->{locator} );
71             }
72              
73 89         732 return $carrier . '::' . $locator;
74             }
75              
76             # to check whether parameter is gps or basic
77             sub _is_gps_parameter {
78 32     32   1263 my ( $agent, $stuff ) = @_;
79 32         73 my $params = _prepare_params( $stuff );
80 32 100       162 if ( $agent->is_docomo ) {
    100          
    100          
    50          
81 12         87 return !defined $params->{ AREACODE };
82             }
83             elsif ( $agent->is_ezweb ) {
84 9   100     129 return defined $params->{ datum } && $params->{ datum } =~ /^\d+$/
85             }
86             elsif ( $agent->is_softbank ) {
87 9         136 return defined $params->{ pos };
88             }
89             elsif ( $agent->is_airh_phone ) {
90 2         33 return;
91             }
92             else {
93 0         0 croak( "Invalid mobile user agent: " . $agent->user_agent );
94             }
95             }
96              
97             sub _prepare_params {
98 77     77   8401 my $stuff = shift;
99 77 100 100     260 if ( ref $stuff && eval { $stuff->can( 'param' ) } ) {
  69         585  
100 8         24 return +{ map {
101 3 100       141 $_ => ( scalar(@{[$stuff->param($_)]}) > 1 ) ? [ $stuff->param( $_ ) ]
  8         194  
102             : $stuff->param( $_ )
103             } $stuff->param };
104             }
105             else {
106 74         124 return $stuff;
107             }
108             }
109              
110             1;
111             __END__