File Coverage

blib/lib/AnyEvent/Lingr.pm
Criterion Covered Total %
statement 27 143 18.8
branch 0 52 0.0
condition 0 27 0.0
subroutine 9 28 32.1
pod 3 6 50.0
total 39 256 15.2


line stmt bran cond sub pod time code
1             package AnyEvent::Lingr;
2 1     1   1359 use Mouse;
  1         32751  
  1         6  
3              
4             our $VERSION = '0.07';
5              
6 1     1   1733 use AnyEvent::HTTP;
  1         49486  
  1         102  
7              
8 1     1   12 use Carp;
  1         14  
  1         56  
9 1     1   5 use JSON;
  1         2  
  1         8  
10 1     1   1180 use Log::Minimal;
  1         22953  
  1         10  
11 1     1   141 use Scalar::Util ();
  1         2  
  1         17  
12 1     1   2315 use Try::Tiny;
  1         1717  
  1         61  
13 1     1   975 use URI;
  1         5320  
  1         145  
14              
15             has ['user', 'password'] => (
16             is => 'ro',
17             required => 1,
18             );
19              
20             has 'api_key' => (
21             is => 'ro',
22             );
23              
24             has 'endpoint' => (
25             is => 'ro',
26             default => 'http://lingr.com/api/',
27             );
28              
29             has 'session' => (
30             is => 'rw',
31             );
32              
33             has ['on_error', 'on_room_info', 'on_event'] => (
34             is => 'rw',
35             isa => 'CodeRef',
36             );
37              
38             has 'counter' => (
39             is => 'rw',
40             isa => 'Int',
41             );
42              
43             has '_polling_guard' => (
44             is => 'rw',
45             clearer => '_clear_polling_guard',
46             );
47              
48 1     1   12 no Mouse;
  1         3  
  1         10  
