File Coverage

blib/lib/Geo/Coordinates/Transform.pm

Criterion	Covered	Total	%
statement	73	79	92.4
branch	14	18	77.7
condition	4	9	44.4
subroutine	13	13	100.0
pod	0	1	0.0
total	104	120	86.6

package Geo::Coordinates::Transform;
#
# Troxel
# Thu Apr  1 10:31:35 2010
#
# Geo::Coordinates::Transform - Transform to/from various lat/long formats in a list oriented way.
#

use strict;
use warnings;
use diagnostics;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use Data::Dumper;

use vars qw($AUTOLOAD);

$VERSION     = '0.10';
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = ();

sub new
{
  my $caller = shift;

  # In case someone wants to sub-class
  my $caller_is_obj  = ref($caller);
  my $class = $caller_is_obj || $caller;

  # Passing reference or hash
  my %arg_hsh;
  if ( ref($_[0]) eq "HASH" ) { %arg_hsh = %{ shift @_ } }
  else                        { %arg_hsh = @_ }

  # The object data structure
  my $self = bless {
                        'dd_fmt' => $arg_hsh{dd_fmt} || '%3.7f',
                        'dm_fmt' => $arg_hsh{dm_fmt} || '%3.5f',
                        'ds_fmt' => $arg_hsh{ds_fmt} || '%3.5f',
                      }, $class;

  return $self;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - -
# Use Autoload to wrap a common loop and validation
# around input for the three transform functoins.
# - - - - - - - - - - - - - - - - - - - - - - - - - -
sub AUTOLOAD
{
 my $self = shift @_;
 my $lst_ref = shift @_;

 my ($func_ptr) = $AUTOLOAD =~ /.*::(.*)$/;
 $func_ptr = "_$func_ptr";

 # Act on only on resident functions
 unless( grep { $_ eq $func_ptr } qw( _cnv_to_dd _cnv_to_ddm _cnv_to_dms ) ) { return }

 # Validate input
 if ( ref $lst_ref ne 'ARRAY' ) { die "Array reference is expected as input" }

 my @ll_out_lst;
 foreach my $ll ( @{$lst_ref} )
 {
    if ( $ll =~ /([^-+\s\d\.]+)/ )
	{
	    push @ll_out_lst, 'NaN';
		warn "Illegal char in $ll";
   	}
	else
	{
        no strict 'refs';
		push @ll_out_lst, $self->${func_ptr}($ll);
	}
 }

 return \@ll_out_lst;
}

# - - - - - - - -
sub _cnv_to_ddm
{
   my $self = shift @_;
   my $in = shift @_;

   $in = $self->_cnv_to_dd($in);

   my $deg = int($in);
   my $dm = abs($in - $deg) * 60;

   return sprintf("%d $self->{'dm_fmt'}",$deg, $dm);
}

# - - - - - - - -
sub _cnv_to_dms
{
   my $self = shift @_;
   my $in = shift @_;

   $in = $self->_cnv_to_dd($in);

   my $deg = int($in);
   my $dm = abs($in - $deg) * 60;

   my $mm = int($dm);
   my $ss = abs($mm - $dm) * 60;

   return sprintf("%d %d $self->{'ds_fmt'}",$deg, $mm, $ss);
}

# - - - - - - - -
sub _cnv_to_dd
{
   my $self = shift @_;
   my $in = shift @_;

   my $sign;
   if ($in =~ s/([-]+)//) { $sign = $1; }

   my $dd = $in;
   if ( $in =~ /([\d+-]+)\s+(\d+)\s+([\d\.]+)/ )   # -dd dd dd
   {
      $dd = $1 + $2/60 + $3/3600;
   }
   elsif ( $in =~ /([\d+-]+)\s+(\d+[\d\.]+)/ ) # -dd dd.ddd
   {
      $dd = $1 + $2/60;
   }

   if ($sign ) { $dd = -1 * $dd }
   if ( (caller(1))[3] !~ /_cnv_to/ ) { $dd = sprintf("$self->{'dd_fmt'}",$dd);}

   return $dd;
}


1;

__END__