File Coverage

blib/lib/Location/Area/DoCoMo/iArea.pm

Criterion	Covered	Total	%
statement	34	131	25.9
branch	0	20	0.0
condition	0	19	0.0
subroutine	11	31	35.4
pod	9	19	47.3
total	54	220	24.5

package Location::Area::DoCoMo::iArea;

################################
#
#  DoCoMo Functions for iArea
#  Location::Area::DoCoMo::iArea
#

use 5.008;
use strict;
use warnings;
use vars qw($VERSION $AUTOLOAD $useAdjustedAura);
$VERSION = 2.10;

use Carp;
use Location::GeoTool;
use Location::GeoTool::Aura;
use Location::Area::DoCoMo::iArea::Area;
require Location::Area::DoCoMo::iArea::Region;
require Location::Area::DoCoMo::iArea::Next;

__PACKAGE__->_make_accessors(
  qw(areaid sub_areaid name meshcache)
);

################################################################
# Constructor                  #
################################

sub import
{
  my $caller = shift;
  $useAdjustedAura = 0;
  foreach (@_)
  {
    $useAdjustedAura = 1 if ($_ =~ /useAdjustedAura/);
  }
}

################################
# From iArea code

sub create_iarea
{
  my $class = shift;
  my ($area,$sub_area) = @_;

  if ($area =~ /^(\d{3})(\d{2})$/)
  {
    $area = $1;
    $sub_area = $2;
  }
  elsif (!(($area =~ /^\d{3}$/) && ($sub_area =~ /^\d{2}$/)))
  {
    return undef;
  }

  return bless Location::Area::DoCoMo::iArea::Area->seek("$area$sub_area",$useAdjustedAura),$class;
}

################################
# From coordinate

sub create_coord
{
  my $class = shift;
  my $mesh = $class->calcurate_mesh(@_);
  return bless Location::Area::DoCoMo::iArea::Area->seek($mesh,$useAdjustedAura),$class;
}

sub include_area
{
  my $self = shift;
  my $mesh = $self->calcurate_mesh(@_);
  my ($m2,$m3,$m4,$m5,$m6,$m7) = $mesh =~ /^(\d{6})(\d?)(\d?)(\d?)(\d?)(\d?)$/;
  return $self->meshcache =~ /,(${m2}(${m3}(${m4}(${m5}(${m6}${m7}?)?)?)?)?),/ ? 1 : 0;
}

sub calcurate_mesh
{
  my $class = shift;
  my ($lat,$lon,$usetokyo,$format) = @_;

  if (UNIVERSAL::isa($lat, 'Location::GeoTool'))
  {
    ($lat,$lon) = $lat->datum_tokyo->format_second->array;
  }
  else
  {
    my $datum = $usetokyo || 'wgs84';
    $datum = 'tokyo' if ($datum eq '1');
    $format ||= 'spacetag';
    ($lat,$lon) = Location::GeoTool->create_coord($lat,$lon,$datum,$format)->datum_tokyo->format_second->array;
  }

  ($lat,$lon) = map { int ($_ * 1000) } ($lat,$lon);

  my @mesh = ();
  my $ab = int($lat / 2400000);
  my $cd = int($lon / 3600000) - 100;
  my $x1 = ($cd +100) * 3600000;
  my $y1 = $ab * 2400000;
  my $e = int(($lat - $y1) / 300000);
  my $f = int(($lon - $x1) / 450000);
  $mesh[0] = $ab.$cd.$e.$f;
  my $x2 = $x1 + $f * 450000;
  my $y2 = $y1 + $e * 300000;
  my $l3 = int(($lon - $x2) / 225000);
  my $m3 = int(($lat - $y2) / 150000);
  my $g = $l3 + $m3 * 2;
  $mesh[1] = $mesh[0].$g;
  my $x3 = $x2 + $l3 * 225000;
  my $y3 = $y2 + $m3 * 150000;
  my $l4 = int(($lon - $x3) / 112500);
  my $m4 = int(($lat - $y3) / 75000);
  my $h = $l4 + $m4 * 2;
  $mesh[2] = $mesh[1].$h;
  my $x4 = $x3 + $l4 * 112500;
  my $y4 = $y3 + $m4 * 75000;
  my $l5 = int(($lon - $x4) / 56250);
  my $m5 = int(($lat - $y4) / 37500);
  my $i = $l5 + $m5 * 2;
  $mesh[3] = $mesh[2].$i;
  my $x5 = $x4 + $l5 * 56250;
  my $y5 = $y4 + $m5 * 37500;
  my $l6 = int(($lon - $x5) / 28125);
  my $m6 = int(($lat - $y5) / 18750);
  my $j = $l6 + $m6 * 2;
  $mesh[4] = $mesh[3].$j;
  my $x6 = $x5 + $l6 * 28125;
  my $y6 = $y5 + $m6 * 18750;
  my $l7 = int(($lon - $x6) / 14062.5);
  my $m7 = int(($lat - $y6) / 9375);
  my $k = $l7 + $m7 * 2;
  $mesh[5] = $mesh[4].$k;

  return $mesh[5];
}

