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__ |