File Coverage

blib/lib/Geo/What3Words.pm

Criterion	Covered	Total	%
statement	78	105	74.2
branch	9	18	50.0
condition	9	29	31.0
subroutine	17	22	77.2
pod	8	9	88.8
total	121	183	66.1

# ABSTRACT: turn WGS84 coordinates into three word addresses and vice-versa using what3words.com HTTPS API

package Geo::What3Words;
$Geo::What3Words::VERSION = '2.1.6';
use strict;
use warnings;
use Cpanel::JSON::XS;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
use Encode qw( decode_utf8 );
use HTTP::Tiny;
use Net::Ping;
use Net::Ping::External;
use Ref::Util qw( is_hashref is_coderef );
use URI;

my $JSONXS = Cpanel::JSON::XS->new->allow_nonref(1);




sub new {
  my ($class, %params) = @_;

  my $self = {};
  $self->{api_endpoint}     = $params{api_endpoint} || 'https://api.what3words.com/v2/';
  $self->{key}              = $params{key}      || die "API key not set";
  $self->{language}         = $params{language};
  $self->{logging}          = $params{logging};

  ## _ua is used for testing. But could also be used to
  ## set proxies or such
  $self->{ua} = $params{ua} || HTTP::Tiny->new;

  my $version  = $Geo::What3Words::VERSION || '';
  $self->{ua}->agent("Perl Geo::What3Words $version");

  return bless($self,$class);
}


sub ping {
  my $self = shift;

  ## http://example.com/some/path => example.com
  ## also works with IP addresses
  my $host = URI->new($self->{api_endpoint})->host;

  $self->_log("pinging $host...");

  my $netping = Net::Ping->new('external');
  my $res = $netping->ping($host);

  $self->_log($res ? 'available' : 'unavailable');

  return $res;
}


sub words2pos {
  my ($self, @params) = @_;

  my $res = $self->words_to_position(@params);
  if ( $res && is_hashref($res) && exists($res->{geometry}) ){
      return $res->{geometry}->{lat} . ',' . $res->{geometry}->{lng};
  }
  return;
}



sub pos2words {
  my ($self, @params) = @_;
  my $res = $self->position_to_words(@params);
  if ( $res && is_hashref($res) && exists($res->{words}) ){
      return $res->{words};
  }
  return;
}


sub valid_words_format {
  my $self = shift;
  my $words = shift;

  ## Translating the PHP regular expression w3w uses in their
  ## documentation
  ## http://perldoc.perl.org/perlunicode.html#Unicode-Character-Properties
  ## http://php.net/manual/en/reference.pcre.pattern.differences.php
  return 0 unless $words;
  return 1 if ($words =~ m/^(\p{Lower}+)\.(\p{Lower}+)\.(\p{Lower}+)$/ );
  return 0;
}


sub words_to_position {
  my $self = shift;
  my $words = shift;
  my $language = shift || $self->{language};

  return $self->_query_remote_api('forward', {addr => $words, lang => $language });
}


sub position_to_words {
  my $self = shift;
  my $position = shift;
  my $language = shift || $self->{language};

  return $self->_query_remote_api('reverse', {coords => $position, lang => $language });
}


sub get_languages {
  my $self = shift;
  my $position = shift;
  return $self->_query_remote_api('languages');
}

sub oneword_available {
  warn 'deprecated method: oneword_available';
  return;
}

sub _query_remote_api {
  my $self        = shift;
  my $method_name = shift;
  my $rh_params   = shift || {};

  my $rh_fields = {
      a      => 1,
      key    => $self->{key},
      format => 'json',
      %$rh_params
  };

  foreach my $key (keys %$rh_fields){
      delete $rh_fields->{$key} if (!defined($rh_fields->{$key}));
  }

  my $uri = URI->new($self->{api_endpoint} . $method_name);
  $uri->query_form( $rh_fields );
  my $url = $uri->as_string;

  $self->_log("GET $url");
  my $response = $self->{ua}->get($url);

  if ( ! $response->{success}) {
    warn "got failed response from $url: " . $response->{status};
    $self->_log("got failed response from $url: " . $response->{status});
    return;
  }

  my $json = $response->{content};
  $json = decode_utf8($json);
  $self->_log($json);

  return $JSONXS->decode($json);
}

sub _log {
  my $self    = shift;
  my $message = shift;
  return unless $self->{logging};

  if ( is_coderef($self->{logging}) ){
      my $lc = $self->{logging};
      &$lc("Geo::What3Words -- " . $message);
  }
  else {
      print "Geo::What3Words -- " . $message . "\n";
  }
  return;
}


1;

__END__