File Coverage

blib/lib/WWW/PlaceEngine.pm

Criterion	Covered	Total	%
statement	17	113	15.0
branch	0	54	0.0
condition	0	27	0.0
subroutine	6	23	26.0
pod	15	17	88.2
total	38	234	16.2

package WWW::PlaceEngine;

use strict;
use vars qw($VERSION);
use Readonly;
use JSON;
use LWP::UserAgent;
$VERSION = '0.03';
$JSON::QuotApos = 1;
$JSON::UTF8 = 1;

Readonly my $API_HOST      => 'http://www.placeengine.com/api';
Readonly my $RTAG_DAEMON   => 'http://localhost:5448';
Readonly my $APKEY_DEFAULT => 'jVX7qKlFTUUcbNOBAnVX7XFhSUm6FyFzapE5oyv4Y.D6asJrrI5w3dUKsBgrpXe8eDIYrAff3WWKtXxnx.SX7OztpPf7SrrcJK-c0fyZKYSNVn-Gp3Kqb-4-VajcTxlFKt12r44C6oK5OPh7UsWLvt-xB3J.TuPHj0ptHJtuGAn1xc.ZA-4R3LBOQyYUsyphZACHrMvKQ1dAlPZPdyiwxpQfFczAZ4AljisHF5eFvjfYk6y5YUNsaT-TOqNCG22UyLTKL4t0bk.43YJU0M2cbdf07TWmDkQOy5JP9NmX1Ea8vbCZTM.DgEqPrsmrOaI9mmvEVppeCxASBz48ON.shw__,cGVybA__,44OR44O844Or44OX44Ot44Kw44Op44Og';
Readonly my $TESTED_RTAGD  => 'w070606';
Readonly my $AGENT_DEFAULT => "WWW::PlaceEngine/$VERSION";
Readonly my $ERR_NOT_OCCUR => 0;
Readonly my $ERR_WIFI_OFF  => 1;
Readonly my $ERR_NO_AP     => 2;
Readonly my $ERR_WIFI_DENY => 4;
Readonly my $ERR_WIFI_TO   => 5;
Readonly my $ERR_NO_APPKEY => 6;
Readonly my $ERR_NO_RTAGD  => 7;
Readonly my $ERR_NO_HOST   => 8;
Readonly my $ERR_RTAGD_OLD => 9;
Readonly my $ERR_NO_LOCAL  => 10;

Readonly my $ERROR_TABLE   => {
                                  $ERR_NOT_OCCUR => '',
                                  $ERR_WIFI_OFF  => 'WiFi device is maybe turned off.',
                                  $ERR_NO_AP     => 'No APs are found or getting WiFi information is denyed.',
                                  $ERR_WIFI_DENY => 'Getting WiFi information is denyed.',
                                  $ERR_WIFI_TO   => 'Getting WiFi information is timeout.',
                                  $ERR_NO_APPKEY => 'Application key is wrong or not found.',
                                  $ERR_NO_RTAGD  => 'PlaceEngine client not found or cannot accessible.',
                                  $ERR_NO_HOST   => 'PlaceEngine API host cannot accessible.',
                                  $ERR_RTAGD_OLD => "PlaceEngine client's version is old. At least $TESTED_RTAGD version is need",
                                  $ERR_NO_LOCAL  => 'No APs are found in local DB.',
                              };

##############################################################################
# CONSTRCUTOR
##############################################################################

sub new {
    my $class = shift;
    my %opt   = @_;
    bless {
        host    => $API_HOST      ,
        rtagd   => $RTAG_DAEMON   ,
        appkey  => $APKEY_DEFAULT ,
        errcode => $ERR_NOT_OCCUR ,
        err     => ''             ,
        # overwrite
        %opt,
    }, $class;
}

##############################################################################
# ACCESSOR
##############################################################################
BEGIN{
    for my $name (qw/ua host rtagd appkey err errcode rtag t numap version/)
    {
        eval qq{
            sub $name { \$_[0]->{$name} = \$_[1] if(defined \$_[1]); \$_[0]->{$name} }
        };
    }
}

##############################################################################
# METHODS
##############################################################################

