Changeset 21515 for lang/perl

Show
Ignore:
Timestamp:
10/17/08 20:01:36 (5 years ago)
Author:
clouder
Message:

cleanup and fixed few bugs

Location:
lang/perl/HTTP-MobileAgent-Plugin-Locator/trunk
Files:
2 added
4 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/HTTP-MobileAgent-Plugin-Locator/trunk/lib/HTTP/MobileAgent/Plugin/Locator.pm

    r11677 r21515  
    1212our %EXPORT_TAGS = (locator => [@EXPORT_OK]); 
    1313 
    14 our $VERSION = '0.01'; 
    15  
    16 our $DOCOMO_GPS_COMPLIANT_MODELS = qr/(?:903i(?!TV|X)|(?:90[45]|SA[78]0[02])i)/; 
     14our $VERSION = '0.02'; 
     15 
     16our $DOCOMO_GPS_COMPLIANT_MODELS = qr/(?:903i(?!TV|X)|(?:90[4-6]|SA[78]0[02])i)/; 
    1717 
    1818our $LOCATOR_AUTO_FROM_COMPLIANT = 1; 
    … …  
    2525    my ( $class ) = @_; 
    2626    no strict 'refs'; 
    27     *{"HTTP\::MobileAgent\::gps_compliant"} = \&_gps_compliant; 
    28     *{"HTTP\::MobileAgent\::gps_parameter"} = \&_gps_parameter; 
    29     *{"HTTP\::MobileAgent\::locator"}       = sub { $class->new( @_ ) }; 
    30     *{"HTTP\::MobileAgent\::get_location"}  = sub { 
     27    *HTTP::MobileAgent::gps_compliant = \&_gps_compliant; 
     28    *HTTP::MobileAgent::locator       = sub { $class->new( @_ ) }; 
     29    *HTTP::MobileAgent::get_location  = sub { 
    3130        my ( $self, $stuff, $option_ref ) = @_; 
    3231        my $params = _prepare_params( $stuff ); 
    3332        $self->locator( $params, $option_ref )->get_location( $params ); 
    3433    }; 
    35  
    36     $class->export_to_level(1, @_); 
    37 } 
     34    $class->export_to_level( 1, @_ ); 
     35} 
     36 
     37sub new { 
     38    my ( $class, $agent, $params, $option_ref ) = @_; 
     39    my $carrier_locator = _get_carrier_locator( $agent, $params, $option_ref ); 
     40    my $locator_class = "HTTP::MobileAgent::Plugin::Locator::$carrier_locator"; 
     41    $locator_class->require or die $!; 
     42    return bless {}, $locator_class; 
     43} 
     44 
     45sub get_location { die "ABSTRACT METHOD" } 
    3846 
    3947sub _gps_compliant { 
    … …  
    4149    if ( $self->is_docomo ) { 
    4250        return $self->model =~ $DOCOMO_GPS_COMPLIANT_MODELS; 
    43     } elsif ( $self->is_ezweb ) { 
     51    } 
     52    elsif ( $self->is_ezweb ) { 
    4453        my @specs = split //, $ENV{ HTTP_X_UP_DEVCAP_MULTIMEDIA } || ''; 
    4554        return defined $specs[ 1 ] && $specs[ 1 ] =~ /^[23]$/; 
    46     } elsif ( $self->is_softbank ) { 
     55    } 
     56    elsif ( $self->is_softbank ) { 
    4757        return $self->is_type_3gc; 
    4858    } 
    4959} 
    5060 
    51  
    52 sub _gps_parameter { 
    53     my ( $self, $stuff ) = @_; 
    54  
    55     my $params = _prepare_params( $stuff ); 
    56  
    57     if ( $self->is_docomo ) { 
    58         return (!defined $params->{AREACODE}) ? 1 : 0; 
    59     } 
    60     elsif ( $self->is_ezweb ) { 
    61         return ( $params->{datum} =~ /^\d+$/ ) ? 1 : 0; 
    62     } 
    63     elsif ( $self->is_softbank ) { 
    64         return ( defined $params->{pos} ) ? 1 : 0; 
    65     } 
    66     elsif ( $self->is_airh_phone ) { 
    67         return 0; 
    68     } 
    69     else { 
    70         croak( "Invalid mobile user agent: " . $self->user_agent ); 
    71     } 
    72 } 
    73  
    74  
    75 sub new { 
    76     my ( $class, $agent, $params, $option_ref ) = @_; 
    77  
    78  
    79     my $sub_locator = _get_sub_locator($agent, $params, $option_ref); 
    80  
    81     my $locator_class = "HTTP::MobileAgent::Plugin::Locator\::$sub_locator"; 
    82     $locator_class->require or die $!; 
    83     return bless {}, $locator_class; 
    84 } 
    85  
    86 sub get_location { die "ABSTRACT METHOD" } 
    87  
    88 sub _get_sub_locator { 
     61sub _get_carrier_locator { 
    8962    my ( $agent, $params, $option_ref ) = @_; 
    9063 
    91     my $carrier =   ( $agent->is_docomo      ) ? 'DoCoMo'   : 
    92                     ( $agent->is_ezweb       ) ? 'EZweb'    : 
    93                     ( $agent->is_softbank    ) ? 'SoftBank' : 
    94                     ( $agent->is_airh_phone  ) ? 'Willcom'  : undef 
    95     ; 
    96     if ( !$carrier ) { 
    97         croak( "Invalid mobile user agent: " . $agent->user_agent ); 
    98     } 
     64    my $carrier = $agent->is_docomo     ? 'DoCoMo' 
     65                : $agent->is_ezweb      ? 'EZweb' 
     66                : $agent->is_softbank   ? 'SoftBank' 
     67                : $agent->is_airh_phone ? 'Willcom' 
     68                : undef; 
     69    croak( "Invalid mobile user agent: " . $agent->user_agent ) if !$carrier; 
    9970 
    10071    my $locator; 
    101     if (   !defined $option_ref 
    102         || !defined $option_ref->{locator} 
    103         || $option_ref->{locator} eq $LOCATOR_AUTO_FROM_COMPLIANT ) 
    104     { 
    105         $locator = ( $agent->gps_compliant ) ? 'GPS' : 'BasicLocation'; 
     72    if ( !defined $option_ref 
     73         || !defined $option_ref->{locator} 
     74         || $option_ref->{locator} eq $LOCATOR_AUTO_FROM_COMPLIANT ) { 
     75        $locator = $agent->gps_compliant ? 'GPS' : 'BasicLocation'; 
    10676    } 
    10777    elsif ( $option_ref->{locator} eq $LOCATOR_AUTO ) { 
    108         $locator = ( $agent->gps_parameter( $params ) ) ? 'GPS' : 'BasicLocation'; 
     78        $locator = _is_gps_parameter( $agent, $params ) ? 'GPS' : 'BasicLocation'; 
    10979    } 
    11080    elsif ( $option_ref->{locator} eq $LOCATOR_GPS ) { 
    111         $locator =  'GPS'; 
     81        $locator = 'GPS'; 
    11282    } 
    11383    elsif ( $option_ref->{locator} eq $LOCATOR_BASIC ) { 
    … …  
    11989 
    12090    return $carrier . '::' . $locator; 
     91} 
     92 
     93# to check whether parameter is gps or basic 
     94sub _is_gps_parameter { 
     95    my ( $agent, $stuff ) = @_; 
     96    my $params = _prepare_params( $stuff ); 
     97    if ( $agent->is_docomo ) { 
     98        return !defined $params->{ AREACODE }; 
     99    } 
     100    elsif ( $agent->is_ezweb ) { 
     101        return defined $params->{ datum } && $params->{ datum } =~ /^\d+$/ 
     102    } 
     103    elsif ( $agent->is_softbank ) { 
     104        return defined $params->{ pos }; 
     105    } 
     106    elsif ( $agent->is_airh_phone ) { 
     107        return; 
     108    } 
     109    else { 
     110        croak( "Invalid mobile user agent: " . $agent->user_agent ); 
     111    } 
    121112} 
    122113 
    … …  
    124115    my $stuff = shift; 
    125116    if ( ref $stuff && eval { $stuff->can( 'param' ) } ) { 
    126         return +{ map { $_ => (scalar(@{[$stuff->param($_)]}) > 1) ? [$stuff->param( $_ )] : $stuff->param($_) } $stuff->param }; 
     117        return +{ map { 
     118            $_ => ( scalar(@{[$stuff->param($_)]}) > 1 ) ? [ $stuff->param( $_ ) ] 
     119                                                         : $stuff->param( $_ ) 
     120        } $stuff->param }; 
    127121    } 
    128122    else { 
    … …  
    144138    use HTTP::MobileAgent::Plugin::Locator; 
    145139 
     140    $q = CGI->new; 
     141    $agent = HTTP::MobileAgent->new; 
     142 
    146143    # get location is Geo::Coordinates::Converter::Point instance formatted wgs84 
    147     my $q = CGI->new; 
    148     my $agent = HTTP::MobileAgent->new; 
    149     my $location = $agent->get_location( $q ); 
    150  
     144    # ./t/* has many examples. 
     145    $location = $agent->get_location( $q ); 
     146    # or 
     147    $location = $agent->get_location( { lat => '35.21.03.342', 
     148                                        lon => '138.34.45.725', 
     149                                        geo => 'wgs84' } ); 
     150    # or 
     151    $location = $agent->get_location( $q, { locator => $LOCATOR_GPS } ); 
     152 
     153    # get latitude and longitude 
    151154    print "lat is " . $location->lat; 
    152155    print "lng is " . $location->lng; 
    … …  
    154157=head1 METHODS 
    155158 
    156  
    157159=head2 get_location([params], $option_ref); 
    158160 
    … …  
    163165=over 
    164166 
    165 =item $option_ref{locator} 
     167=item $option_ref->{locator} 
    166168 
    167169select locator class algorithm option. 
    168170 
    169171$LOCATOR_AUTO_FROM_COMPLIANT 
    170  auto detect locator from gps compliant.this is I<default>. 
     172 auto detect locator from gps compliant. This is I<default>. 
    171173 
    172174$LOCATOR_AUTO 
    … …  
    181183=back 
    182184 
    183  
    184  
    185185=head2 gps_compliant() 
    186186 
    187187returns if the agent is GPS compliant. 
    188188 
    189  
    190  
    191 =head2 gps_parameter([params]) 
    192  
    193 returns if the params is GPS request. 
    194  
    195  
    196189=head1 CLASSES 
    197190 
    … …  
    237230 
    238231  Tokuhiro Matsuno E<lt>tokuhiro __at__ mobilefactory.jpE<gt> 
     232  Masahiro Chiba E<lt>chiba __at__ geminium.comE<gt> 
    239233 
    240234=head1 SEE ALSO 
    … …  
    242236C<HTTP::MobileAgent>, C<Geo::Coordinates::Converter>, C<Geo::Coordinates::Converter::Point>, C<Geo::Coordinates::Converter::iArea>, C<http://coderepos.org/share/log/lang/perl/HTTP-MobileAgent-Plugin-Locator/> 
    243237 
    244 =head1 LICENCE AND COPYRIGHT 
    245  
    246 Copyright (c) 2008, Yoshiki Kurihara E<lt>kurihara __at__ cpan.orgE<gt>. All rights reserved. 
     238=head1 LICENCE 
    247239 
    248240This module is free software; you can redistribute it and/or 
    249241modify it under the same terms as Perl itself. See L<perlartistic>. 
    250242 
    251 =head1 DISCLAIMER OF WARRANTY 
    252  
    253 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 
    254 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 
    255 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 
    256 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER 
    257 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 
    258 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 
    259 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH 
    260 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL 
    261 NECESSARY SERVICING, REPAIR, OR CORRECTION. 
    262  
    263 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 
    264 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 
    265 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE 
    266 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, 
    267 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE 
    268 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 
    269 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 
    270 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 
    271 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 
    272 SUCH DAMAGES. 
     243=cut 

  • lang/perl/HTTP-MobileAgent-Plugin-Locator/trunk/t/01.get_location.t

    r7422 r21515  
    5050        $for_basic_on_gps_option_refs, 
    5151        { AREACODE => '05902' }, 
    52         { lat => '35.39.43.535', lng => '139.44.06.233' } 
     52        { lat => '35.39.52.909', lng => '139.43.52.172' } 
    5353    ); 
    54      
    5554} 
    5655 
    … …  
    6665        $for_basic_option_refs, 
    6766        { AREACODE => '05902' }, 
    68         { lat => '35.39.43.535', lng => '139.44.06.233' } 
     67        { lat => '35.39.52.909', lng => '139.43.52.172' } 
    6968    ); 
    7069} 
    … …  
    7473    local $ENV{HTTP_USER_AGENT} = 'KDDI-CA31 UP.Browser/6.2.0.7.3.129 (GUI) MMP/2.0'; 
    7574    local $ENV{HTTP_X_UP_DEVCAP_MULTIMEDIA} = '0200000000000000'; 
    76      
     75 
    7776    locator_test( 
    7877        $for_gps_option_refs, 
    … …  
    105104        { lat => '35.21.03.342', lng => '138.34.45.725' } 
    106105    ); 
    107      
     106 
    108107    local $ENV{ HTTP_X_JPHONE_GEOCODE } = '352051%1a1383456%1afoo'; 
    109108    locator_test( 

  • lang/perl/HTTP-MobileAgent-Plugin-Locator/trunk/t/02.gps_comliant.t

    r4371 r21515  
    33use HTTP::MobileAgent; 
    44use HTTP::MobileAgent::Plugin::Locator; 
     5 
     6{ 
     7    local $ENV{HTTP_USER_AGENT} = 'DoCoMo/2.0 P906i(c100;TB;W24H15)'; 
     8    my $agent = HTTP::MobileAgent->new; 
     9    ok $agent->gps_compliant, "docomo gps"; 
     10} 
    511 
    612{ 

  • lang/perl/HTTP-MobileAgent-Plugin-Locator/trunk/t/07.gps_parameter.t

    r7422 r21515  
    1010 
    1111    # GPS 
    12     is $agent->gps_parameter({ 
     12    is HTTP::MobileAgent::Plugin::Locator::_is_gps_parameter( $agent, { 
    1313        lat => '35.21.03.342', lon => '138.34.45.725', geo => 'wgs84' 
    14     }) => 1; 
     14    } ) => 1; 
    1515 
    1616    # Basic 
    17     is $agent->gps_parameter({ 
    18         AREACODE => '05902', LAT => '+35.39.43.538', LON => '+139.44.06.232', GEO => 'wgs84', XACC => 1  
    19     }) => 0; 
     17    is HTTP::MobileAgent::Plugin::Locator::_is_gps_parameter( $agent, { 
     18        AREACODE => '05902', LAT => '+35.39.43.538', LON => '+139.44.06.232', GEO => 'wgs84', XACC => 1 
     19    }) => ''; 
    2020 
    21     is $agent->gps_parameter({ 
     21    is HTTP::MobileAgent::Plugin::Locator::_is_gps_parameter( $agent, { 
    2222        AREACODE => '05902' 
    23     }) => 0; 
     23    }) => ''; 
    2424} 
    2525 
    … …  
    3131 
    3232    # GPS 
    33     is $agent->gps_parameter({ 
     33    is HTTP::MobileAgent::Plugin::Locator::_is_gps_parameter( $agent, { 
    3434        lat => '+35.21.03.342', lon => '+138.34.45.725', datum => '0' 
    3535    }) => 1; 
    3636 
    3737    # Basic 
    38     is $agent->gps_parameter({ 
     38    is HTTP::MobileAgent::Plugin::Locator::_is_gps_parameter( $agent, { 
    3939        lat => '35.21.03.342', lon => '138.34.45.725', datum => 'wgs84' 
    40     }) => 0; 
    41  
     40    }) => ''; 
    4241} 
    4342 
    4443 
    4544{ # SoftBank 
    46     local $ENV{HTTP_USER_AGENT} = 'SoftBank/1.0/911T/TJ001 Browser/NetFront/3.3 Profile/MIDP-2.0 Configuration/CLDC-1.1'; 
     45    local $ENV{HTTP_USER_AGENT} = 
     46        'SoftBank/1.0/911T/TJ001 Browser/NetFront/3.3 Profile/MIDP-2.0 Configuration/CLDC-1.1'; 
    4747    my $agent = HTTP::MobileAgent->new; 
    4848 
    4949    # GPS 
    50     is $agent->gps_parameter({ 
    51         pos => 'N35.21.03.342E138.34.45.725'  
     50    is HTTP::MobileAgent::Plugin::Locator::_is_gps_parameter( $agent, { 
     51        pos => 'N35.21.03.342E138.34.45.725' 
    5252    }) => 1; 
    5353 
    5454    # Basic 
    5555    local $ENV{ HTTP_X_JPHONE_GEOCODE } = '352051%1a1383456%1afoo'; 
    56     is $agent->gps_parameter({ 
    57     }) => 0; 
    58  
     56    is HTTP::MobileAgent::Plugin::Locator::_is_gps_parameter( $agent, { 
     57    }) => ''; 
    5958} 
    6059