File Coverage

blib/lib/Lingua/Translate/Yandex.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Lingua::Translate::Yandex;
2              
3 1     1   28582 use strict;
  1         2  
  1         33  
4 1     1   5 use warnings;
  1         2  
  1         23  
5 1     1   4 use Carp;
  1         6  
  1         76  
6 1     1   913 use Data::Dumper;
  1         10574  
  1         80  
7              
8 1     1   447 use XML::Simple;
  0            
  0            
9             use LWP::UserAgent;
10              
11             use utf8;
12             use 5.010;
13              
14             =head1 NAME
15              
16             Lingua::Translate::Yandex - class for access to Yandex Translation Api.
17              
18             =head1 VERSION
19              
20             Version 0.01
21              
22             =cut
23              
24             our $VERSION = '0.03';
25              
26              
27             =head1 SYNOPSIS
28              
29             use Lingua::Translate::Yandex;
30              
31             my $translator = Lingua::Translate::Yandex->new();
32             say $translator->translate("Hello", "ru");
33             ...
34              
35             =cut
36              
37             =head1 CONSTRUCTORS
38              
39             =head2 new()
40              
41             =cut
42              
43             sub new {
44             my ($class) = @_;
45             my $self = {
46             browser => LWP::UserAgent->new(),
47             xml => XML::Simple->new(),
48             };
49             bless $self, $class;
50             return $self;
51             }
52              
53             =head1 METHODS
54              
55             =head2 getLanguages
56              
57             Return array with all supported pairs of languages.
58              
59             =cut
60              
61             sub getLanguages {
62             my ($self) = @_;
63             my $response = $self->getXmlResponse("http://translate.yandex.net/api/v1/tr/getLangs");
64             return $response->{dirs}->{string};
65              
66             }
67              
68             =head2 detectLanguage($text)
69              
70             Return language of B<$text>.
71              
72             =cut
73              
74             sub detectLanguage {
75             my ($self, $text) = @_;
76             my $response = $self->getXmlResponse("http://translate.yandex.net/api/v1/tr/detect?text=$text");
77             unless ($response->{code} == 200) {
78             croak "Unsupported language"
79             }
80             return $response->{lang};
81             }
82              
83             =head2 translate($text, $to)
84              
85             Translate B<$text> to B<$to> target language and return translated text in utf8 encoding. B<$text> must be in utf8 encoding.
86              
87             =cut
88              
89             sub translate {
90             my ($self, $text, $to) = @_;
91             utf8::decode($text);
92             my $language_pairs = $self->getLanguages();
93             my $text_lang = $self->detectLanguage($text);
94             my $pair = lc($text_lang . "-" . $to);
95             unless (@$language_pairs ~~ /($pair)/) {
96             croak "Unsupported languege pair";
97             }
98              
99             my $response = $self->getXmlResponse("http://translate.yandex.net/api/v1/tr/translate?lang=$pair&text=$text");
100             my $code = $response->{code};
101             given ($code) {
102             when (200) {break;}
103             when (413) {croak "The text size exceeds the maximum.";}
104             when (422) {croak "The text could not be translated.";}
105             when (501) {croak "The specified translation direction is not supported.";}
106             }
107              
108             my $result = $response->{text};
109             utf8::encode($result);
110             return $result;
111             }
112              
113              
114              
115             =head2 getXmlResponse($url)
116              
117             Return response from request to B<$url> in XML format.
118              
119             =cut
120              
121             sub getXmlResponse {
122             my ($self, $url) = @_;
123             return $self->{xml}->XMLin($self->{browser}->get($url)->content);
124             }
125              
126              
127             =head1 AUTHOR
128              
129             Milovidov Mikhail, C<< >>
130              
131             =head1 BUGS
132              
133             Please report any bugs or feature requests to C, or through
134             the web interface at L. I will be notified, and then you'll
135             automatically be notified of progress on your bug as I make changes.
136              
137              
138              
139              
140             =head1 SUPPORT
141              
142             You can find documentation for this module with the perldoc command.
143              
144             perldoc Lingua::Translate::Yandex
145              
146              
147             You can also look for information at:
148              
149             =over 4
150              
151             =item * RT: CPAN's request tracker (report bugs here)
152              
153             L
154              
155             =item * AnnoCPAN: Annotated CPAN documentation
156              
157             L
158              
159             =item * CPAN Ratings
160              
161             L
162              
163             =item * Search CPAN
164              
165             L
166              
167             =back
168              
169             =head1 LICENSE AND COPYRIGHT
170              
171             Copyright 2012 Milovidov Mikhail.
172              
173             This program is free software; you can redistribute it and/or modify it
174             under the terms of either: the GNU General Public License as published
175             by the Free Software Foundation; or the Artistic License.
176              
177             See http://dev.perl.org/licenses/ for more information.
178              
179              
180             =cut
181              
182             1; # End of Lingua::Translate::Yandex