################################################################
# Fields                       #
################################

################################
# Construct accessor methods

sub _make_accessors
{
  my($class, @attr) = @_;
  for my $attr (@attr) {
    no strict 'refs';
    *{"$class\::$attr"} = sub { shift->{$attr} };
  }
}

################################
# Accessor method for full areaid

sub full_areaid {$_[0]->id}
sub id{ $_[0]->areaid().$_[0]->sub_areaid() }

sub prefecture
{
  my $self = shift;
  unless ($self->{prefecture})
  {
    ($self->{region},$self->{prefecture}) = Location::Area::DoCoMo::iArea::Region->seek($self->{areaid},$self->{sub_areaid});
  }
  return $self->{prefecture};
}

sub region
{
  my $self = shift;
  unless ($self->{region})
  {
    ($self->{region},$self->{prefecture}) = Location::Area::DoCoMo::iArea::Region->seek($self->{areaid},$self->{sub_areaid});
  }
  return $self->{region};
}

################################################################
# Methods                      #
################################

################################
# Get new Location::Area::DoCoMo::iArea objects which next to this area

sub get_nextarea
{
  my $self = shift;
  my $next = Location::Area::DoCoMo::iArea::Next->seek($self->{areaid},$self->{sub_areaid});

  my @nextareas = ();
  foreach my $s (@$next)
  {
    $s =~ s/\-//;
    my $tmpobj = Location::Area::DoCoMo::iArea->create_iarea($s);
    push (@nextareas,$tmpobj);
  }
  return wantarray() ? @nextareas : \@nextareas;
}

################################
# Get Location::GeoTool::Aura object of this area's aura

sub get_aura
{
  Location::GeoTool::Aura->create_vertex(map {$_[0]->$_} ('sw','se','nw','ne'));
}

################################
# Get Location::GeoTool object of center point of this area's aura

sub get_center
{
  $_[0]->get_aura->get_center;
}

################################
# For internal use: Get Location::GeoTool object of each vertex of area's aura

sub sw{$_[0]->{'sw'} ||= Location::GeoTool->create_coord($_[0]->{"south"}/1000,$_[0]->{"west"}/1000,'tokyo','second')}
sub se{$_[0]->{'se'} ||= Location::GeoTool->create_coord($_[0]->{"south"}/1000,$_[0]->{"east"}/1000,'tokyo','second')}
sub nw{$_[0]->{'nw'} ||= Location::GeoTool->create_coord($_[0]->{"north"}/1000,$_[0]->{"west"}/1000,'tokyo','second')}
sub ne{$_[0]->{'ne'} ||= Location::GeoTool->create_coord($_[0]->{"north"}/1000,$_[0]->{"east"}/1000,'tokyo','second')}

################################################################
# Legacy                       #
################################

sub setArea{shift->create_iarea(@_)}
sub setCoordinate{shift->create_coord(@_)}
sub getNextArea{shift->get_nextarea(@_)}
sub getAura
{
  my ($self,$usetokyo) = @_;
  my $datum;
  $datum = $usetokyo ? 'datum_tokyo' : 'datum_wgs84';

  return $self->get_aura->$datum->format_spacetag->array;
}

1;
__END__