File Coverage

blib/lib/WebService/Google/Language.pm

Criterion	Covered	Total	%
statement	131	135	97.0
branch	52	62	83.8
condition	18	25	72.0
subroutine	29	29	100.0
pod	7	7	100.0
total	237	258	91.8

package WebService::Google::Language;

use 5.006;

use strict;
use warnings;

our $VERSION = '0.14';

use Carp ();
use JSON 2.0 ();
use LWP::UserAgent;
use URI;

use constant GOOGLE_DETECT_URL    => 'http://ajax.googleapis.com/ajax/services/language/detect';
use constant GOOGLE_TRANSLATE_URL => 'http://ajax.googleapis.com/ajax/services/language/translate';
use constant API_VERSION          => '1.0';
use constant MAX_LENGTH           => 5000;
use constant URL_MAX_LENGTH       => 2073;



#
#  constructor
#

sub new {
  my $class = shift;
  my $self = bless {}, $class;

  unshift @_, 'referer' if @_ % 2;
  my %conf = @_;

  $self->referer(delete $conf{referer});

  for (qw'src dest key') {
    if (defined(my $value = delete $conf{$_})) {
      $self->{$_} = $value;
    }
  }

  for (qw'json ua') {
    if (defined(my $value = delete $conf{$_})) {
      $self->$_($value);
    }
  }
  unless ($self->json) {
    $self->json(JSON->new);
  }
  unless ($self->ua) {
    $conf{agent} = $class . ' ' . $class->VERSION
      unless defined $conf{agent};
    # respect proxy environment variables (reported by IZUT)
    $conf{env_proxy} = 1
      unless exists $conf{env_proxy};
    $self->ua(LWP::UserAgent->new(%conf));
  }

  return $self;
}



#
#  public methods
#

sub translate {
  my $self = shift;
  unshift @_, 'text' if @_ % 2;
  my %args = @_;
  my $src  = $args{src}  || $self->{src}  || '';
  my $dest = $args{dest} || $self->{dest} || 'en';
  return $self->_request($args{text}, $src . '|' . $dest);
}

sub detect {
  my $self = shift;
  unshift @_, 'text' if @_ % 2;
  my %args = @_;
  return $self->_request($args{text});
}

*detect_language = \&detect;

sub ping {
  my $self = shift;
  return $self->ua
    ->get( GOOGLE_TRANSLATE_URL, referer => $self->referer )
    ->is_success;
}



#
#  accessors
#

sub json {
  my $self = shift;
  if (@_) {
    my $json = shift;
    Carp::croak q{'json' requires an object based on 'JSON'}
      unless $json && $json->isa('JSON');
    $self->{json} = $json;
    return $self;
  }
  $self->{json};
}

sub referer {
  my $self = shift;
  if (@_) {
    my $referer = shift;
    unless (defined $referer && $referer =~ /\S/) {
      my $name    = q{'referer'};
      my $error   = 'requires a non-empty parameter';
      my $caller  = (caller(1))[3];
      Carp::croak $caller && $caller eq ref($self) . '::new'
        ? "Constructor $error $name"
        : "$name $error";
    }
    $self->{referer} = $referer;
    return $self;
  }
  $self->{referer};
}

sub ua {
  my $self = shift;
  if (@_) {
    my $ua = shift;
    Carp::croak q{'ua' requires an object based on 'LWP::UserAgent'}
      unless $ua && $ua->isa('LWP::UserAgent');
    $self->{ua} = $ua;
    return $self;
  }
  $self->{ua};
}



#
#  private methods and functions
#

sub _request {
  my ($self, $text, $langpair) = @_;
  if (defined $text && $text =~ /\S/) {
    _utf8_encode($text);
    if (length $text > MAX_LENGTH) {
      Carp::croak 'Google does not allow submission of text exceeding '
        . MAX_LENGTH . ' characters in length';
    }
  }
  else {
    return;
  }

  my ($uri, $response);
  my @param = ( v => API_VERSION );
  push @param, key => $self->{key} if defined $self->{key};
  if (defined $langpair) {
    $uri = URI->new(GOOGLE_TRANSLATE_URL);
    push @param, langpair => $langpair;
  }
  else {
    $uri = URI->new(GOOGLE_DETECT_URL);
  }
  push @param, q => $text;
  $uri->query_form(\@param);

  my $length = length $uri;
  if ($length > URL_MAX_LENGTH) {
    if (defined $langpair) {
      # POST only for translate
      $uri->query_form( [] );
      $response = $self->ua->post( $uri, \@param, referer => $self->referer );
    }
    else {
      # detect can't be POSTed
      Carp::croak "The length of the generated URL for this request is $length bytes and exceeds the maximum of "
        . URL_MAX_LENGTH . ' bytes. Shorten your parameters.';
    }
  }
  else {
    $response = $self->ua->get( $uri, referer => $self->referer );
  }

  if ($response->is_success) {
    my $result = eval { $self->json->decode($response->content) };
    if ($@) {
      Carp::croak "Couldn't parse response from '$uri': $@";
    }
    else {
      return bless $result, 'WebService::Google::Language::Result';
    }
  }
  else {
    Carp::croak "An HTTP error occured while getting '$uri': " . $response->status_line;
  }
}

sub _utf8_encode {
  if ($] < 5.007) {

    # on Perl 5.6 the JSON 2 module (JSON::PP56) provides the missing
    # utf8::encode function, but it seems to be broken
    # my own UTF8 encoder is tested on ActivePerl 5.6.1.638

    if (length $_[0] == do { use bytes; length $_[0] }) {
      $_[0] = pack 'U*', unpack 'C*', $_[0];
    }
  }
  else {
    utf8::encode($_[0]);
  }
}



#
#  convenience accessor methods to result hash
#

package WebService::Google::Language::Result;

sub error {
  $_[0]->{responseStatus} && $_[0]->{responseStatus} != 200
    ? { code    => $_[0]->{responseStatus},
        message => $_[0]->{responseDetails},
      }
    : undef
}

sub code { $_[0]->{responseStatus} }

sub message { $_[0]->{responseDetails} }

sub translation {
  $_[0]->{responseData} ? $_[0]->{responseData}{translatedText} : undef
}

sub language {
  $_[0]->{responseData}
    ? $_[0]->{responseData}{language} ||
      $_[0]->{responseData}{detectedSourceLanguage}
    : undef
}

sub is_reliable {
  $_[0]->{responseData} ? $_[0]->{responseData}{isReliable} : undef
}

sub confidence {
  $_[0]->{responseData} ? $_[0]->{responseData}{confidence} : undef
}



$VERSION = eval $VERSION;

__END__