line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Geo::Coordinates::Converter::Format::ISO6709; |
2
|
6
|
|
|
6
|
|
5185
|
use strict; |
|
6
|
|
|
|
|
46
|
|
|
6
|
|
|
|
|
246
|
|
3
|
6
|
|
|
6
|
|
33
|
use warnings; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
189
|
|
4
|
6
|
|
|
6
|
|
27
|
use parent 'Geo::Coordinates::Converter::Format'; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
40
|
|
5
|
|
|
|
|
|
|
|
6
|
6
|
|
|
6
|
|
348
|
use POSIX; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
39
|
|
7
|
|
|
|
|
|
|
|
8
|
6
|
|
|
6
|
|
29422
|
use Geo::Coordinates::Converter::Format::Dms; |
|
6
|
|
|
|
|
209
|
|
|
6
|
|
|
|
|
10710
|
|
9
|
|
|
|
|
|
|
|
10
|
81
|
|
|
81
|
0
|
307
|
sub name { 'iso6709' } |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub detect { |
13
|
43
|
|
|
43
|
0
|
83
|
my($self, $point) = @_; |
14
|
43
|
100
|
|
|
|
1588
|
return unless $point->isa('Geo::Coordinates::Converter::Point::ISO6709'); |
15
|
13
|
50
|
|
|
|
31
|
return unless $point->iso6709 =~ m{\A[+-][0-9]+(?:\.[0-9]+)?[+-][0-9]+(?:\.[0-9]+)?(?:[+-][0-9]+(?:\.[0-9]+)?)?(?:CRS[_A-Z0-9]+)?/\z}i; |
16
|
13
|
|
|
|
|
128
|
return $self->name; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub to { |
20
|
13
|
|
|
13
|
0
|
16
|
my($self, $point) = @_; |
21
|
|
|
|
|
|
|
|
22
|
13
|
100
|
|
|
|
30
|
if (my($lat_prefix, $lat, $lng_prefix, $lng, $height, $crs) = $point->iso6709 =~ |
23
|
|
|
|
|
|
|
m{\A([+-])([0-9]{6}(?:\.[0-9]+)?)([+-])([0-9]{7}(?:\.[0-9]+)?)([+-][0-9]+(?:\.[0-9]+)?)?(?:CRS([_A-Z0-9]+))?/\z}i) { |
24
|
|
|
|
|
|
|
# dms |
25
|
4
|
|
|
|
|
52
|
my($lat_d, $lat_m, $lat_s) = $lat =~ /^(..)(..)(.+)$/; |
26
|
4
|
|
|
|
|
15
|
my($lng_d, $lng_m, $lng_s) = $lng =~ /^(...)(..)(.+)$/; |
27
|
|
|
|
|
|
|
|
28
|
4
|
50
|
|
|
|
12
|
$lat_prefix = '' unless $lat_prefix eq '-'; |
29
|
4
|
50
|
|
|
|
8
|
$lng_prefix = '' unless $lng_prefix eq '-'; |
30
|
4
|
|
|
|
|
116
|
$point->lat( $lat_prefix . ($lat_d + ($lat_m / 60) + ($lat_s / 3600)) ); |
31
|
4
|
|
|
|
|
43
|
$point->lng( $lng_prefix . ($lng_d + ($lng_m / 60) + ($lng_s / 3600)) ); |
32
|
4
|
100
|
66
|
|
|
33
|
$point->height($height + 0) if $height && $height != 0; |
33
|
4
|
|
|
|
|
12
|
$point->format('wgs84'); |
34
|
4
|
|
|
|
|
24
|
return $point; |
35
|
|
|
|
|
|
|
} |
36
|
9
|
100
|
|
|
|
77
|
if (my($lat_prefix, $lat, $lng_prefix, $lng, $height, $crs) = $point->iso6709 =~ |
37
|
|
|
|
|
|
|
m{\A([+-])([0-9]{4}(?:\.[0-9]+)?)([+-])([0-9]{5}(?:\.[0-9]+)?)([+-][0-9]+(?:\.[0-9]+)?)?(?:CRS([_A-Z0-9]+))?/\z}i) { |
38
|
|
|
|
|
|
|
# dm |
39
|
3
|
|
|
|
|
44
|
my($lat_d, $lat_m, $lat_f) = $lat =~ /^(..)(.+)(?:\.(.+))?$/; |
40
|
3
|
|
|
|
|
12
|
my($lng_d, $lng_m, $lng_f) = $lng =~ /^(...)(.+)(?:\.(.+))?$/; |
41
|
|
|
|
|
|
|
|
42
|
3
|
50
|
|
|
|
10
|
$lat_prefix = '' unless $lat_prefix eq '-'; |
43
|
3
|
50
|
|
|
|
7
|
$lng_prefix = '' unless $lng_prefix eq '-'; |
44
|
3
|
|
50
|
|
|
15
|
$lat_f ||= 0; |
45
|
3
|
|
50
|
|
|
11
|
$lng_f ||= 0; |
46
|
3
|
|
|
|
|
8
|
$lat_f = "0.$lat_f" * 1; |
47
|
3
|
|
|
|
|
6
|
$lng_f = "0.$lng_f" * 1; |
48
|
3
|
|
|
|
|
32
|
$point->lat( $lat_prefix . ($lat_d + ($lat_m / 60) + ($lat_f / 60)) ); |
49
|
3
|
|
|
|
|
35
|
$point->lng( $lng_prefix . ($lng_d + ($lng_m / 60) + ($lng_f / 60)) ); |
50
|
3
|
100
|
66
|
|
|
29
|
$point->height($height + 0) if $height && $height != 0; |
51
|
3
|
|
|
|
|
13
|
$point->format('wgs84'); |
52
|
3
|
|
|
|
|
17
|
return $point; |
53
|
|
|
|
|
|
|
} |
54
|
6
|
50
|
|
|
|
46
|
if (my($lat_prefix, $lat, $lng_prefix, $lng, $height, $crs) = $point->iso6709 =~ |
55
|
|
|
|
|
|
|
m{\A([+-])([0-9]{2}(?:\.[0-9]+)?)([+-])([0-9]{3}(?:\.[0-9]+)?)([+-][0-9]+(?:\.[0-9]+)?)?(?:CRS([_A-Z0-9]+))?/\z}i) { |
56
|
|
|
|
|
|
|
# degree |
57
|
|
|
|
|
|
|
|
58
|
6
|
100
|
|
|
|
81
|
$lat_prefix = '' unless $lat_prefix eq '-'; |
59
|
6
|
50
|
|
|
|
15
|
$lng_prefix = '' unless $lng_prefix eq '-'; |
60
|
6
|
|
|
|
|
21
|
$point->lat( $lat_prefix . $lat ); |
61
|
6
|
|
|
|
|
38
|
$point->lng( $lng_prefix . $lng ); |
62
|
6
|
100
|
66
|
|
|
56
|
$point->height($height + 0) if $height && $height != 0; |
63
|
6
|
|
|
|
|
26
|
$point->format('wgs84'); |
64
|
6
|
|
|
|
|
32
|
return $point; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
0
|
return $point; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub from { |
71
|
7
|
|
|
7
|
0
|
12
|
my($self, $point) = @_; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# re-bless to geohash point package |
74
|
|
|
|
|
|
|
# because i want ->geohash method |
75
|
7
|
50
|
|
|
|
121
|
bless $point, 'Geo::Coordinates::Converter::Point::ISO6709' unless $point->isa(__PACKAGE__); |
76
|
|
|
|
|
|
|
|
77
|
7
|
|
|
|
|
18
|
my $lat = $point->lat; |
78
|
7
|
|
|
|
|
40
|
my $lng = $point->lng; |
79
|
7
|
|
|
|
|
27
|
my $parts = 2; |
80
|
7
|
100
|
|
|
|
22
|
if ($point->format eq 'dms') { |
81
|
4
|
|
|
|
|
31
|
$point = Geo::Coordinates::Converter::Format::Dms->from($point); |
82
|
4
|
|
|
|
|
13
|
$lat = $point->lat; |
83
|
4
|
|
|
|
|
21
|
$lng = $point->lng; |
84
|
4
|
|
|
|
|
15
|
$parts = 4; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
7
|
|
|
|
|
20
|
$lat = do { |
88
|
7
|
|
|
|
|
24
|
my @list = split /\./, $lat; |
89
|
7
|
|
|
|
|
22
|
$list[0] = sprintf '%02d', $list[0]; |
90
|
7
|
50
|
|
|
|
23
|
$list[-1] = ".$list[-1]" if @list == $parts; |
91
|
7
|
100
|
|
|
|
23
|
unshift @list, ($list[0] >= 0 ? '+' : ''); |
92
|
7
|
|
|
|
|
21
|
join '', @list; |
93
|
|
|
|
|
|
|
}; |
94
|
7
|
|
|
|
|
9
|
$lng = do { |
95
|
7
|
|
|
|
|
19
|
my @list = split /\./, $lng; |
96
|
7
|
|
|
|
|
20
|
$list[0] = sprintf '%03d', $list[0]; |
97
|
7
|
50
|
|
|
|
21
|
$list[-1] = ".$list[-1]" if @list == $parts; |
98
|
7
|
100
|
|
|
|
19
|
unshift @list, ($list[0] >= 0 ? '+' : ''); |
99
|
7
|
|
|
|
|
20
|
join '', @list; |
100
|
|
|
|
|
|
|
}; |
101
|
7
|
|
|
|
|
21
|
$lat =~ s/\.?0+$//; |
102
|
7
|
|
|
|
|
22
|
$lng =~ s/\.?0+$//; |
103
|
|
|
|
|
|
|
|
104
|
7
|
|
|
|
|
14
|
my $iso6709 = "$lat$lng"; |
105
|
7
|
100
|
|
|
|
17
|
if ($point->height > 0) { |
|
|
100
|
|
|
|
|
|
106
|
1
|
|
|
|
|
9
|
$iso6709 .= '+' . $point->height; |
107
|
|
|
|
|
|
|
} elsif ($point->height < 0) { |
108
|
2
|
|
|
|
|
23
|
$iso6709 .= $point->height; |
109
|
|
|
|
|
|
|
} |
110
|
7
|
|
|
|
|
70
|
$point->iso6709("$iso6709/"); |
111
|
7
|
|
|
|
|
43
|
$point->lat(undef); |
112
|
7
|
|
|
|
|
38
|
$point->lng(undef); |
113
|
7
|
|
|
|
|
37
|
$point->height(undef); |
114
|
|
|
|
|
|
|
|
115
|
7
|
|
|
|
|
36
|
$point; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
1; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head1 NAME |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Geo::Coordinates::Converter::Format::ISO6709 - ISO6709 support for Geo::Coordinates::Converter |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 SYNOPSIS |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
use Geo::Coordinates::Converter; |
127
|
|
|
|
|
|
|
use Geo::Coordinates::Converter::Point::ISO6709; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
my $geo = Geo::Coordinates::Converter->new( |
130
|
|
|
|
|
|
|
point => Geo::Coordinates::Converter::Point::ISO6709->new({ |
131
|
|
|
|
|
|
|
iso6709 => '+35.36083+138.72750+3776CRSWGS_84/', |
132
|
|
|
|
|
|
|
}), |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
$geo->format('dms'); |
135
|
|
|
|
|
|
|
say $geo->lat; # 35.21.38.988 |
136
|
|
|
|
|
|
|
say $geo->lon; # 138.43.39.000 |
137
|
|
|
|
|
|
|
say $geo->height; # 3776 |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
lat/lng to ISO6709 |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $geo = Geo::Coordinates::Converter->new( |
142
|
|
|
|
|
|
|
lat => '35.360833', lng => '138.727500', |
143
|
|
|
|
|
|
|
); |
144
|
|
|
|
|
|
|
$geo->format('iso6709'); |
145
|
|
|
|
|
|
|
say $geo->point->geohash; # +35.360833+138.7275/ |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 DESCRIPTION |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Geo::Coordinates::Converter::Format::ISO6709 is encodes and decodes ISO6709 format. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head1 AUTHOR |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Kazuhiro Osawa Eyappo {at} shibuya {dot} plE |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head1 SEE ALSO |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
L, |
158
|
|
|
|
|
|
|
L, |
159
|
|
|
|
|
|
|
L |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 LICENSE |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
164
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |