1package Geo::Coordinates::Converter; 2use strict; 3use warnings; 4use Class::Accessor::Lite ( 5 rw => [qw/ source current /], 6); 7 8use 5.008001; 9 10our $VERSION = '0.13'; 11 12use Carp; 13use String::CamelCase qw( camelize ); 14use Module::Load (); 15 16use Geo::Coordinates::Converter::Point; 17 18our $DEFAULT_CONVERTER = 'Geo::Coordinates::Converter::Datum'; 19our $DEFAULT_FORMAT = [qw/ Degree Dms Milliseconds ISO6709 /]; 20our $DEFAULT_INETRNAL_FORMAT = 'degree'; 21 22sub add_default_formats { 23 my($class, @formats) = @_; 24 my %default_formats = map { $_ => 1 } @{ $DEFAULT_FORMAT }, @formats; 25 $DEFAULT_FORMAT = [ keys %default_formats ]; 26} 27 28sub new { 29 my($class, %opt) = @_; 30 31 my $converter = delete $opt{converter} || $DEFAULT_CONVERTER; 32 unless (ref $converter) { 33 Module::Load::load($converter); 34 $converter = $converter->new unless ref $converter; 35 } 36 37 my $internal_format = delete $opt{internal_format} || $DEFAULT_INETRNAL_FORMAT; 38 my $formats = delete $opt{formats}; 39 my $source = delete $opt{point} || Geo::Coordinates::Converter::Point->new(\%opt); 40 41 my $self = bless { 42 source => $source, 43 formats => {}, 44 converter => $converter, 45 internal_format => $internal_format, 46 }, $class; 47 48 my @plugins = @{ $DEFAULT_FORMAT }; 49 push @plugins, @{ $formats } if ref $formats eq 'ARRAY'; 50 for my $plugin (@plugins) { 51 $self->load_format($plugin); 52 } 53 54 $self->format_detect($self->source) unless $source->format; 55 $self->normalize($self->source); 56 $self->reset; 57 58 $self; 59} 60 61sub load_format { 62 my($self, $format) = @_; 63 64 unless (ref $format) { 65 if ($format =~ s/^\+//) { 66 Module::Load::load($format); 67 } else { 68 my $name = $format; 69 $format = sprintf '%s::Format::%s', ref $self, camelize($name); 70 Module::Load::load($format); 71 } 72 $format = $format->new; 73 } 74 $self->formats($format->name, $format); 75} 76 77sub formats { 78 my($self, $format, $plugin) = @_; 79 $self->{formats}->{$format} = $plugin if $plugin; 80 wantarray ? keys %{ $self->{formats} } : $self->{formats}->{$format}; 81} 82 83sub format_detect { 84 my($self, $point) = @_; 85 86 for my $format ($self->formats) { 87 my $name = $self->formats($format)->detect($point); 88 next unless $name; 89 $point->format($name); 90 last; 91 } 92 $point->format; 93} 94 95sub normaraiz { goto &normalize; } # alias for backward compatibility. 96sub normalize { 97 my($self, $point) = @_; 98 $self->formats($point->format)->normalize($point); 99 $point; 100} 101 102sub convert { 103 my($self, @opt) = @_; 104 return $self->point unless @opt; 105 106 my $point = $self->source->clone; 107 my $format = $point->format; 108 $self->format($self->{internal_format}, $point); 109 for my $type (@opt) { 110 if ($self->formats($type)) { 111 $format = $type unless $format eq $type; 112 } else { 113 eval { $self->datum($type, $point) }; 114 croak "It dosen't correspond to the $type format/datum: $@" if $@; 115 } 116 } 117 $self->format($format, $point); 118 119 $point->$_( $self->$_($point) ) for qw/ lat lng /; 120 $self->current($point->clone); 121} 122 123for my $meth (qw/ lat lng /) { 124 no strict 'refs'; 125 *{__PACKAGE__ . "::$meth"} = sub { 126 my $self = shift; 127 my $point = shift || $self->current; 128 $self->formats($point->format)->round($point->$meth); 129 }; 130} 131sub height { 132 my $self = shift; 133 my $point = shift || $self->current; 134 $point->height; 135} 136 137sub datum { 138 my $self = shift; 139 140 if (my $datum = shift) { 141 my $point = shift || $self->current; 142 return $self if $point->datum eq $datum; 143 144 my $format = $point->format; 145 $self->format($self->{internal_format}, $point); 146 $self->{converter}->convert($point => $datum); 147 $self->format($format, $point); 148 149 return $self; 150 } else { 151 return $self->current->datum; 152 } 153} 154 155sub format { 156 my $self = shift; 157 158 if (my $fmt = shift) { 159 croak "It dosen't correspond to the $fmt format" unless $self->formats($fmt); 160 my $point = shift || $self->current; 161 return $self if $point->format eq $fmt; 162 163 $self->formats($point->format)->to($point); 164 $self->formats($fmt)->from($point); 165 $point->format($fmt); 166 167 return $self; 168 } else { 169 return $self->current->format; 170 } 171} 172 173sub round { 174 my($self, $point) = @_; 175 my $fmt = $self->formats($point->format); 176 $point->$_($fmt->round($point->$_)) for (qw/ lat lng /); 177 $point; 178} 179 180sub point { 181 my($self, $point) = @_; 182 $point ||= $self->current; 183 $self->round($point->clone); 184} 185 186sub reset { 187 my $self = shift; 188 $self->current($self->source->clone); 189 $self; 190} 191 1921; 193 194__END__ 195 196=head1 NAME 197 198Geo::Coordinates::Converter - simple converter of geo coordinates 199 200=head1 SYNOPSIS 201 202 use strict; 203 use warnings; 204 205 use Geo::Coordinates::Converter; 206 207 my $geo = Geo::Coordinates::Converter->new( lat => '35.65580', lng => '139.65580', datum => 'wgs84' ); 208 my $point = $geo->convert( dms => 'tokyo' ); 209 print $point->lat; 210 print $point->lng; 211 print $point->datum; 212 print $point->format; 213 214 my $clone = $point->clone; 215 my $geo2 = Geo::Coordinates::Converter->new( point => $clone ); 216 my $point2 = $geo->convert( degree => 'wgs84' ); 217 print $point2->lat; 218 print $point2->lng; 219 print $point2->datum; 220 print $point2->format; 221 222can you use milliseconds format 223 224 my $geo = Geo::Coordinates::Converter->new( lat => -128064218, lng => 502629380 ); 225 $geo->format('degree'); 226 is($geo->lat, -35.573394); 227 is($geo->lng, 139.619272); 228 229=head1 DESCRIPTION 230 231the format and datum of geo coordinates are simply converted. 232when it is insufficient in the coordinate system and the format of the standard, it is possible to add it easily. 233 234=head1 CONSTRUCTOR 235 236=over 4 237 238=item new 239 240 my $geo = Geo::Coordinates::Converter->new( lat => '35.65580', lng => '139.65580', datum => 'wgs84' ); 241 my $geo = Geo::Coordinates::Converter->new( point => $point ); 242 243=back 244 245=head2 Options 246 247=over 8 248 249=item lat 250 251set to latitude 252 253=item lng 254 255set to longitude 256 257=item point 258 259set to L<Geo::Coordinates::Converter::Point> object. 260 261when this is set, neither 'lat' and 'lng' and 'datum' and 'format' options are necessary having. 262 263=item datum 264 265set to datum 266 267=item format 268 269set to format. 270it is detected automatically. 271 272=item converter 273 274set to converter object. 275L<Geo::Coordinates::Converter::Datum> can be used by default, and other conversion classes also use it. 276 277=item formats 278 279the object of the format is set by the ARRAY reference when using it excluding the formatter of default. 280 281=item internal_format 282 283the specification format is set internally. default is degree. 284when it dose not like on internal format when datum is customized, it use it. 285 286=back 287 288=head1 METHODS 289 290=over 4 291 292=item convert 293 294the geometric transformation is done. 295after it converts it, L<Geo::Coordinates::Converter::Point> object it returned. 296 297 # Examples: 298 my $point = $geo->convert( grs80 => 'degree' ); 299 my $point = $geo->convert( tokyo => 'dms' ); 300 my $point = $geo->convert( dms => 'wgs84' ); 301 my $point = $geo->convert('wgs84'); 302 my $point = $geo->convert('degree'); 303 304=back 305 306=head1 AUTHOR 307 308Kazuhiro Osawa E<lt>yappo {at} shibuya {dot} plE<gt> 309 310=head1 SEE ALSO 311 312L<Geo::Coordinates::Converter::Point>, L<Geo::Coordinates::Converter::Format>, L<Geo::Coordinates::Converter::Datum> 313 314=head1 LICENSE 315 316This library is free software; you can redistribute it and/or modify 317it under the same terms as Perl itself. 318 319=cut 320 321