File Coverage

blib/lib/I22r/Translate/Google.pm
Criterion Covered Total %
statement 57 165 34.5
branch 0 52 0.0
condition 0 29 0.0
subroutine 19 28 67.8
pod 1 5 20.0
total 77 279 27.6


line stmt bran cond sub pod time code
1             package I22r::Translate::Google;
2 3     3   32415 use Moose;
  3         651852  
  3         25  
3 3     3   21009 use MooseX::ClassAttribute;
  3         311078  
  3         18  
4 3     3   1022864 use I22r::Translate::Result;
  3         17  
  3         201  
5 3     3   39 use Carp;
  3         7  
  3         321  
6 3     3   3286 use Data::Dumper;
  3         24805  
  3         430  
7             with 'I22r::Translate::Backend';
8              
9             our $VERSION = '0.96';
10              
11             {
12             # code from REST::Google and REST::Google::Translate2 packages.
13             # REST::Google code is copyright 2008 by Eugen Sobchenko <ejs@cpan.org>
14             # and Sergey Sinkovskiy <glorybox@cpan.org>
15             #
16             # These distributions are on CPAN, but REST::Google::Translate2
17             # tests won't pass without an API key, and REST::Google tests
18             # won't pass because of an obsolete REST::Google::Translate
19             # package, so including these modules as dependencies would
20             # be a giant headache.
21              
22             package I22r::REST::Google;
23 3     3   28 use strict;
  3         6  
  3         108  
24 3     3   23 use warnings;
  3         6  
  3         160  
25 3     3   17 use Carp qw/carp croak/;
  3         5  
  3         174  
26 3     3   1765 use JSON::MaybeXS;
  3         16492  
  3         376  
27 3     3   2119 use HTTP::Request;
  3         66906  
  3         117  
28 3     3   2337 use LWP::UserAgent;
  3         66088  
  3         114  
29 3     3   27 use URI;
  3         3  
  3         189  
30             require Class::Data::Inheritable;
31             require Class::Accessor;
32 3     3   19 use base qw/Class::Data::Inheritable Class::Accessor/;
  3         5  
  3         2110  
33             __PACKAGE__->mk_classdata("http_referer");
34             __PACKAGE__->mk_classdata("service");
35             __PACKAGE__->mk_accessors(qw/responseDetails responseStatus/);
36 3     3   8050 use constant DEFAULT_ARGS => ( 'v' => '1.0', );
  3         7  
  3         281  
37 3     3   16 use constant DEFAULT_REFERER => 'http://example.com/';
  3         5  
  3         1540  
38             sub _get_args {
39 0     0     my $proto = shift;
40 0           my %args;
41 0 0         if ( scalar(@_) > 1 ) {
    0          
42 0 0         if ( @_ % 2 ) {
43 0           croak "odd number of parameters";
44             }
45 0           %args = @_;
46             } elsif ( ref $_[0] ) {
47 0 0         unless ( eval { local $SIG{'__DIE__'}; %{ $_[0] } || 1 } ) {
  0 0          
  0            
  0            
48 0           croak "not a hashref in args";
49             }
50 0           %args = %{ $_[0] };
  0            
51             } else {
52 0           %args = ( 'q' => shift );
53             }
54 0           return { $proto->DEFAULT_ARGS, %args };
55             }
56             sub new {
57 0     0     my $class = shift;
58 0           my $args = $class->_get_args(@_);
59 0 0         croak "request attempted without setting a service URL"
60             unless ( defined $class->service );
61 0           my $uri = URI->new( $class->service );
62 0           $uri->query_form( $args );
63 0 0         unless ( defined $class->http_referer ) {
64 0           carp "search attempted without setting a valid http referer header";
65 0           $class->http_referer( DEFAULT_REFERER );
66             }
67 0           my $request;
68 0           $request = HTTP::Request->new(
69             GET => $uri,
70             [ 'Referer', $class->http_referer ] );
71 0           my $ua = LWP::UserAgent->new();
72 0           $ua->env_proxy;
73 0           my $response = $ua->request( $request );
74 0 0         if (!$response->is_success) {
75 0           croak sprintf qq/HTTP request failed: %s/, $response->status_line;
76             }
77 0           my $content = $response->content;
78 0           my $json = JSON::MaybeXS->new(utf8 => 1);
79 0           my $self = $json->decode($content);
80 0           return bless $self, $class;
81             }
82 0     0     sub responseData { return $_[0]->{responseData} }
83             ##################################################################
84             package I22r::REST::Google::Translate;
85 3     3   20 use strict;
  3         5  
  3         75  
86 3     3   14 use warnings;
  3         6  
  3         170  
87 3     3   18 use base qw/Exporter I22r::REST::Google/;
  3         5  
  3         1912  
88             __PACKAGE__->service( 'https://www.googleapis.com/language/translate/v2' );
89             sub responseData {
90 0     0     my $self = shift;
91 0   0       my $rd = $self->{responseData} // $self->{data}{translations}[0];
92 0           return bless $rd, 'I22r::REST::Google::Data';
93             }
94             ##################################################################
95             package I22r::REST::Google::Data;
96             require Class::Accessor;
97 3     3   32 use base qw/Class::Accessor/;
  3         6  
  3         4042  
98             __PACKAGE__->mk_ro_accessors( qw/translatedText/ );
99             }
100              
101             our %remap = ( he => 'iw' );
102             our %unremap = ( iw => 'he' );
103             our @google_languages = qw(
104             af sq ar az eu bn be bg ca zh zh-CN zh-TW hr cs da nl en eo
105             et tl fi fr gl ka de el gu ht iw he hi hu is id ga it ja kn
106             ko la lv lt mk ms mt no fa pl pt ro ru sr sk sl es sw sv ta
107             te th tr uk ur vi cy yi
108             );
109              
110             sub BUILD {
111 0     0 0   my $self = shift;
112 0 0         $self->name('Google') unless $self->name;
113             }
114              
115             sub can_translate {
116 0     0 1   my ($self, $lang1, $lang2) = @_;
117 0 0         if ($lang1 eq $lang2) {
118 0           return 1;
119             }
120 0           my $langs = join(" ", @google_languages, values %remap);
121 0 0 0       return -1 unless " $langs " =~ / $lang1 / && " $langs " =~ / $lang2 /;
122              
123 0 0 0       if ($lang1 =~ /zh/ && $lang2 =~ /zh/) {
124             # assume translation between zh-CN and zh-TW is easy
125 0           return 0.9;
126             }
127              
128 0           return 0.4;
129             }
130              
131             sub get_translations {
132 0     0 0   my ($self, $req) = @_;
133 0 0         return unless $req->config("ENABLED");
134 0 0         return unless $self->network_available;
135 0           my $api_key = $req->config("API_KEY");
136 0 0         return unless $api_key;
137              
138 0 0         if (!$self->config("REFERER_SET")) {
139 0           $self->set_referer( $req->config("REFERER") );
140             }
141              
142              
143             # XXX - source encoding
144              
145 0           my %result;
146             my %untext;
147 0           my %text = %{$req->text};
  0            
148 0           while (my ($id,$text) = each %text) {
149 0           push @{$untext{$text}}, $id;
  0            
150             }
151              
152             # XXX - refactor candidate. Can we pass multiple &q=...
153             # params for efficiency
154              
155 0           my @text = keys %untext;
156 0           my @translated;
157              
158 0           while (@text) {
159 0 0         last if $req->timed_out;
160              
161 0           my @itext;
162 0           my $otext = shift @text;
163 0           my $uri = URI->new();
164 0           $uri->query_form( 'q' => [ @itext, $otext ] );
165 0           while ( length($uri) < 1500 ) {
166 0           push @itext, $otext;
167 0           $otext = shift @text;
168 0 0         last if !defined $otext;
169 0           $uri = URI->new();
170 0           $uri->query_form( 'q' => [ @itext, $otext ] );
171             }
172 0 0         if (defined $otext) {
173 0           unshift @text, $otext;
174             }
175              
176 0 0 0       if (@itext == 0 && @text > 0) {
177 0           carp "Can't perform translation on next element '$text[0]'. ",
178             "Content length would be ",length($uri);
179 0           last;
180             }
181              
182 0           eval {
183 0           my $res;
184 0           $res = eval { I22r::REST::Google::Translate->new(
185             'q' => [ @itext ],
186             'key' => $self->config->{API_KEY},
187             'source' => $remap{$req->src} // $req->src,
188 0   0       'target' => $remap{$req->dest} // $req->dest,
      0        
189             'v' => '2.0'
190             ) } ;
191              
192 0 0         if ($res) {
    0          
    0          
    0          
193 0           eval {
194             my @output = map {
195             $_->{translatedText}
196 0           } @{ $res->{data}{translations} };
  0            
  0            
197 0           for my $i (0 .. $#itext) {
198 0           my $ids = $untext{ $itext[$i] };
199 0           foreach my $id (@$ids) {
200             $req->results->{$id} = I22r::Translate::Result->new(
201             id => $id,
202             otext => $itext[$i],
203             olang => $unremap{ $req->src } // $req->src,
204 0   0       lang => $unremap{ $req->dest } // $req->dest,
      0        
205             text => $output[$i],
206             source => $self->name,
207             length => length($output[$i]),
208             time => time
209             );
210 0           push @translated, $id;
211             }
212             }
213            
214 0           $self->config->{_NETWORK_ERR} = 0;
215             };
216             } elsif ($@ =~ /connect to www.googleapis.com/) {
217 0 0         if (++$self->config->{_NETWORK_ERR} > 100) {
218 0           carp "network issues.";
219             # how to disable for 30-60 seconds?
220             }
221             } elsif ($@ =~ /HTTP response failed: 400/) {
222 0           local $, = " , ";
223 0           carp "Error in request, which had q => [ @itext ]";
224             } elsif ($@) {
225 0           carp $@;
226             }
227             };
228 0 0         if ($@) {
229 0           carp $@;
230             }
231             }
232 0           return @translated;
233             }
234              
235 0     0 0   sub network_available { !$ENV{NO_NETWORK} }
236              
237             sub set_referer {
238 0     0 0   my ($self, $referer) = @_;
239 0   0       $referer //= $self->config->{REFERER} // "http://just.doing.some.testing/";
      0        
240 0           I22r::REST::Google->http_referer( $referer );
241 0           $self->config->{_REFERER_SET} = 1;
242             }
243              
244             1;
245              
246             =head1 NAME
247              
248             I22r::Translate::Google - Google backend for I22r::Translate framework
249              
250             =head1 SYNOPSIS
251              
252             I22r::Translate->config(
253             'I22r::Translate::Google' => {
254             ENABLED => 1,
255             API_KEY => "your_required_API_key_goes_here",
256             REFERER => "http://mywebsite.com/"
257             }
258             );
259              
260             $translation = I22r::Translate->translate_string(
261             src => 'en', dest => 'es', text => 'hello world',
262             quality => { 'I22r::Translate::Google' => 2.0 } );
263              
264             =head1 DESCRIPTION
265              
266             Invokes Google's translation webservice to translate content
267             from one language to another.
268              
269             You instruct the L<I22r::Translate> package to use the
270             Google backend by passing a key-value pair to the
271             L<I22r::Translate::config|I22r::Translate/"config"> method
272             where the key is the string "C<I22r::Translate::Google>"
273             and the value is a hash reference with at least the following
274             key-value pairs:
275              
276             =over 4
277              
278             =item ENABLED => 0 | 1
279              
280             Must be set to a true value for the Google backend to be enabled.
281              
282             =item API_KEY => string
283              
284             An API key is required to use the Google Translate web service.
285             You can get an API key from L<https://code.google.com/apis/console>
286             (note: this is not a free service).
287             (other note: if you can't get an API key from the above URL, but
288             then you do figure out where to get one, L<let me know|mailto:mob@cpan.org>
289             or L<file a bug report|I22r::Translate/"SUPPORT"> and
290             I'll update these instructions).
291              
292             =back
293              
294             Configuration for the Google backend also recognizes these
295             options:
296              
297             =over 4
298              
299             =item REFERER => URL
300              
301             Sets a URL that will passed to the Google Translate service as
302             your application's referer. If not set, this package will set
303             the referer to C<http://just.doing.some.testing/>.
304              
305             =item timeout => integer
306              
307             Stops a translation job after a certain number of seconds have
308             passed.
309              
310             =item callback => code reference or function name
311              
312             A function to be invoked when the Google backend obtains
313             a translation result. The function will be called with a single
314             hash reference argument, containing the available data about
315             the translation input and output.
316              
317             =item filter => array reference
318              
319             List of filters to use (see L<I22r::Translate::Filter>) when
320             sending text to the Google Translate webservice.
321              
322             =back
323              
324             When you use the L<I22r::Translate/"translate_string">,
325             L<I22r::Translate/"translate_list">, or
326             L<I22r::Translate/"translate_hash"> function, the
327             L<I22r::Translate> module will decide when to use the
328             Google backend for translation. Most users do not need to
329             know anything else about the methods in this package.
330              
331             =head1 TODO
332              
333             =over 4
334              
335             =item 1. You typically make a GET request to the Google webservice,
336             which has a limit of 2000 characters (that's 2000 URL encoded and
337             UTF-8 encoded bytes, right?). If you use a POST request, you can
338             send up to 5000 bytes. L<WWW::Google::Translate> does this.
339              
340             =item 2. Provide a way to override the C<can_translate> method
341             and plug in your own opinion of how well Google translates between
342             language pairs (ultimately, want to be able to do this for every
343             backend).
344              
345             =item 3. Dynamically determine the list of languages supported by
346             Google translate. Either that or release a new version of this
347             module each time a language is added/deleted.
348              
349             =back
350              
351             =head1 AUTHOR
352              
353             Marty O'Brien, C<< <mob@cpan.org> >>
354              
355             =head1 SEE ALSO
356              
357             L<WWW::Google::Translate>, L<Lingua::Translate::Google>,
358             L<REST::Google::Translate>, L<REST::Google::Translate2>
359              
360             =head1 LICENSE AND COPYRIGHT
361              
362             Copyright 2012-2016 Marty O'Brien.
363              
364             This program is free software; you can redistribute it and/or modify it
365             under the terms of either: the GNU General Public License as published
366             by the Free Software Foundation; or the Artistic License.
367              
368             See http://dev.perl.org/licenses/ for more information.
369              
370             =cut