49              
50             sub request {
51 0     0 0   my ($self, $http_method, $method, $params, $cb) = @_;
52              
53 0           my $uri = URI->new($self->endpoint . $method);
54 0           $uri->query_form($params);
55              
56             my $cb_wrap = sub {
57 0     0     my ($body, $hdr) = @_;
58              
59 0           my $json = try { decode_json $body };
  0            
60 0           $cb->($json, $hdr);
61 0           };
62              
63 0 0         if ($http_method eq 'GET') {
    0          
64 0           http_get $uri, $cb_wrap;
65             } elsif ($http_method eq 'POST') {
66 0           my $body = $uri->query;
67 0           $uri->query(undef);
68 0           http_post $uri, $body, $cb_wrap;
69             } else {
70 0           croak "unsupported http method: $http_method"
71             }
72              
73 0           1;
74             }
75              
76             sub get {
77 0     0 0   shift->request('GET', @_);
78             }
79              
80             sub post {
81 0     0 0   shift->request('POST', @_);
82             }
83              
84             sub _on_error {
85 0     0     my ($self, $res, $hdr) = @_;
86              
87 0           $self->_clear_polling_guard;
88              
89 0 0         if (my $cb = $self->on_error) {
90 0 0         if ($res) {
91 0           $cb->($res->{detail});
92             }
93             else {
94 0           $cb->($hdr->{Status} . ': ' . $hdr->{Reason});
95             }
96             }
97             else {
98 0           debugf 'on_error callback does not set';
99 0           critf "res:%s hdr:%s", ddf($res), ddf($hdr);
100             }
101             }
102              
103             sub start_session {
104 0     0 1   my ($self) = @_;
105              
106 0           debugf "starting session...";
107              
108 0 0         if ($self->session) {
109 0           debugf "found old session:%s reusing...", $self->session;
110              
111             $self->get('session/verify', { session => $self->session }, sub {
112 0     0     my ($res, $hdr) = @_;
113 0 0         return unless $self;
114              
115 0 0 0       if ($res and $res->{status} eq 'ok') {
116 0           infof "session verified: %s", $res->{session};
117 0           $self->_get_channels;
118             }
119             else {
120 0   0       debugf "session verify failed: %s", ddf($res || $hdr);
121 0           $self->session(undef);
122 0           $self->_on_error($res, $hdr);
123             }
124 0           });
125             }
126             else {
127 0           debugf "create new session...";
128              
129             $self->post('session/create', {
130             user => $self->user,
131             password => $self->password,
132             $self->api_key ? (api_key => $self->api_key) : (),
133             }, sub {
134 0     0     my ($res, $hdr) = @_;
135 0 0         return unless $self;
136              
137 0 0 0       if ($res and $res->{status} eq 'ok') {
138 0           debugf "session created: %s", $res->{session};
139 0           $self->session( $res->{session} );
140 0           $self->_get_channels;
141             }
142             else {
143 0   0       debugf "session create failed: %s", ddf($res || $hdr);
144 0           $self->_on_error($res, $hdr);
145             }
146 0 0         });
147             }
148              
149 0           Scalar::Util::weaken($self);
150             }
151              
152             sub update_room_info {
153 0     0 1   my ($self) = @_;
154 0           $self->_get_channels;
155             }
156              
157             sub _get_channels {
158 0     0     my ($self) = @_;
159              
160 0           debugf "getting joined channels";
161              
162             $self->get('user/get_rooms', { session => $self->session }, sub {
163 0     0     my ($res, $hdr) = @_;
164 0 0         return unless $self;
165              
166 0 0 0       if ($res and $res->{status} eq 'ok') {
167 0           debugf "got rooms: %s", ddf($res->{rooms});
168 0           $self->_update_room_info( $res->{rooms} );
169             }
170             else {
171 0           $self->_on_error($res, $hdr);
172             }
173 0           });
174 0           Scalar::Util::weaken($self);
175             }
176              
177             sub _update_room_info {
178 0     0     my ($self, $rooms) = @_;
179              
180 0           $self->get('room/show', { session => $self->session, room => join ',', @{ $rooms } }, sub {
181 0     0     my ($res, $hdr) = @_;
182 0 0         return unless $self;
183              
184 0 0 0       if ($res and $res->{status} eq 'ok') {
185 0           debugf "got room infos";
186 0 0         if ($self->on_room_info) {
187 0           $self->on_room_info->($res->{rooms});
188             }
189             else {
190 0           debugf "no room info callback";
191             }
192              
193 0           $self->_start_observe($rooms);
194             }
195             else {
196 0           $self->_on_error($res, $hdr);
197             }
198 0           });
199 0           Scalar::Util::weaken($self);
200             }
201              
202             sub _start_observe {
203 0     0     my ($self, $rooms) = @_;
204              
205             $self->post('room/subscribe', {
206             session => $self->session,
207             rooms => join(',', @$rooms),
208             reset => 1,
209             }, sub {
210 0     0     my ($res, $hdr) = @_;
211 0 0         return unless $self;
212              
213 0 0 0       if ($res and $res->{status} eq 'ok') {
214 0           $self->counter( $res->{counter} );
215 0           $self->_polling;
216             }
217             else {
218 0           $self->_on_error($res, $hdr);
219             }
220 0           });
221 0           Scalar::Util::weaken($self);
222             }
223              
224             sub _polling {
225 0     0     my ($self) = @_;
226              
227 0 0         if ($self->_polling_guard) {
228 0           debugf 'polling session is still active, ignoring this request';
229 0           return;
230             }
231              
232 0           my $uri = URI->new( $self->endpoint . 'event/observe' );
233 0           $uri->port(8080);
234 0           $uri->query_form({ session => $self->session, counter => $self->counter });
235              
236             my $guard = http_get $uri, timeout => 60, sub {
237 0     0     my ($body, $hdr) = @_;
238 0 0         return unless $self;
239              
240 0           my $res = try { decode_json $body };
  0            
241              
242 0 0 0       if ($res and $res->{status} eq 'ok') {
243 0 0         if ($res->{counter}) {
244 0           $self->counter( $res->{counter} );
245             }
246 0 0         if ($res->{events}) {
247 0 0         if (my $cb = $self->on_event) {
248 0           $cb->($_) for @{ $res->{events} };
  0            
249             }
250             else {
251 0           debugf "no on_event callback";
252             }
253             }
254              
255 0           $self->_clear_polling_guard;
256 0           $self->_polling;
257             }
258             else {
259 0           $self->_on_error($res, $hdr);
260             }
261 0           };
262 0           Scalar::Util::weaken($self);
263              
264 0           $self->_polling_guard( $guard );
265             }
266              
267             sub say {
268 0     0 1   my ($self, $room, $msg, $cb) = @_;
269              
270             $self->post('room/say', { session => $self->session, room => $room, text => $msg }, sub {
271 0     0     my ($res, $hdr) = @_;
272 0 0         return unless $self;
273              
274 0 0 0       if ($res and $res->{status} eq 'ok') {
275 0 0         $cb->($res) if $cb;
276             }
277             else {
278 0           $self->_on_error($res, $hdr);
279             }
280 0           });
281              
282 0           Scalar::Util::weaken($self);
283             }
284              
285             1;
286              
287             __END__