line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Yandex::Translate; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
75826
|
use strict; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
156
|
|
4
|
5
|
|
|
5
|
|
30
|
use warnings; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
146
|
|
5
|
5
|
|
|
5
|
|
955
|
use utf8; |
|
5
|
|
|
|
|
30
|
|
|
5
|
|
|
|
|
30
|
|
6
|
|
|
|
|
|
|
|
7
|
5
|
|
|
5
|
|
2647
|
use HTML::Entities qw{encode_entities}; |
|
5
|
|
|
|
|
29217
|
|
|
5
|
|
|
|
|
451
|
|
8
|
5
|
|
|
5
|
|
3206
|
use HTTP::Tiny; |
|
5
|
|
|
|
|
194651
|
|
|
5
|
|
|
|
|
210
|
|
9
|
5
|
|
|
5
|
|
2895
|
use JSON; |
|
5
|
|
|
|
|
54202
|
|
|
5
|
|
|
|
|
27
|
|
10
|
5
|
|
|
5
|
|
643
|
use POSIX qw{:locale_h}; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
35
|
|
11
|
5
|
|
|
5
|
|
2767
|
use URI::Escape qw{uri_escape_utf8}; |
|
5
|
|
|
|
|
5774
|
|
|
5
|
|
|
|
|
6154
|
|
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.002'; |
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 tr }; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# |
40
|
|
|
|
|
|
|
# Set the default UI to Russian if the locale is Russian; |
41
|
|
|
|
|
|
|
# Set the default UI to Turkish if the locale is Turkish; |
42
|
|
|
|
|
|
|
# otherwise, set it to English. |
43
|
|
|
|
|
|
|
# |
44
|
|
|
|
|
|
|
(my $default_ui = setlocale(LC_CTYPE) || 'en') =~ s/_.*$//; |
45
|
|
|
|
|
|
|
$default_ui = 'en' if (!exists $valid_default_ui{$default_ui}); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub new |
48
|
|
|
|
|
|
|
{ |
49
|
1
|
|
|
1
|
1
|
9
|
my $class = shift; |
50
|
1
|
|
33
|
|
|
16
|
my $self = { |
51
|
|
|
|
|
|
|
_key_ => shift, |
52
|
|
|
|
|
|
|
_text_ => shift, |
53
|
|
|
|
|
|
|
_from_lang_ => shift, |
54
|
|
|
|
|
|
|
_to_lang_ => shift, |
55
|
|
|
|
|
|
|
_ui_ => shift || $default_ui, |
56
|
|
|
|
|
|
|
_hint_ => shift, |
57
|
|
|
|
|
|
|
_format_ => shift, |
58
|
|
|
|
|
|
|
_options_ => shift, |
59
|
|
|
|
|
|
|
_base_ => 'https://translate.yandex.net/api/v1.5/tr.json', |
60
|
|
|
|
|
|
|
_post_ => undef, |
61
|
|
|
|
|
|
|
_http_ => HTTP::Tiny->new |
62
|
|
|
|
|
|
|
}; |
63
|
|
|
|
|
|
|
|
64
|
1
|
50
|
|
|
|
118
|
$self->{_text_} = uri_escape_utf8($self->{_text_}) if (defined $self->{_text_}); |
65
|
|
|
|
|
|
|
|
66
|
1
|
|
|
|
|
3
|
return bless $self, $class; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub set_key |
70
|
|
|
|
|
|
|
{ |
71
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $key ) = @_; |
72
|
0
|
0
|
|
|
|
0
|
$self->{_key_} = $key if (defined $key); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub set_ui |
76
|
|
|
|
|
|
|
{ |
77
|
3
|
|
|
3
|
1
|
1295
|
my ( $self, $ui ) = @_; |
78
|
3
|
50
|
33
|
|
|
18
|
$self->{_ui_} = (defined $ui && exists $valid_lang{$ui}) ? $ui : $default_ui; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub set_default_ui |
82
|
|
|
|
|
|
|
{ |
83
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $this_default_ui ) = @_; |
84
|
0
|
0
|
0
|
|
|
0
|
$default_ui = $this_default_ui if (defined $this_default_ui && exists $valid_default_ui{$this_default_ui}); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# |
88
|
|
|
|
|
|
|
# Get a list of supported translation directions. |
89
|
|
|
|
|
|
|
# |
90
|
|
|
|
|
|
|
sub get_langs_list |
91
|
|
|
|
|
|
|
{ |
92
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
0
|
my $query = '/getLangs?'; |
95
|
0
|
|
|
|
|
0
|
$self->{_post_} = 'key='.$self->{_key_}.'&ui='.$self->{_ui_}; |
96
|
0
|
|
|
|
|
0
|
my $response = $self->{_http_}->get($self->{_base_} . $query . $self->{_post_}); |
97
|
|
|
|
|
|
|
|
98
|
0
|
0
|
|
|
|
0
|
die "Invalid API key\n" if ($response->{status} eq '401'); |
99
|
0
|
0
|
|
|
|
0
|
die "Blocked API key\n" if ($response->{status} eq '402'); |
100
|
0
|
0
|
|
|
|
0
|
die "Failed to get list of supported languages! (response code $response->{status})\n" unless ($response->{success}); |
101
|
|
|
|
|
|
|
|
102
|
0
|
0
|
0
|
|
|
0
|
if (defined wantarray && length $response->{content}) { |
103
|
0
|
|
|
|
|
0
|
my $json_respond = JSON->new->utf8->decode($response->{content}); |
104
|
0
|
0
|
|
|
|
0
|
return (wantarray) ? @{ $json_respond->{dirs} } : scalar(@{ $json_respond->{dirs} }); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub set_text |
109
|
|
|
|
|
|
|
{ |
110
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $text ) = @_; |
111
|
0
|
0
|
|
|
|
0
|
$self->{_text_} = uri_escape_utf8($text) if (defined $text); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub set_hint |
115
|
|
|
|
|
|
|
{ |
116
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $hint ) = @_; |
117
|
0
|
|
|
|
|
0
|
my @valid_hint_lang; |
118
|
0
|
0
|
0
|
|
|
0
|
if (defined $hint && ref($hint) eq 'ARRAY') { |
119
|
0
|
|
|
|
|
0
|
for (@{ $hint }) { |
|
0
|
|
|
|
|
0
|
|
120
|
0
|
0
|
|
|
|
0
|
push @valid_hint_lang, $_ if (exists $valid_lang{$_}); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
} |
123
|
0
|
0
|
|
|
|
0
|
$self->{_hint_} = (@valid_hint_lang) ? [ @valid_hint_lang ] : undef; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub detect_lang |
127
|
|
|
|
|
|
|
{ |
128
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
0
|
my $query = '/detect?'; |
131
|
0
|
|
|
|
|
0
|
$self->{_post_} = 'key='.$self->{_key_}.'&text='.$self->{_text_}; |
132
|
0
|
0
|
|
|
|
0
|
$self->{_post_} .= '&hint='.join(',', @{ $self->{_hint_} }) if (defined $self->{_hint_}); |
|
0
|
|
|
|
|
0
|
|
133
|
0
|
|
|
|
|
0
|
my $response = $self->{_http_}->get($self->{_base_} . $query . $self->{_post_}); |
134
|
|
|
|
|
|
|
|
135
|
0
|
0
|
|
|
|
0
|
die "Invalid API key\n" if ($response->{status} eq '401'); |
136
|
0
|
0
|
|
|
|
0
|
die "Blocked API key\n" if ($response->{status} eq '402'); |
137
|
0
|
0
|
|
|
|
0
|
die "Exceeded the daily limit on the amount of translated text\n" if ($response->{status} eq '404'); |
138
|
0
|
0
|
|
|
|
0
|
die "Failed to detect the language! (response code $response->{status})\n" unless ($response->{success}); |
139
|
|
|
|
|
|
|
|
140
|
0
|
0
|
0
|
|
|
0
|
if (defined wantarray && length $response->{content}) { |
141
|
0
|
|
|
|
|
0
|
my $json_respond = JSON->new->utf8->decode($response->{content}); |
142
|
0
|
0
|
|
|
|
0
|
return (wantarray) ? ($json_respond->{lang}) : $json_respond->{lang}; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub set_from_lang |
147
|
|
|
|
|
|
|
{ |
148
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $from_lang ) = @_; |
149
|
0
|
0
|
0
|
|
|
0
|
$self->{_from_lang_} = $from_lang if (!defined $from_lang || exists $valid_lang{$from_lang}); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub set_to_lang |
153
|
|
|
|
|
|
|
{ |
154
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $to_lang ) = @_; |
155
|
0
|
0
|
0
|
|
|
0
|
$self->{_to_lang_} = $to_lang if (defined $to_lang && exists $valid_lang{$to_lang}); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub set_format |
159
|
|
|
|
|
|
|
{ |
160
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $format ) = @_; |
161
|
0
|
0
|
0
|
|
|
0
|
$self->{_format_} = $format if (!defined $format || exists $valid_format{$format}); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub set_options |
165
|
|
|
|
|
|
|
{ |
166
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $options ) = @_; |
167
|
0
|
0
|
0
|
|
|
0
|
$self->{_options_} = $options if (!defined $options || exists $valid_options{$options}); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub translate |
171
|
|
|
|
|
|
|
{ |
172
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
0
|
my $query = '/translate?'; |
175
|
0
|
0
|
|
|
|
0
|
my $lang = (defined $self->{_from_lang_}) ? $self->{_from_lang_}.'-'.$self->{_to_lang_} : $self->{_to_lang_}; |
176
|
0
|
|
|
|
|
0
|
$self->{_post_} = 'key='.$self->{_key_}.'&text='.$self->{_text_}.'&lang='.$lang; |
177
|
0
|
0
|
|
|
|
0
|
$self->{_post_} .= '&format='.$self->{_format_} if (defined $self->{_format_}); |
178
|
0
|
0
|
|
|
|
0
|
$self->{_post_} .= '&options='.$self->{_options_} if (defined $self->{_options_}); |
179
|
0
|
|
|
|
|
0
|
my $response = $self->{_http_}->get($self->{_base_} . $query . $self->{_post_}); |
180
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
0
|
die "Invalid API key\n" if ($response->{status} eq '401'); |
182
|
0
|
0
|
|
|
|
0
|
die "Blocked API key\n" if ($response->{status} eq '402'); |
183
|
0
|
0
|
|
|
|
0
|
die "Exceeded the daily limit on the amount of translated text\n" if ($response->{status} eq '404'); |
184
|
0
|
0
|
|
|
|
0
|
die "Exceeded the maximum text size\n" if ($response->{status} eq '413'); |
185
|
0
|
0
|
|
|
|
0
|
die "The text cannot be translated\n" if ($response->{status} eq '422'); |
186
|
0
|
0
|
|
|
|
0
|
die "The specified translation direction is not supported\n" if ($response->{status} eq '501'); |
187
|
0
|
0
|
|
|
|
0
|
die "Failed to translate text! (response code $response->{status})\n" unless ($response->{success}); |
188
|
|
|
|
|
|
|
|
189
|
0
|
0
|
0
|
|
|
0
|
if (defined wantarray && length $response->{content}) { |
190
|
0
|
|
|
|
|
0
|
my $json_respond = JSON->new->utf8->decode($response->{content}); |
191
|
0
|
0
|
|
|
|
0
|
if (defined $self->{_options_}) { |
192
|
0
|
|
|
|
|
0
|
return ($json_respond->{detected}->{lang}, $json_respond->{text}[0]); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
else { |
195
|
0
|
0
|
|
|
|
0
|
return (wantarray) ? ($json_respond->{text}[0]) : $json_respond->{text}[0]; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# |
201
|
|
|
|
|
|
|
# See §2.7 of Пользовательское соглашение сервиса «API Яндекс.Переводчик» |
202
|
|
|
|
|
|
|
# at https://yandex.ru/legal/translate_api/ |
203
|
|
|
|
|
|
|
# |
204
|
|
|
|
|
|
|
# See §2.7 of Terms of Use of API Yandex.Translate Service |
205
|
|
|
|
|
|
|
# at https://yandex.com/legal/translate_api/ |
206
|
|
|
|
|
|
|
# |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub get_yandex_technology_reference |
209
|
|
|
|
|
|
|
{ |
210
|
3
|
|
|
3
|
1
|
14
|
my ( $self, $attribute ) = @_; |
211
|
3
|
50
|
|
|
|
9
|
if (defined wantarray) { |
212
|
3
|
|
|
|
|
5
|
my %yandex_attribute; |
213
|
3
|
50
|
33
|
|
|
9
|
if (defined $attribute && ref($attribute) eq 'HASH') { |
214
|
0
|
|
|
|
|
0
|
while (my ( $key, $value ) = each %{ $attribute }) { |
|
0
|
|
|
|
|
0
|
|
215
|
0
|
0
|
|
|
|
0
|
$yandex_attribute{$key} = $key.'="'.encode_entities($value).'"' if (lc $key ne 'href'); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# |
220
|
|
|
|
|
|
|
# Sort %yandex_attribute so that the same $yandex_attributes value |
221
|
|
|
|
|
|
|
# will consistently be produced for a given $attribute hash. |
222
|
|
|
|
|
|
|
# |
223
|
3
|
50
|
|
|
|
9
|
my $yandex_attributes = (%yandex_attribute) ? ' '.join(' ', map { $yandex_attribute{$_} } sort { $a cmp $b } keys %yandex_attribute) : ''; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
224
|
|
|
|
|
|
|
|
225
|
3
|
|
|
|
|
11
|
my %yandex_url = ( |
226
|
|
|
|
|
|
|
ru => 'http://translate.yandex.ru/', |
227
|
|
|
|
|
|
|
en => 'http://translate.yandex.com/', |
228
|
|
|
|
|
|
|
tr => 'http://translate.yandex.com.tr/', |
229
|
|
|
|
|
|
|
); |
230
|
3
|
|
|
|
|
8
|
my %yandex_text = ( |
231
|
|
|
|
|
|
|
ru => 'Переведено сервисом Яндекс.Переводчик', |
232
|
|
|
|
|
|
|
en => 'Powered by Yandex.Translate', |
233
|
|
|
|
|
|
|
tr => 'Tarafından desteklenmektedir Yandex.Çeviri', |
234
|
|
|
|
|
|
|
); |
235
|
3
|
50
|
|
|
|
10
|
my $yandex_url = (exists $yandex_url{$self->{_ui_}}) ? $yandex_url{$self->{_ui_}} : $yandex_url{$default_ui}; |
236
|
3
|
50
|
|
|
|
8
|
my $yandex_text = (exists $yandex_text{$self->{_ui_}}) ? $yandex_text{$self->{_ui_}} : $yandex_text{$default_ui}; |
237
|
3
|
|
|
|
|
10
|
my $yandex_element = ''.$yandex_text.''; |
238
|
3
|
50
|
|
|
|
13
|
return (wantarray) ? ($yandex_element) : $yandex_element; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
1; |
243
|
|
|
|
|
|
|
__END__ |