File Coverage

blib/lib/WebService/DetectLanguage.pm
Criterion Covered Total %
statement 8 47 17.0
branch 0 4 0.0
condition n/a
subroutine 3 8 37.5
pod 4 4 100.0
total 15 63 23.8


line stmt bran cond sub pod time code
1             package WebService::DetectLanguage;
2             $WebService::DetectLanguage::VERSION = '0.02';
3 1     1   713 use 5.006;
  1         4  
4 1     1   556 use Moo;
  1         11886  
  1         7  
5 1     1   1476 use JSON::MaybeXS;
  1         3  
  1         724  
6              
7             has key => (
8             is => 'ro',
9             required => 1,
10             );
11              
12             has ua => (
13             is => 'ro',
14             default => sub {
15             require HTTP::Tiny;
16             require IO::Socket::SSL;
17             return HTTP::Tiny->new;
18             },
19             );
20              
21             has base_url => (
22             is => 'ro',
23             default => sub { 'https://ws.detectlanguage.com/0.2' },
24             );
25              
26             sub _get
27             {
28 0     0     my ($self, $relurl) = @_;
29 0           my $url = $self->base_url.'/'.$relurl;
30 0           my $headers = { "Authorization" => "Bearer ".$self->key };
31 0           my $response = $self->ua->get($url, { headers => $headers });
32              
33 0 0         if (not $response->{success}) {
34 0           die "failed $response->{status} $response->{reason}\n";
35             }
36 0           return decode_json($response->{content});
37             }
38              
39             sub detect
40             {
41 0     0 1   my ($self, $string) = @_;
42              
43 0           my ($result) = $self->multi_detect($string);
44 0           return @{ $result };
  0            
45             }
46              
47             sub multi_detect
48             {
49 0     0 1   my ($self, @strings) = @_;
50 0           my $url = $self->base_url."/detect";
51 0           my $headers = { "Authorization" => "Bearer ".$self->key };
52 0           my $form_data = { 'q[]' => \@strings };
53 0           my $response = $self->ua->post_form($url, $form_data, { headers => $headers });
54              
55 0 0         if (not $response->{success}) {
56 0           die "failed $response->{status} $response->{reason}\n";
57             }
58              
59 0           require WebService::DetectLanguage::Result;
60 0           require WebService::DetectLanguage::Language;
61              
62 0           my $data = decode_json($response->{content});
63 0           my @results;
64              
65 0           foreach my $result_set (@{ $data->{data}{detections} }) {
  0            
66 0           my $set = [];
67 0           foreach my $result (@$result_set) {
68             my $object = WebService::DetectLanguage::Result->new(
69             language => WebService::DetectLanguage::Language->new(code => $result->{language}),
70             is_reliable => $result->{isReliable},
71             confidence => $result->{confidence},
72 0           );
73 0           push(@$set, $object);
74             }
75 0           push(@results, $set);
76             }
77              
78 0           return @results;
79             }
80              
81             sub languages
82             {
83 0     0 1   my $self = shift;
84 0           my $result = $self->_get("languages");
85              
86 0           require WebService::DetectLanguage::Language;
87              
88 0           return map { WebService::DetectLanguage::Language->new($_) } @$result;
  0            
89             }
90              
91             sub account_status
92             {
93 0     0 1   my $self = shift;
94             # my $result = $self->_request("user/status");
95 0           my $result = $self->_get("user/status");
96              
97 0           require WebService::DetectLanguage::AccountStatus;
98              
99 0           return WebService::DetectLanguage::AccountStatus->new( $result );
100             }
101              
102             1;
103              
104             =head1 NAME
105              
106             WebService::DetectLanguage - interface to the language detection API at DetectLanguage.com
107              
108             =head1 SYNOPSIS
109              
110             use WebService::DetectLanguage;
111             my $api = WebService::DetectLanguage->new(key => '...');
112             my @possibilities = $api->detect("there can be only one");
113             foreach my $poss (@possibilities) {
114             printf "language = %s confidence=%f\n",
115             $poss->language->name,
116             $poss->confidence;
117             }
118              
119             =head1 DESCRIPTION
120              
121             This module is an interface to the DetectLanguage service,
122             which provides an API for guessing what natural language is used
123             in a sample of text.
124              
125             This is very much a first cut at an interface,
126             so (a) the interface may well change, and
127             (b) contributions are welcome.
128              
129             To use the API you must sign up to get an API key,
130             at L.
131             There is a free level which lets you make 1,000 requests per day,
132             and you don't have to provide a card to sign up for the free level.
133              
134             =head2 Example Usage
135              
136             Let's say you've got a sample of text in a file.
137             You might read it into C<$text> using C
138             from L.
139              
140             To identify the language, you call the C method:
141              
142             @results = $api->detect($text);
143              
144             Each result is an instance of L.
145             If there's only one result,
146             you should look at the C flag to see whether they're
147             confident of the identification
148             The more text they're given, the more confident they are, in general.
149              
150             if (@results == 1) {
151             $result = $results[0];
152             if ($result->is_reliable) {
153             printf "Language is %s!\n", $result->language->name;
154             }
155             else {
156             # Hmm, maybe check with the user?
157             }
158             }
159              
160             You might get more than one result though.
161             This might happen if your sample contains
162             words from more than one language,
163             for example.
164              
165             In that case, the C flag can be used to check
166             if the first result is reliable enough to go with.
167              
168             if (@results > 1 && $results[0]->is_reliable) {
169             # we'll go with that!
170             }
171              
172             Each result also includes a confidence value,
173             which looks a bit like a percentage,
174             but L
175             says that it can go higher than 100.
176              
177             foreach my $result (@results) {
178             my $language = $result->language;
179             printf "language = %s (%s) with confidence %f\n",
180             $language->name,
181             $language->code,
182             $result->confidence;
183             }
184              
185             =head1 METHODS
186              
187             =head2 new
188              
189             You must provide the B that you got from C.
190              
191             my $api = WebService::WordsAPI->new(
192             key => '...',
193             );
194              
195              
196             =head2 detect
197              
198             This method takes a UTF-8 text string,
199             and returns a list of one or more guesses
200             at the language.
201              
202             Each guess is a data object which has attributes
203             C, C, and C.
204              
205             my $text = "It was a bright cold day in April, ...";
206             my @results = $api->detect($text);
207              
208             foreach my $result (@results) {
209             printf "language = %s (%s) confidence = %f reliable = %s\n",
210             $result->language->name,
211             $result->language->code,
212             $result->confidence,
213             $result->is_reliable ? 'Yes' : 'No';
214             }
215              
216             Look at the L
217             to see how to interpret each result.
218              
219              
220             =head2 multi_detect
221              
222             This takes multiple strings and returns a list of arrayrefs;
223             there is one arrayref for each string, returned in the same order as the strings.
224             Each arrayref contains one or more language guess,
225             as for C above.
226              
227             my @strings = (
228             "All happy families are alike; each unhappy family ... ",
229             "This is my favourite book in all the world, though ... ",
230             "It is a truth universally acknowledged, that Perl ... ",
231             );
232              
233             my @results = $api->multi_detect(@strings);
234              
235             for (my $i = 0; $i < @strings; $i++) {
236             print "Text: $strings[$i]\n";
237             my @results = @{ $results[$i] };
238              
239             # ... as for detect() above
240             }
241              
242              
243             =head2 languages
244              
245             This returns a list of the supported languages:
246              
247             my @languages = $api->languages;
248              
249             foreach my $language (@languages) {
250             printf "%s: %s\n",
251             $language->code,
252             $language->name;
253             }
254              
255             =head2 account_status
256              
257             This returns a bunch of information about your account:
258              
259             my $status = $api->account_status;
260              
261             printf "plan=%s status=%s requests=%d\n",
262             $status->plan,
263             $status->status,
264             $status->requests;
265              
266             For the full list of attributes,
267             either look at the API documentation,
268             or L.
269              
270             =head1 SEE ALSO
271              
272             L is the home page for the service;
273             documentation for the API can be found at L.
274              
275             =head1 REPOSITORY
276              
277             L
278              
279             =head1 AUTHOR
280              
281             Neil Bowers Eneilb@cpan.orgE
282              
283             =head1 LICENSE AND COPYRIGHT
284              
285             This software is copyright (c) 2019 by Neil Bowers .
286              
287             This is free software; you can redistribute it and/or modify it under
288             the same terms as the Perl 5 programming language system itself.
289