sub get_location {
    my $self = shift;
    $self->check_rtagd or return;
    $self->get_rtag or return;
    $self->decode_rtag();
}

sub get_local_location {
    my $self = shift;
    my $time = shift || $self->t || time;
    my $param = '/locdb?t=' . $time;
    $param .= '&appk=' . $self->appkey;

    my $ua = $self->ua || $self->ua(LWP::UserAgent->new(agent=>$AGENT_DEFAULT));
    my $res = $ua->get($self->rtagd . $param);
    return $self->set_err($ERR_NO_RTAGD) if !$res->is_success;

    my $cont = $res->content;
    my ($long,$lat,$result,$opt) = @{jsonToObj($cont)};
    for my $name (qw/long lat result/) {
        $opt->{$name} = eval qq{\$$name};
    }

    if ($result < 0) {
        return $self->set_err($result * -1);
    } elsif ($result == 0) {
        return $self->set_err($ERR_NO_LOCAL) if (($opt->{lat} == 0.0) && ($opt->{long} == 0.0));
    }

    return $opt;
}

sub check_rtagd {
    my $self = shift;

    return $self->version if $self->version;

    my $ua = $self->ua || $self->ua(LWP::UserAgent->new(agent=>$AGENT_DEFAULT));
    my $origto = $ua->timeout;
    $ua->timeout(30);
    my $res = $ua->get($self->rtagd . '/ackjs?t=' . time);
    $ua->timeout($origto);
    return $self->set_err($ERR_NO_RTAGD) if !$res->is_success;

    my ($version) = $res->content =~ /^ackRTAG\("(.*)"\);$/;

    return $self->set_err($ERR_RTAGD_OLD) if ($version lt $TESTED_RTAGD);

    $self->version($version);
}

sub get_rtag {
    my $self = shift;
    $self->set_err;
    $self->numap(0);
    $self->rtag('');
    $self->t(time);
    return $self->set_err($ERR_NO_APPKEY) if !$self->appkey;

    my $ua = $self->ua || $self->ua(LWP::UserAgent->new(agent=>$AGENT_DEFAULT));
    my $origto = $ua->timeout;
    $ua->timeout(30);
    my $res = $ua->get($self->rtagd . '/rtagjs?t=' . $self->t . '&appk=' . $self->appkey);
    $ua->timeout($origto);
    return $self->set_err($ERR_NO_RTAGD) if !$res->is_success;

    my ($rtag,$numap,$time) = $res->content =~ /^recvRTAG\("(.*)",(.*),(.*)\);$/;

    if ($numap < 0) {
        return $self->set_err($numap * -1);
    } elsif ($numap == 0) {
        return $self->set_err($ERR_NO_AP);
    }

    $self->numap($numap);
    $self->t($time);
    $self->rtag($rtag);
}

sub decode_rtag {
    my $self = shift;
    my $rtag = shift || $self->rtag || '';
    my $time = shift || $self->t || time;

    my $param = '/loc?rtag=' . $rtag . '&t=' . $time;
    $param .= '&appk=' . $self->appkey .'&fmt=json';

    my $ua = $self->ua || $self->ua(LWP::UserAgent->new(agent=>$AGENT_DEFAULT));
    my $res = $ua->get($self->host . $param);
    return $self->set_err($ERR_NO_HOST) if !$res->is_success;

    my $cont = $res->content;
    my ($long,$lat,$range,$opt) = @{jsonToObj($cont)};
    for my $name (qw/long lat range/) {
        $opt->{$name} = eval qq{\$$name};
    }

    if ($opt->{range} == -113) {
        return $self->set_err($opt->{range},'Request format is illegal.');
    } elsif ($opt->{range} <= -100) {
        return $self->set_err($opt->{range},'AP has no location information.');
    } elsif ($opt->{range} <= 0) {
        return $self->set_err($opt->{range},'No APs are found.');
    }
    return $opt;
}

##############################################################################
# ERROR
##############################################################################

sub set_err {
    my $self = shift;
    my ($errcode,$err) = @_;

    $self->errcode($errcode || 0);
    $self->err( $err || $ERROR_TABLE->{$errcode} || 'Unkown error occured.');

    return;
}

1;

__END__