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


line stmt bran cond sub pod time code
1             package Location::Area::DoCoMo::iArea;
2            
3             ################################
4             #
5             # DoCoMo Functions for iArea
6             # Location::Area::DoCoMo::iArea
7             #
8            
9 1     1   35196 use 5.008;
  1         4  
  1         44  
10 1     1   6 use strict;
  1         1  
  1         34  
11 1     1   5 use warnings;
  1         13  
  1         43  
12 1     1   5 use vars qw($VERSION $AUTOLOAD $useAdjustedAura);
  1         2  
  1         82  
13             $VERSION = 2.10;
14            
15 1     1   5 use Carp;
  1         2  
  1         917  
16 1     1   5611 use Location::GeoTool;
  1         88036  
  1         5  
17 1     1   2321 use Location::GeoTool::Aura;
  1         1461  
  1         30  
18 1     1   10669 use Location::Area::DoCoMo::iArea::Area;
  1         3  
  1         1289  
19             require Location::Area::DoCoMo::iArea::Region;
20             require Location::Area::DoCoMo::iArea::Next;
21            
22             __PACKAGE__->_make_accessors(
23             qw(areaid sub_areaid name meshcache)
24             );
25            
26             ################################################################
27             # Constructor #
28             ################################
29            
30             sub import
31             {
32 1     1   89 my $caller = shift;
33 1         3 $useAdjustedAura = 0;
34 1         13 foreach (@_)
35             {
36 0 0       0 $useAdjustedAura = 1 if ($_ =~ /useAdjustedAura/);
37             }
38             }
39            
40             ################################
41             # From iArea code
42            
43             sub create_iarea
44             {
45 0     0 1 0 my $class = shift;
46 0         0 my ($area,$sub_area) = @_;
47            
48 0 0 0     0 if ($area =~ /^(\d{3})(\d{2})$/)
    0          
49             {
50 0         0 $area = $1;
51 0         0 $sub_area = $2;
52             }
53             elsif (!(($area =~ /^\d{3}$/) && ($sub_area =~ /^\d{2}$/)))
54             {
55 0         0 return undef;
56             }
57            
58 0         0 return bless Location::Area::DoCoMo::iArea::Area->seek("$area$sub_area",$useAdjustedAura),$class;
59             }
60            
61             ################################
62             # From coordinate
63            
64             sub create_coord
65             {
66 0     0 1 0 my $class = shift;
67 0         0 my $mesh = $class->calcurate_mesh(@_);
68 0         0 return bless Location::Area::DoCoMo::iArea::Area->seek($mesh,$useAdjustedAura),$class;
69             }
70            
71             sub include_area
72             {
73 0     0 1 0 my $self = shift;
74 0         0 my $mesh = $self->calcurate_mesh(@_);
75 0         0 my ($m2,$m3,$m4,$m5,$m6,$m7) = $mesh =~ /^(\d{6})(\d?)(\d?)(\d?)(\d?)(\d?)$/;
76 0 0       0 return $self->meshcache =~ /,(${m2}(${m3}(${m4}(${m5}(${m6}${m7}?)?)?)?)?),/ ? 1 : 0;
77             }
78            
79             sub calcurate_mesh
80             {
81 0     0 0 0 my $class = shift;
82 0         0 my ($lat,$lon,$usetokyo,$format) = @_;
83            
84 0 0       0 if (UNIVERSAL::isa($lat, 'Location::GeoTool'))
85             {
86 0         0 ($lat,$lon) = $lat->datum_tokyo->format_second->array;
87             }
88             else
89             {
90 0   0     0 my $datum = $usetokyo || 'wgs84';
91 0 0       0 $datum = 'tokyo' if ($datum eq '1');
92 0   0     0 $format ||= 'spacetag';
93 0         0 ($lat,$lon) = Location::GeoTool->create_coord($lat,$lon,$datum,$format)->datum_tokyo->format_second->array;
94             }
95            
96 0         0 ($lat,$lon) = map { int ($_ * 1000) } ($lat,$lon);
  0         0  
97            
98 0         0 my @mesh = ();
99 0         0 my $ab = int($lat / 2400000);
100 0         0 my $cd = int($lon / 3600000) - 100;
101 0         0 my $x1 = ($cd +100) * 3600000;
102 0         0 my $y1 = $ab * 2400000;
103 0         0 my $e = int(($lat - $y1) / 300000);
104 0         0 my $f = int(($lon - $x1) / 450000);
105 0         0 $mesh[0] = $ab.$cd.$e.$f;
106 0         0 my $x2 = $x1 + $f * 450000;
107 0         0 my $y2 = $y1 + $e * 300000;
108 0         0 my $l3 = int(($lon - $x2) / 225000);
109 0         0 my $m3 = int(($lat - $y2) / 150000);
110 0         0 my $g = $l3 + $m3 * 2;
111 0         0 $mesh[1] = $mesh[0].$g;
112 0         0 my $x3 = $x2 + $l3 * 225000;
113 0         0 my $y3 = $y2 + $m3 * 150000;
114 0         0 my $l4 = int(($lon - $x3) / 112500);
115 0         0 my $m4 = int(($lat - $y3) / 75000);
116 0         0 my $h = $l4 + $m4 * 2;
117 0         0 $mesh[2] = $mesh[1].$h;
118 0         0 my $x4 = $x3 + $l4 * 112500;
119 0         0 my $y4 = $y3 + $m4 * 75000;
120 0         0 my $l5 = int(($lon - $x4) / 56250);
121 0         0 my $m5 = int(($lat - $y4) / 37500);
122 0         0 my $i = $l5 + $m5 * 2;
123 0         0 $mesh[3] = $mesh[2].$i;
124 0         0 my $x5 = $x4 + $l5 * 56250;
125 0         0 my $y5 = $y4 + $m5 * 37500;
126 0         0 my $l6 = int(($lon - $x5) / 28125);
127 0         0 my $m6 = int(($lat - $y5) / 18750);
128 0         0 my $j = $l6 + $m6 * 2;
129 0         0 $mesh[4] = $mesh[3].$j;
130 0         0 my $x6 = $x5 + $l6 * 28125;
131 0         0 my $y6 = $y5 + $m6 * 18750;
132 0         0 my $l7 = int(($lon - $x6) / 14062.5);
133 0         0 my $m7 = int(($lat - $y6) / 9375);
134 0         0 my $k = $l7 + $m7 * 2;
135 0         0 $mesh[5] = $mesh[4].$k;
136            
137 0         0 return $mesh[5];
138             }
139            
140             ################################################################
141             # Fields #
142             ################################
143            
144             ################################
145             # Construct accessor methods
146            
147             sub _make_accessors
148             {
149 1     1   3 my($class, @attr) = @_;
150 1         3 for my $attr (@attr) {
151 1     1   6 no strict 'refs';
  1         4  
  1         1033  
152 4     0   15 *{"$class\::$attr"} = sub { shift->{$attr} };
  4         23  
  0            
153             }
154             }
155            
156             ################################
157             # Accessor method for full areaid
158            
159 0     0 1   sub full_areaid {$_[0]->id}
160 0     0 0   sub id{ $_[0]->areaid().$_[0]->sub_areaid() }
161            
162             sub prefecture
163             {
164 0     0 1   my $self = shift;
165 0 0         unless ($self->{prefecture})
166             {
167 0           ($self->{region},$self->{prefecture}) = Location::Area::DoCoMo::iArea::Region->seek($self->{areaid},$self->{sub_areaid});
168             }
169 0           return $self->{prefecture};
170             }
171            
172             sub region
173             {
174 0     0 1   my $self = shift;
175 0 0         unless ($self->{region})
176             {
177 0           ($self->{region},$self->{prefecture}) = Location::Area::DoCoMo::iArea::Region->seek($self->{areaid},$self->{sub_areaid});
178             }
179 0           return $self->{region};
180             }
181            
182             ################################################################
183             # Methods #
184             ################################
185            
186             ################################
187             # Get new Location::Area::DoCoMo::iArea objects which next to this area
188            
189             sub get_nextarea
190             {
191 0     0 1   my $self = shift;
192 0           my $next = Location::Area::DoCoMo::iArea::Next->seek($self->{areaid},$self->{sub_areaid});
193            
194 0           my @nextareas = ();
195 0           foreach my $s (@$next)
196             {
197 0           $s =~ s/\-//;
198 0           my $tmpobj = Location::Area::DoCoMo::iArea->create_iarea($s);
199 0           push (@nextareas,$tmpobj);
200             }
201 0 0         return wantarray() ? @nextareas : \@nextareas;
202             }
203            
204             ################################
205             # Get Location::GeoTool::Aura object of this area's aura
206            
207             sub get_aura
208             {
209 0     0 1   Location::GeoTool::Aura->create_vertex(map {$_[0]->$_} ('sw','se','nw','ne'));
  0            
210             }
211            
212             ################################
213             # Get Location::GeoTool object of center point of this area's aura
214            
215             sub get_center
216             {
217 0     0 1   $_[0]->get_aura->get_center;
218             }
219            
220             ################################
221             # For internal use: Get Location::GeoTool object of each vertex of area's aura
222            
223 0   0 0 0   sub sw{$_[0]->{'sw'} ||= Location::GeoTool->create_coord($_[0]->{"south"}/1000,$_[0]->{"west"}/1000,'tokyo','second')}
224 0   0 0 0   sub se{$_[0]->{'se'} ||= Location::GeoTool->create_coord($_[0]->{"south"}/1000,$_[0]->{"east"}/1000,'tokyo','second')}
225 0   0 0 0   sub nw{$_[0]->{'nw'} ||= Location::GeoTool->create_coord($_[0]->{"north"}/1000,$_[0]->{"west"}/1000,'tokyo','second')}
226 0   0 0 0   sub ne{$_[0]->{'ne'} ||= Location::GeoTool->create_coord($_[0]->{"north"}/1000,$_[0]->{"east"}/1000,'tokyo','second')}
227            
228             ################################################################
229             # Legacy #
230             ################################
231            
232 0     0 0   sub setArea{shift->create_iarea(@_)}
233 0     0 0   sub setCoordinate{shift->create_coord(@_)}
234 0     0 0   sub getNextArea{shift->get_nextarea(@_)}
235             sub getAura
236             {
237 0     0 0   my ($self,$usetokyo) = @_;
238 0           my $datum;
239 0 0         $datum = $usetokyo ? 'datum_tokyo' : 'datum_wgs84';
240            
241 0           return $self->get_aura->$datum->format_spacetag->array;
242             }
243            
244             1;
245             __END__