File Coverage

blib/lib/WebService/Lymbix.pm
Criterion Covered Total %
statement 30 76 39.4
branch 0 4 0.0
condition 0 17 0.0
subroutine 9 14 64.2
pod 5 5 100.0
total 44 116 37.9


line stmt bran cond sub pod time code
1             package WebService::Lymbix;
2              
3 3     3   253115 use strict;
  3         8  
  3         114  
4 3     3   17 use warnings;
  3         7  
  3         164  
5              
6             our $VERSION = '0.02';
7             $VERSION = eval $VERSION;
8              
9 3     3   17 use Carp;
  3         10  
  3         201  
10 3     3   11776 use Encode;
  3         79001  
  3         305  
11 3     3   2555 use Mouse;
  3         142121  
  3         16  
12 3     3   1921 use Mouse::Util::TypeConstraints;
  3         7  
  3         16  
13 3     3   5760 use LWP::UserAgent;
  3         297958  
  3         118  
14 3     3   180 use HTTP::Request;
  3         9  
  3         3289  
15              
16             =head1 NAME
17              
18             WebService::Lymbix - API wrapper of Lymbix.
19              
20             =head1 VERSION
21              
22             Version 0.02
23              
24             =cut
25              
26             =head1 SYNOPSIS
27              
28             An API wrapper of Lymbix. See L for more details.
29              
30             Perhaps a little code snippet.
31              
32             use WebService::Lymbix;
33              
34             my $auth_key = '';
35             my $lymbix = WebService::Lymbix->new($auth_key);
36             print $lymbix->tonalize("if you had to launch your business in two weeks, what would you cut")
37             ...
38              
39             =head1 ATTRIBUTES
40              
41             =head2 api_url
42              
43             =head2 auth_key
44              
45             =head2 accept_type
46              
47             =head2 api_version
48              
49             =cut
50              
51             has api_url => (
52             is => 'rw',
53             isa => 'Str',
54             required => 1,
55             default => 'http://api.lymbix.com'
56             );
57             has auth_key => ( is => 'rw', isa => 'Str', required => 1 );
58              
59             enum 'AcceptType' => qw(application/json application/xml);
60             has accept_type => (
61             is => 'rw',
62             isa => 'AcceptType',
63             default => 'application/json',
64             );
65              
66             has api_version => ( is => 'rw', isa => 'Str', default => '2.2' );
67              
68             has ua => ( is => 'rw', isa => 'LWP::UserAgent' );
69             has req => ( is => 'rw', isa => 'HTTP::Request' );
70              
71             has tonalize_uri => ( is => 'ro', default => '/tonalize' );
72             has tonalize_detailed_uri => ( is => 'ro', default => '/tonalize_detailed' );
73             has tonalize_multiple_uri => ( is => 'ro', default => '/tonalize_multiple' );
74             has flag_response_uri => ( is => 'ro', default => '/flag_response' );
75              
76             around BUILDARGS => sub {
77             my $orig = shift;
78             my $class = shift;
79              
80             if ( @_ == 1 && !ref $_[0] ) {
81             return $class->$orig( auth_key => $_[0] );
82             }
83             else {
84             return $class->$orig(@_);
85             }
86             };
87              
88             sub BUILD {
89 2     2 1 49 my $self = shift;
90              
91 2         17 $self->ua( LWP::UserAgent->new );
92 2         5473 $self->req( HTTP::Request->new('POST') );
93 2         144 $self->req->header( AUTHENTICATION => $self->auth_key );
94 2         172 $self->req->header( ACCEPT => $self->accept_type );
95 2         82 $self->req->header( VERSION => $self->api_version );
96             }
97              
98             =head1 METHODS
99              
100             =head2 tonalize(article, [return_fields, accept_type, article_reference_id])
101              
102             The tonalize method provides article-level Lymbix sentiment data for a single article.
103              
104             =cut
105              
106             sub tonalize {
107 0     0 1   my $self = shift;
108              
109 0           my $article = shift;
110 0   0       my $return_fields = shift || ' '; # CSV format
111 0   0       my $reference_id = shift || '';
112              
113 0           my $content = qq(article=$article);
114 0           $content .= qq(&return_fields=[$return_fields]);
115 0           $content .= qq(&reference_id=$reference_id);
116              
117 0           return $self->_request( $content, $self->tonalize_uri );
118             }
119              
120             =head2 tonalize_detailed(article, [return_fields, accept_type, article_reference_id])
121              
122             The tonalize_detailed method provides article-level Lymbix sentiment data along with a sentence by sentence sentiment data for a single article.
123              
124             =cut
125              
126             sub tonalize_detailed {
127 0     0 1   my $self = shift;
128              
129 0           my $article = shift;
130 0   0       my $return_fields = shift || ' '; # CSV format
131 0   0       my $reference_id = shift || '';
132              
133 0           my $content = qq(article=$article);
134 0           $content .= qq(&return_fields=[$return_fields]);
135 0           $content .= qq(&reference_id=$reference_id);
136              
137 0           return $self->_request( $content, $self->tonalize_detailed_uri );
138             }
139              
140             =head2 PARAMS
141              
142             =head3 article (string)
143              
144             =head3 return_fields (csv)
145              
146             =head3 article_reference_id (string)
147              
148             =head2 tonalize_multiple(articles, [return_fields, article_reference_ids])
149              
150             The tonalize_multiple method provides article-level Lymbix sentiment data for multiple articles.
151              
152             articles (csv), return_fields (csv), article_reference_ids (csv)
153              
154             =cut
155              
156             sub tonalize_multiple {
157 0     0 1   my $self = shift;
158              
159 0           my $articles = shift;
160 0   0       my $return_fields = shift || ' '; # CSV format
161 0   0       my $reference_ids = shift || ' '; # CSV format
162              
163 0           my $content = qq(articles=[$articles]);
164 0           $content .= qq(&return_fields=[$return_fields]);
165 0           $content .= qq(&reference_ids=[$reference_ids]);
166              
167 0           return $self->_request( $content, $self->tonalize_multiple_uri );
168             }
169              
170             =head2 flag_response (reference_id, phrase, api_method_requested, [api_version, callback_url])
171              
172             Flags a phrase to be re-evaluated.
173              
174             =cut
175              
176             sub flag_response {
177 0     0 1   my $self = shift;
178              
179 0           my $reference_id = shift; # || croak 'Required to pass reference_id';
180 0           my $phrase = shift;
181 0           my $api_method_requested = shift;
182 0   0       my $api_version = shift || $self->api_version;
183 0   0       my $callback_url = shift || '';
184              
185 0 0         croak "Invalid api_method_requested [$api_method_requested]"
186             unless grep( /^$api_method_requested$/,
187             qw(tonalize tonalize_detailed tonalize_multiple) );
188              
189 0           my $content = qq(phrase=$phrase);
190 0           $content .= qq(&reference_id=$reference_id);
191 0           $content .= qq(&api_method_requested=$api_method_requested);
192 0           $content .= qq(&api_version=$api_version);
193 0           $content .= qq(&callback_url=$callback_url);
194              
195 0           return $self->_request( $content, $self->flag_response_uri );
196             }
197              
198             sub _request {
199 0     0     my $self = shift;
200 0           my $content = shift;
201 0           my $uri = shift;
202              
203 0           $self->req->uri( $self->api_url . $uri );
204 0           $self->req->content( encode( "UTF8", $content ) );
205              
206 0           my $res = $self->ua->request( $self->req );
207 0 0         if ( $res->is_success ) {
208 0           return $res->content;
209             }
210             else {
211 0           return $res->status_line;
212             }
213             }
214              
215             =head1 AUTHOR
216              
217             Omid Houshyar, C<< >>
218              
219             =head1 BUGS
220              
221              
222             Please report any bugs or feature requests via GitHub bug tracker at
223             L.
224              
225              
226             =head1 ACKNOWLEDGEMENTS
227              
228             Pavel Shaydo for helping me to release this module.
229              
230              
231             =head1 LICENSE AND COPYRIGHT
232              
233             Copyright 2012 Omid Houshyar.
234              
235             This program is free software; you can redistribute it and/or modify it
236             under the terms of either: the GNU General Public License as published
237             by the Free Software Foundation; or the Artistic License.
238              
239             See http://dev.perl.org/licenses/ for more information.
240              
241              
242             =cut
243              
244             __PACKAGE__->meta->make_immutable();
245             1;