File Coverage

blib/lib/Yandex/Translate.pm
Criterion Covered Total %
statement 24 113 21.2
branch 0 88 0.0
condition 0 36 0.0
subroutine 8 23 34.7
pod 14 14 100.0
total 46 274 16.7


line stmt bran cond sub pod time code
1             package Yandex::Translate;
2              
3 1     1   390 use strict;
  1         2  
  1         22  
4 1     1   5 use warnings;
  1         1  
  1         70  
5 1     1   417 use utf8;
  1         18  
  1         4  
6              
7 1     1   371 use HTML::Entities qw{encode_entities};
  1         4281  
  1         61  
8 1     1   524 use HTTP::Tiny;
  1         33479  
  1         33  
9 1     1   6 use JSON;
  1         2  
  1         5  
10 1     1   92 use POSIX qw{:locale_h};
  1         2  
  1         4  
11 1     1   447 use URI::Escape qw{uri_escape_utf8};
  1         1061  
  1         1219  
12              
13             #
14             # The “my” keyword is on a separate line so that the VERSION_FROM attribute
15             # of ExtUtils::MakeMaker->WriteMakefile() will accurately detect $VERSION.
16             #
17             my
18             $VERSION = '1.000002';
19              
20             #
21             # See https://tech.yandex.ru/translate/doc/dg/concepts/api-overview-docpage/
22             # for the supported language codes.
23             #
24             my %valid_lang = map { $_ => 1 } qw{
25             az sq am en ar hy af eu ba be bn my bg bs cy hu vi ht gl nl
26             mrj el ka gu da he yi id ga it is es kk kn ca ky zh ko xh km
27             lo la lv lt lb mg ms
28             ml mt mk mi mr mhr mn de ne no pa pap fa pl pt ro ru ceb sr si
29             sk sl sw su tg th tl ta tt te tr udm uz uk ur fi fr hi hr cs
30             sv gd et eo jv ja
31             };
32              
33             my %valid_format = map { $_ => 1 } qw { plain html };
34              
35             my %valid_options = map { $_ => 1 } qw { 1 };
36              
37             my %valid_default_ui = map { $_ => 1 } qw{ en ru };
38              
39             #
40             # Set the default UI to Russian if the locale is Russian;
41             # otherwise, set it to English.
42             #
43             (my $default_ui = setlocale(LC_CTYPE) || 'en') =~ s/_.*$//;
44             $default_ui = 'en' if ($default_ui ne 'ru');
45              
46             sub new
47             {
48 0     0 1   my $class = shift;
49             my $self = {
50             _key_ => shift,
51 0 0   0     _text_ => sub { my $t = shift; return (defined $t) ? uri_escape_utf8($t) : $t },
  0            
52 0   0       _from_lang_ => shift,
53             _to_lang_ => shift,
54             _ui_ => shift || $default_ui,
55             _hint_ => shift,
56             _format_ => shift,
57             _options_ => shift,
58             _base_ => 'https://translate.yandex.net/api/v1.5/tr.json',
59             _post_ => undef
60             };
61              
62 0           bless $self, $class;
63 0           return $self;
64             }
65              
66             sub set_key
67             {
68 0     0 1   my ( $self, $key ) = @_;
69 0 0         $self->{_key_} = $key if (defined $key);
70             }
71              
72             sub set_ui
73             {
74 0     0 1   my ( $self, $ui ) = @_;
75 0 0 0       $self->{_ui_} = (defined $ui && exists $valid_lang{$ui}) ? $ui : $default_ui;
76             }
77              
78             sub set_default_ui
79             {
80 0     0 1   my ( $self, $this_default_ui ) = @_;
81 0 0 0       $default_ui = $this_default_ui if (defined $this_default_ui && exists $valid_default_ui{$this_default_ui});
82             }
83              
84             #
85             # Get a list of supported translation directions.
86             #
87             sub get_langs_list
88             {
89 0     0 1   my $self = shift;
90 0           my $query = '/getLangs?';
91 0           $self->{_post_} = 'key='.$self->{_key_}.'&ui='.$self->{_ui_};
92 0           my $response = HTTP::Tiny->new->get($self->{_base_} . $query . $self->{_post_});
93              
94 0 0         die "Invalid API key\n" if ($response->{status} eq '401');
95 0 0         die "Blocked API key\n" if ($response->{status} eq '402');
96 0 0         die "Failed to get list of supported languages! (response code $response->{status})\n" unless ($response->{success});
97              
98 0 0 0       if (defined wantarray && length $response->{content}) {
99 0           my $json_respond = JSON->new->utf8->decode($response->{content});
100 0 0         return (wantarray) ? @{ $json_respond->{dirs} } : scalar(@{ $json_respond->{dirs} });
  0            
  0            
101             }
102             }
103              
104             sub set_text
105             {
106 0     0 1   my ( $self, $text ) = @_;
107 0 0         $self->{_text_} = uri_escape_utf8($text) if (defined $text);
108             }
109              
110             sub set_hint
111             {
112 0     0 1   my ( $self, $hint ) = @_;
113 0           my @valid_hint_lang;
114 0 0 0       if (defined $hint && ref($hint) eq 'ARRAY') {
115 0           for (@{ $hint }) {
  0            
116 0 0         push @valid_hint_lang, $_ if (exists $valid_lang{$_});
117             }
118             }
119 0 0         $self->{_hint_} = (@valid_hint_lang) ? [ @valid_hint_lang ] : undef;
120             }
121              
122             sub detect_lang
123             {
124 0     0 1   my $self = shift;
125 0           my $query = '/detect?';
126 0           $self->{_post_} = 'key='.$self->{_key_}.'&text='.$self->{_text_};
127 0 0         $self->{_post_} .= '&hint='.join(',', @{ $self->{_hint_} }) if (defined $self->{_hint_});
  0            
128 0           my $response = HTTP::Tiny->new->get($self->{_base_} . $query . $self->{_post_});
129              
130 0 0         die "Invalid API key\n" if ($response->{status} eq '401');
131 0 0         die "Blocked API key\n" if ($response->{status} eq '402');
132 0 0         die "Exceeded the daily limit on the amount of translated text\n" if ($response->{status} eq '404');
133 0 0         die "Failed to detect the language! (response code $response->{status})\n" unless ($response->{success});
134              
135 0 0 0       if (defined wantarray && length $response->{content}) {
136 0           my $json_respond = JSON->new->utf8->decode($response->{content});
137 0 0         return (wantarray) ? ($json_respond->{lang}) : $json_respond->{lang};
138             }
139             }
140              
141             sub set_from_lang
142             {
143 0     0 1   my ( $self, $from_lang ) = @_;
144 0 0 0       $self->{_from_lang_} = $from_lang if (!defined $from_lang || exists $valid_lang{$from_lang});
145             }
146              
147             sub set_to_lang
148             {
149 0     0 1   my ( $self, $to_lang ) = @_;
150 0 0 0       $self->{_to_lang_} = $to_lang if (defined $to_lang && exists $valid_lang{$to_lang});
151             }
152              
153             sub set_format
154             {
155 0     0 1   my ( $self, $format ) = @_;
156 0 0 0       $self->{_format_} = $format if (!defined $format || exists $valid_format{$format});
157             }
158              
159             sub set_options
160             {
161 0     0 1   my ( $self, $options ) = @_;
162 0 0 0       $self->{_options_} = $options if (!defined $options || exists $valid_options{$options});
163             }
164              
165             sub translate
166             {
167 0     0 1   my $self = shift;
168 0           my $query = '/translate?';
169 0 0         my $lang = (defined $self->{_from_lang_}) ? $self->{_from_lang_}.'-'.$self->{_to_lang_} : $self->{_to_lang_};
170 0           $self->{_post_} = 'key='.$self->{_key_}.'&text='.$self->{_text_}.'&lang='.$lang;
171 0 0         $self->{_post_} .= '&format='.$self->{_format_} if (defined $self->{_format_});
172 0 0         $self->{_post_} .= '&options='.$self->{_options_} if (defined $self->{_options_});
173 0           my $response = HTTP::Tiny->new->get($self->{_base_} . $query . $self->{_post_});
174              
175 0 0         die "Invalid API key\n" if ($response->{status} eq '401');
176 0 0         die "Blocked API key\n" if ($response->{status} eq '402');
177 0 0         die "Exceeded the daily limit on the amount of translated text\n" if ($response->{status} eq '404');
178 0 0         die "Exceeded the maximum text size\n" if ($response->{status} eq '413');
179 0 0         die "The text cannot be translated\n" if ($response->{status} eq '422');
180 0 0         die "The specified translation direction is not supported\n" if ($response->{status} eq '501');
181 0 0         die "Failed to translate text! (response code $response->{status})\n" unless ($response->{success});
182              
183 0 0 0       if (defined wantarray && length $response->{content}) {
184 0           my $json_respond = JSON->new->utf8->decode($response->{content});
185 0 0         if (defined $self->{_options_}) {
186 0           return ($json_respond->{detected}->{lang}, $json_respond->{text}[0]);
187             }
188             else {
189 0 0         return (wantarray) ? ($json_respond->{text}[0]) : $json_respond->{text}[0];
190             }
191             }
192             }
193              
194             #
195             # See §2.7 of Пользовательское соглашение сервиса «API Яндекс.Переводчик»
196             # at https://yandex.ru/legal/translate_api/
197             #
198             # See §2.7 of Terms of Use of API Yandex.Translate Service
199             # at https://yandex.com/legal/translate_api/
200             #
201             sub get_yandex_technology_reference
202             {
203 0     0 1   my ( $self, $attribute ) = @_;
204 0 0         if (defined wantarray) {
205 0           my %yandex_attribute;
206 0 0 0       if (defined $attribute && ref($attribute) eq 'HASH') {
207 0           while (my ( $key, $value ) = each %{ $attribute }) {
  0            
208 0 0         $yandex_attribute{$key} = $key.'="'.encode_entities($value).'"' if (lc $key ne 'href');
209             }
210             }
211              
212             #
213             # Sort %yandex_attribute so that the same $yandex_attributes value
214             # will consistently be produced for a given $attribute hash.
215             #
216 0 0         my $yandex_attributes = (%yandex_attribute) ? ' '.join(' ', map { $yandex_attribute{$_} } sort { $a cmp $b } keys %yandex_attribute) : '';
  0            
  0            
217              
218 0           my %yandex_url = (
219             ru => 'http://translate.yandex.ru/',
220             en => 'http://translate.yandex.com/',
221             );
222 0           my %yandex_text = (
223             ru => 'Переведено сервисом Яндекс.Переводчик',
224             en => 'Powered by Yandex.Translate',
225             );
226 0 0         my $yandex_url = (exists $yandex_url{$self->{_ui_}}) ? $yandex_url{$self->{_ui_}} : $yandex_url{$default_ui};
227 0 0         my $yandex_text = (exists $yandex_text{$self->{_ui_}}) ? $yandex_text{$self->{_ui_}} : $yandex_text{$default_ui};
228 0           my $yandex_element = ''.$yandex_text.'';
229 0 0         return (wantarray) ? ($yandex_element) : $yandex_element;
230             }
231             }
232              
233             1;
234             __END__