File Coverage

blib/lib/WWW/Hatena/WanWanWorld.pm

Criterion	Covered	Total	%
statement	18	26	69.2
branch	0	4	0.0
condition			n/a
subroutine	6	9	66.6
pod			n/a
total	24	39	61.5

package WWW::Hatena::WanWanWorld::position;
use strict;
use warnings;

sub lat { &WWW::Hatena::Scraper::_getset; }
sub long { &WWW::Hatena::Scraper::_getset; }
sub position {
    my $self = shift;
    if (@_ == 2) {
        $self->lat(shift);
        $self->long(shift);
    } elsif (@_ != 0) {
        croak ("Number of parameters are invalid");
    }
    return ($self->lat,$self->long);
}

package WWW::Hatena::WanWanWorld;

use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.02';

use base qw(WWW::Hatena::Scraper WWW::Hatena::WanWanWorld::position);
use Digest::MD5 qw(md5_base64);
use JSON;
use Location::GeoTool;
use Encode;

Encode::Alias::define_alias( qr/^euc$/i => '"euc-jp"' );

sub new {
    my $self = shift;
    my %opts = @_;
    $opts{labo} = 1;

    $opts{user_check_code} = sub {
        my $self = shift;
        my $content = shift;

        my ($user) = $content =~ /var\smyName\s*=\s*'([^']+)';/;
        $self->user($user);
        my ($long,$lat) = $content =~ /var\sstart\s*=\s*\[([\d\.]+),\s*([\d\.]+)\];/;
        $self->lat($lat);
        $self->long($long);

        $self->user;
    };
    $opts{user_check_url} = "http://world.hatelabo.jp/";
    my $charcode = delete $opts{'charcode'} || 'encode';

    $self = $self->WWW::Hatena::Scraper::new(%opts);
    $self->logout_url("http://world.hatelabo.jp/logout");
    $self->charcode($charcode);
    return $self;
}

sub friends { &WWW::Hatena::Scraper::_getset; }
sub arounds { &WWW::Hatena::Scraper::_getset; }
sub markers { &WWW::Hatena::Scraper::_getset; }
sub voice { &WWW::Hatena::Scraper::_getset; }
sub charcode { &WWW::Hatena::Scraper::_getset; }
sub json {
    my $self = shift;
    $self->{'json'} ||= JSON->new(unmapping => 1, quotapos => 1 , barekey => 1,utf8 => $self->charcode eq 'encode' ? 1: 0);
}

sub get_around {
    my $self = shift;
    my $km = shift;
    my $rkm = md5_base64($self->rk);
    my $voice = $self->encoded_voice() || '';
    my ($lat,$long,$minY,$minX,$maxY,$maxX) = $self->get_minmax($km);
    my $content = "z=1&lat=${long}&lng=${lat}&voice=${voice}&rkm=${rkm}&minX=${minX}&maxX=${maxX}&minY=${minY}&maxY=${maxY}&_=";
    my $json = $self->json->jsonToObj($self->get_content('http://world.hatelabo.jp/position',$content));
    for my $dog (map { $json->{$_} } keys %$json) {
        my $voice = $dog->{'voice'};
        $voice = encode($self->charcode,$voice) if ($self->charcode ne 'encode');
        $dog->{'voice'} = $voice || '';
    }
    $self->arounds($json);
}

sub get_friend {
    my $self = shift;
    my $content = shift || '';
    my $res = $self->get_content('http://world.hatelabo.jp/friend',$content);
    if ($content eq '') {
        return $self->friends($self->json->jsonToObj($res));
    } else {
        my ($result) = $res =~ /(.+)<\/success>/m;
        return eval {$result} || 0;
    }
}

sub delete_friend {
    my $self = shift;
    my $friend = shift;
    my $rkm = md5_base64($self->rk);
    $self->get_friend("mode=delete&friendname=${friend}&rkm=${rkm}&_=");
}

sub add_friend {
    my $self = shift;
    my $friend = shift;
    my $rkm = md5_base64($self->rk);
    $self->get_friend("mode=add&friendname=${friend}&rkm=${rkm}&_=");
}

sub get_marker {
    my $self = shift;
    my $km = shift;
    my ($lat,$long,$minY,$minX,$maxY,$maxX) = $self->get_minmax($km);
    my $content = "minX=${minX}&maxX=${maxX}&minY=${minY}&maxY=${maxY}<=20&_=";
    $self->markers($self->json->jsonToObj($self->get_content('http://world.hatelabo.jp/marker',$content)));
}

sub add_house {
    my $self = shift;
    my ($lat,$long) = $self->position;
    my $rkm = md5_base64($self->rk);
    $self->json->jsonToObj($self->get_content('http://world.hatelabo.jp/house',"lat=${long}&lng=${lat}&mode=add&rkm=${rkm}&_="));
}

sub get_minmax {
    my $self = shift;
    my $km = shift;
    my ($lat,$long) = $self->position;
    my $loc = Location::GeoTool->create_coord($lat,$long,'wgs84','degree');
    my ($minY,$minX) = $loc->direction_vector(225,$km * 1414.21356)->to_point->array;
    my $maxX = $long * 2 - $minX;
    my $maxY = $lat * 2 - $minY;
    return ($lat,$long,$minY,$minX,$maxY,$maxX);
}

sub encoded_voice {
    my $self = shift;

    my $voice = $self->voice;
    $voice = decode($self->charcode,$voice) if ($self->charcode ne 'encode');
    Encode::_utf8_off($voice);

    if ($voice) {
        $voice =~ s/([^0-9A-Za-z_ ])/'%'.unpack('H2',$1)/ge;
        $voice =~ s/\s/+/g;
    }
    return $voice;
}

1;
__END__