package Geo::Coordinates::Converter; use strict; use warnings; use base qw( Class::Accessor::Fast ); __PACKAGE__->mk_accessors(qw/ source current /); our $VERSION = '0.04'; use Carp; use String::CamelCase qw( camelize ); use UNIVERSAL::require; use Geo::Coordinates::Converter::Point; our $DEFAULT_CONVERTER = 'Geo::Coordinates::Converter::Datum'; our $DEFAULT_FORMAT = [qw/ Degree Dms /]; our $DEFAULT_INETRNAL_FORMAT = 'degree'; sub add_default_formats { my($class, @formats) = @_; my %default_formats = map { $_ => 1 } @{ $DEFAULT_FORMAT }, @formats; $DEFAULT_FORMAT = [ keys %default_formats ]; } sub new { my($class, %opt) = @_; my $converter = delete $opt{converter} || $DEFAULT_CONVERTER; unless (ref $converter) { $converter->require or die $@; $converter = $converter->new unless ref $converter; } my $internal_format = delete $opt{internal_format} || $DEFAULT_INETRNAL_FORMAT; my $formats = delete $opt{formats}; my $source = delete $opt{point} || Geo::Coordinates::Converter::Point->new(\%opt); my $self = bless { source => $source, formats => {}, converter => $converter, internal_format => $internal_format, }, $class; my @plugins = @{ $DEFAULT_FORMAT }; push @plugins, @{ $formats } if ref $formats eq 'ARRAY'; for my $plugin (@plugins) { $self->load_format($plugin); } $self->format_detect($self->source) unless $source->format; $self->normaraiz($self->source); $self->reset; $self; } sub load_format { my($self, $format) = @_; unless (ref $format) { if ($format =~ s/^\+//) { $format->require or die $@; } else { my $name = $format; $format = sprintf '%s::Format::%s', ref $self, camelize($name); $format->require or die $@; } $format = $format->new; } $self->formats($format->name, $format); } sub formats { my($self, $format, $plugin) = @_; $self->{formats}->{$format} = $plugin if $plugin; wantarray ? keys %{ $self->{formats} } : $self->{formats}->{$format}; } sub format_detect { my($self, $point) = @_; for my $format ($self->formats) { my $name = $self->formats($format)->detect($point); next unless $name; $point->format($name); last; } $point->format; } sub normaraiz { my($self, $point) = @_; $self->formats($point->format)->normaraiz($point); $point; } sub convert { my($self, @opt) = @_; return $self->point unless @opt; my $point = $self->source->clone; my $format = $point->format; $self->format($self->{internal_format}, $point); for my $type (@opt) { if ($self->formats($type)) { $format = $type unless $format eq $type; } else { eval { $self->datum($type, $point) }; croak "It dosen't correspond to the $type format/datum: $@" if $@; } } $self->format($format, $point); $point->$_( $self->$_($point) ) for qw/ lat lng /; $self->current($point->clone); } for my $meth (qw/ lat lng /) { no strict 'refs'; *{__PACKAGE__ . "::$meth"} = sub { my $self = shift; my $point = shift || $self->current; $self->formats($point->format)->round($point->$meth); }; } sub height { my $self = shift; my $point = shift || $self->current; $point->height; } sub datum { my $self = shift; if (my $datum = shift) { my $point = shift || $self->current; return $self if $point->datum eq $datum; my $format = $point->format; $self->format($self->{internal_format}, $point); $self->{converter}->convert($point => $datum); $self->format($format, $point); return $self; } else { return $self->current->datum; } } sub format { my $self = shift; if (my $fmt = shift) { croak "It dosen't correspond to the $fmt format" unless $self->formats($fmt); my $point = shift || $self->current; return $self if $point->format eq $fmt; $self->formats($point->format)->to($point); $self->formats($fmt)->from($point); $point->format($fmt); return $self; } else { return $self->current->format; } } sub round { my($self, $point) = @_; my $fmt = $self->formats($point->format); $point->$_($fmt->round($point->$_)) for (qw/ lat lng /); $point; } sub point { my($self, $point) = @_; $point ||= $self->current; $self->round($point->clone); } sub reset { my $self = shift; $self->current($self->source->clone); $self; } 1; __END__ =head1 NAME Geo::Coordinates::Converter - simple converter of geo coordinates =head1 SYNOPSIS use strict; use warnings; use Geo::Coordinates::Converter; my $geo = Geo::Coordinates::Converter->new( lat => '35.65580', lng => '139.65580', datum => 'wgs84' ); my $point = $geo->convert( dms => 'tokyo' ); print $point->lat; print $point->lng; print $point->datum; print $point->format; my $clone = $point->clone; my $geo2 = Geo::Coordinates::Converter->new( point => $clone ); my $point2 = $geo->convert( degree => 'wgs84' ); print $point2->lat; print $point2->lng; print $point2->datum; print $point2->format; =head1 DESCRIPTION the format and datum of geo coordinates are simply converted. when it is insufficient in the coordinate system and the format of the standard, it is possible to add it easily. =head1 CONSTRUCTOR =over 4 =item new my $geo = Geo::Coordinates::Converter->new( lat => '35.65580', lng => '139.65580', datum => 'wgs84' ); my $geo = Geo::Coordinates::Converter->new( point => $point ); =back =head2 Options =over 8 =item lat set to latitude =item lng set to longitude =item point set to L object. when this is set, neither 'lat' and 'lng' and 'datum' and 'format' options are necessary having. =item datum set to datum =item format set to format. it is detected automatically. =item converter set to converter object. L can be used by default, and other conversion classes also use it. =item formats the object of the format is set by the ARRAY reference when using it excluding the formatter of default. =item internal_format the specification format is set internally. default is degree. when it dose not like on internal format when datum is customized, it use it. =back =head1 METHODS =over 4 =item convert the geometric transformation is done. after it converts it, L object it returned. # Examples: my $point = $geo->convert( grs80 => 'degree' ); my $point = $geo->convert( tokyo => 'dms' ); my $point = $geo->convert( dms => 'wgs84' ); my $point = $geo->convert('wgs84'); my $point = $geo->convert('degree'); =back =head1 AUTHOR Kazuhiro Osawa Eko@yappo.ne.jpE =head1 SEE ALSO L, L, L =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut