File Coverage

blib/lib/AnyEvent/SparkBot.pm
Criterion Covered Total %
statement 64 208 30.7
branch 0 60 0.0
condition 0 12 0.0
subroutine 22 27 81.4
pod 3 4 75.0
total 89 311 28.6


line stmt bran cond sub pod time code
1             package AnyEvent::SparkBot;
2              
3             our $VERSION='1.012';
4 2     2   1590 use Modern::Perl;
  2         6  
  2         21  
5 2     2   1525 use Moo;
  2         6176  
  2         15  
6 2     2   1936 use MooX::Types::MooseLike::Base qw(:all);
  2         14435  
  2         718  
7 2     2   16 use Scalar::Util qw( looks_like_number);
  2         5  
  2         119  
8 2     2   15 use Data::Dumper;
  2         4  
  2         106  
9 2     2   11 use namespace::clean;
  2         4  
  2         36  
10 2     2   2821 use AnyEvent::HTTP::MultiGet;
  2         222687  
  2         76  
11 2     2   1386 use AnyEvent::WebSocket::Client;
  2         411584  
  2         128  
12 2     2   20 use MIME::Base64;
  2         5  
  2         168  
13 2     2   700 use JSON;
  2         8189  
  2         16  
14 2     2   2088 use AnyEvent::HTTP::Spark;
  2         7  
  2         102  
15              
16             BEGIN {
17 2     2   17 no namespace::clean;
  2         5  
  2         12  
18 2     2   1081 with 'HTTP::MultiGet::Role', 'AnyEvent::SparkBot::SharedRole';
19             }
20              
21             =head1 NAME
22              
23             AnyEvent::SparkBot - Cisco Spark WebSocket Client for the AnyEvent Loop
24              
25             =head1 SYNOPSIS
26              
27             use Modern::Perl;
28             use Data::Dumper;
29             use AnyEvent::SparkBot;
30             use AnyEvent::Loop;
31             $|=1;
32              
33             our $obj=new AnyEvent::SparkBot(token=>$ENV{SPARK_TOKEN},on_message=>\&cb);
34              
35             $obj->que_getWsUrl(sub {
36             my ($agent,$id,$result)=@_;
37              
38             # start here if we got a valid connection
39             return $obj->start_connection if $result;
40             $obj->handle_reconnect;
41             });
42             $obj->agent->run_next;
43             AnyEvent::Loop::run;
44              
45             sub cb {
46             my ($sb,$result,$eventType,$verb,$json)=@_;
47             return unless $eventType eq 'conversation.activity' and $verb eq 'post';
48              
49             # Data::Result Object is False when combination of EvenType and Verb are unsupprted
50             if($result) {
51             my $data=$result->get_data;
52             my $response={
53             roomId=>$data->{roomId},
54             personId=>$data->{personId},
55             text=>"ya.. ya ya.. I'm on it!"
56             };
57             # Proxy our lookup in a Retry-After ( prevents a lot of errors )
58             $obj->run_lookup('que_createMessage',(sub {},$response);
59             } else {
60             print "Error: $result\n";
61             }
62             }
63              
64             =head1 DESCRIPTION
65              
66             Connects to cisco spark via a websocket. By itself this class only provides connectivty to Spark, the on_message callback is used to handle events that come in. By default No hanlder is provided.
67              
68             =head1 Moo Role(s)
69              
70             This module uses the following Moo role(s)
71              
72             HTTP::MultiGet::Role
73             AnyEvent::SparkBot::SharedRole
74              
75             =cut
76              
77             has retryTimeout=>(
78             is=>'ro',
79             isa=>Int,
80             default=>10,
81             lazy=>1,
82             );
83              
84             has retryCount=>(
85             is=>'ro',
86             isa=>Int,
87             default=>1,
88             lazy=>1,
89             );
90              
91             has retries=>(
92             is=>'ro',
93             isa=>HashRef,
94             lazy=>1,
95             default=>sub { {} },
96             required=>0,
97             );
98              
99             has reconnect_sleep=>(
100             is=>'ro',
101             isa=>Int,
102             default=>10,
103             required=>1,
104             );
105              
106             has reconnect=>(
107             is=>'ro',
108             isa=>Bool,
109             default=>1,
110             required=>1,
111             );
112              
113             has pingEvery=>(
114             is=>'ro',
115             isa=>Int,
116             default=>60,
117             );
118              
119             has pingWait=>(
120             is=>'ro',
121             isa=>Int,
122             default=>10,
123             );
124              
125             has ping=>(
126             is=>'rw',
127             );
128              
129             has lastPing=>(
130             is=>'rw',
131             isa=>Str,
132             lazy=>1,
133             );
134              
135             has connInfo=>(
136             is=>'rw',
137             lazy=>1,
138             default=>sub { {} },
139             );
140              
141             has deviceDesc=>(
142             is=>'ro',
143             isa=>Str,
144             default=>'{"deviceName":"perlwebscoket-client","deviceType":"DESKTOP","localizedModel":"nodeJS","model":"nodeJS","name":"perl-spark-client","systemName":"perl-spark-client","systemVersion":"'.$VERSION.'"}',
145             );
146              
147             has defaultUrl=>(
148             is=>'ro',
149             isa=>Str,
150             default=>'https://wdm-a.wbx2.com/wdm/api/v1/devices',
151             );
152              
153             has lastConn=>(
154             isa=>Str,
155             is=>'ro',
156             required=>1,
157             default=>'/tmp/sparkBotLastConnect.json',
158             );
159              
160             has connection=>(
161             is=>'rw',
162             isa=>Object,
163             required=>0,
164             );
165              
166             has on_message=>(
167             is=>'ro',
168             isa=>CodeRef,
169             required=>1,
170             );
171              
172             has spark=>(
173             is=>'rw',
174             isa=>Object,
175             required=>0,
176             lazy=>1,
177             );
178              
179             has currentUser=>(
180             is=>'rw',
181             isa=>HashRef,
182             required=>0,
183             lazy=>1,
184             default=>sub {return {}}
185             );
186              
187             =head1 OO Arguments and accessors
188              
189             Required Argument(s)
190              
191             token: The token used to authenticate the bot
192             on_message: code ref used to handle incomming messages
193              
194             Optional Arguments
195              
196             reconnect: default is true
197             logger: null(default) or an instance of log4perl::logger
198             lastConn: location to the last connection file
199             # it may be a very good idea to set this value
200             # default: /tmp/sparkBotLastConnect.json
201             defaultUrl: https://wdm-a.wbx2.com/wdm/api/v1/devices
202             # this is where we authenticate and pull the websocket url from
203             deviceDesc: JSON hash, representing the client description
204             agent: an instance of AnyEvent::HTTP::MultiGet
205             retryTimeout: default 10, sets how long to wait afer getting a 429 error
206             retryCount: default 1, sets how many retries when we get a 429 error
207              
208             Timout and retry values:
209              
210             pingEvery: 60 # used to check how often we run a ping
211             # pings only happen if no inbound request has come in for
212             # the interval
213             pingWait: 10
214             # how long to wait for a ping response
215             reconnect_sleep: 10
216             # how long to wait before we try to reconnect
217              
218             Objects set at runtime:
219              
220             lastConn: sets the location of the last connection file
221             ping: sets an object that will wake up and do something
222             lastPing: contains the last ping string value
223             connection: contains the current websocket connection if any
224             spark: Instance of AnyEvent::HTTP::Spark
225             currentUser: Hash ref representing the current bot user
226              
227             =cut
228              
229             # This method runs after the new constructor
230             sub BUILD {
231 2     2 0 1058 my ($self)=@_;
232              
233 2         41 my $sb=new AnyEvent::HTTP::Spark(agent=>$self->agent,token=>$self->token);
234 2         41 $self->spark($sb);
235             }
236              
237             # this method runs before the new constructor, and can be used to change the arguments passed to the module
238             around BUILDARGS => sub {
239             my ($org,$class,@args)=@_;
240            
241             return $class->$org(@args);
242             };
243              
244             =head1 OO Methods
245              
246             =over 4
247              
248             =item * my $result=$self->new_true({qw( some data )});
249              
250             Returns a new true Data::Result object.
251              
252             =item * my $result=$self->new_false("why this failed")
253              
254             Returns a new false Data::Result object
255              
256             =item * my $self->start_connection()
257              
258             Starts the bot up.
259              
260             =cut
261              
262             sub start_connection : BENCHMARK_DEBUG {
263 0         0 my ($self)=@_;
264              
265 0         0 my $url=$self->connInfo->{webSocketUrl};
266              
267             $self->run_lookup('que_getMe',sub {
268 0         0 my ($sb,$id,$result)=@_;
269 0 0       0 return $self->log_error("Could not get spark Bot user info?") unless $result;
270              
271 0         0 $self->currentUser($result->get_data);
272 0         0 });
273 0         0 $self->agent->run_next;
274 0         0 my $client=AnyEvent::WebSocket::Client->new;
275              
276             $client->connect($url)->cb(sub {
277 0         0 my $conn=eval { shift->recv };
  0         0  
278              
279 0 0       0 if($@) {
280 0         0 $self->log_error("Failed to cnnect to our web socket, error was: $@");
281 0         0 return $self->handle_reconnect;
282             }
283              
284 0         0 $self->connection($conn);
285 0         0 $conn->on(finish=>sub { $self->handle_reconnect() });
  0         0  
286 0         0 $self->setPing();
287              
288              
289 0         0 $conn->send(to_json({
290             id=>$self->uuidv4,
291             type=>'authorization',
292             data=>{
293             token=>'Bearer '.$self->token,
294             }
295             }));
296              
297 0         0 $conn->on(each_message=>sub { $self->handle_message(@_) });
  0         0  
298 0         0 });
299              
300 2     2   8390 }
  2         7  
  2         13  
301              
302              
303             =item * $self->handle_message($connection,$message)
304              
305             Handles incoming messages
306              
307             =cut
308              
309             sub handle_message : BENCHMARK_INFO {
310 0         0 my ($self,$conn,$message)=@_;
311 0         0 my $json=eval { from_json($message->body) };
  0         0  
312 0         0 $self->ping(undef);
313 0 0       0 if($@) {
314 0         0 $self->log_error("Failed to parse message, error was: $@");
315 0         0 $self->handle_reconnect;
316 0         0 return;
317             }
318              
319 0 0 0     0 if(exists $json->{type} && $json->{type} eq 'pong') {
320 0 0       0 if($json->{id} ne $self->lastPing) {
321 0         0 $self->log_error('Got a bad ping back?');
322 0         0 return $self->handle_reconnect;
323             } else {
324 0         0 $self->log_debug("got a ping response");
325 0         0 return $self->setPing();
326             }
327             } else {
328 0 0 0     0 if(exists $json->{data} and exists $json->{data}->{eventType} and exists $json->{data}->{activity} ) {
      0        
329 0         0 my $activity=$json->{data}->{activity};
330 0         0 my $eventType=$json->{data}->{eventType};
331 0 0       0 $eventType='unknown' unless defined $eventType;
332 0 0       0 if(exists $activity->{verb}) {
333 0         0 my $verb=$activity->{verb};
334 0 0       0 $verb='unknown' unless defined($verb);
335 0 0       0 if($eventType eq 'conversation.activity') {
336 0 0 0     0 if($verb=~ /post|share/) {
    0          
    0          
    0          
337 0 0       0 if(exists $activity->{actor}) {
338 0         0 my $actor=$activity->{actor};
339              
340 0 0       0 if($self->currentUser->{displayName} eq $actor->{displayName}) {
341 0         0 $self->log_debug("ignoring message because we sent it");
342 0         0 $self->setPing();
343 0         0 return;
344             }
345             $self->run_lookup('que_getMessage',sub {
346 0         0 my ($agent,$id,$result,$req,$resp)=@_;
347 0         0 $self->on_message->($self,$result,$eventType,$verb,$json);
348 0         0 },$activity->{id});
349             }
350             } elsif($verb eq 'add' and $activity->{object}->{objectType} eq 'person') {
351             my $args={
352             roomId=>$activity->{target}->{id},
353             personEmail=>$activity->{object}->{emailAddress},
354 0         0 };
355             $self->run_lookup('que_listMemberships',sub {
356 0         0 my ($agent,$id,$result,$req,$resp)=@_;
357 0         0 $self->on_message->($self,$result,$eventType,$verb,$json);
358 0         0 },$args);
359             } elsif($verb eq 'create') {
360             my $args={
361             personId=>$self->currentUser->{id},
362 0         0 };
363             $self->run_lookup('que_listMemberships',sub {
364 0         0 my ($agent,$id,$result,$req,$resp)=@_;
365 0         0 $self->on_message->($self,$result,$eventType,$verb,$json);
366 0         0 },$args);
367             } elsif($verb=~ /lock|unlock|update/) {
368             $self->run_lookup('que_getRoom',sub {
369 0         0 my ($agent,$id,$result,$req,$resp)=@_;
370 0         0 $self->on_message->($self,$result,$eventType,$verb,$json);
371 0         0 },$activity->{object}->{id});
372             } else {
373 0         0 $self->on_message->($self,$self->new_false("Unsupported EventType: [$eventType] and Verb: [$verb]"),$eventType,$verb,$json);
374             }
375             } else {
376 0         0 $self->on_message->($self,$self->new_false("Unsupported EventType: [$eventType] and Verb: [$verb]"),$eventType,$verb,$json);
377             }
378             } else {
379 0 0       0 my $eventType=defined($json->{data}->{eventType}) ? $json->{data}->{eventType} : 'unknown';
380 0 0       0 my $verb=defined($json->{data}->{activity}->{verb}) ? $json->{data}->{activity}->{verb} : 'unknown';
381 0         0 $self->on_message->($self,$self->new_false("Unsupported EventType: [$eventType] and Verb: [$verb]"),$eventType,'unknown',$json);
382             }
383             } else {
384 0 0       0 my $eventType=defined($json->{data}->{eventType}) ? $json->{data}->{eventType} : 'unknown';
385 0 0       0 my $verb=defined($json->{data}->{activity}->{verb}) ? $json->{data}->{activity}->{verb} : 'unknown';
386 0         0 $self->on_message->($self,$self->new_false("Unsupported EventType: [$eventType] and Verb: [$verb]"),$eventType,$verb,$json);
387             }
388             }
389 0         0 $self->setPing();
390 2     2   3022 }
  2         5  
  2         11  
391              
392             =item * $self->run_lookup($method,$cb,@args);
393              
394             Shortcut for:
395              
396             $self->spark->$method($cb,@args);
397             $self->agent->run_next;
398              
399             =cut
400              
401             sub run_lookup {
402 0     0 1   my ($self,$method,$cb,@args)=@_;
403            
404 0           $self->spark->$method($cb,@args);
405 0           $self->agent->run_next;
406             }
407              
408              
409             =item * $self->handle_reconnect()
410              
411             Handles reconnecting to spark
412              
413             =cut
414              
415             sub handle_reconnect : BENCHMARK_INFO {
416 0         0 my ($self)=@_;
417 0         0 $self->ping(undef);
418 0 0       0 $self->connection->close if $self->connection;
419              
420             my $ping=AnyEvent->timer(after=>$self->reconnect_sleep,cb=>sub {
421 0         0 $self->que_getWsUrl(sub { $self->start_connection });
  0         0  
422 0         0 $self->agent->run_next;
423 0         0 });
424 0         0 $self->ping($ping);
425 2     2   1119 }
  2         6  
  2         10  
426              
427             =item * $self->setPing()
428              
429             Sets the next ping object
430              
431             =cut
432              
433             sub setPing {
434 0     0 1   my ($self)=@_;
435              
436 0           $self->ping(undef);
437             my $ping=AnyEvent->timer(after=>$self->pingEvery,cb=>sub {
438              
439 0 0   0     unless($self->connection) {
440 0           $self->ping(undef);
441 0           $self->log_error('current conenction is not valid?');
442 0           return;
443             }
444 0           my $id=$self->uuidv4;
445 0           $self->lastPing($id);
446 0           $self->connection->send(to_json({ type=>'ping', id=> $id, }));
447 0           $self->setPingWait;
448 0           });
449 0           $self->ping($ping);
450             }
451              
452             =item * $self->setPingWait()
453              
454             This method is called by ping, sets a timeout to wait for the response.
455              
456             =cut
457              
458             sub setPingWait {
459 0     0 1   my ($self)=@_;
460 0           $self->ping(undef);
461             my $wait=AnyEvent->timer(after=>$self->pingWait,cb=>sub {
462 0     0     $self->ping(undef);
463 0           $self->handle_reconnect;
464 0           });
465 0           $self->ping($wait);
466             }
467              
468             =item * my $result=$self->getLastConn()
469              
470             Fetches the last connection info
471              
472             Returns a Data::Result Object, when true it contains the hash, when false it contains why it failed.
473              
474             =cut
475              
476             sub getLastConn : BENCHMARK_DEBUG {
477 0         0 my ($self)=@_;
478              
479 0         0 my $lc=$self->lastConn;
480 0 0       0 if(-r $lc) {
481 0         0 my $fh=IO::File->new($lc,'r');
482 0 0       0 return $self->new_false("Could not open file: $lc, error was: $!") unless $fh;
483              
484 0         0 my $str=join '',$fh->getlines;
485 0         0 $fh->close;
486              
487 0         0 my $json=eval { from_json($str) };
  0         0  
488 0 0       0 if($@) {
489 0         0 return $self->new_false("Could not parse $lc, error was: $@");
490             }
491              
492 0         0 return $self->new_true($json);
493             }
494              
495 0         0 return $self->new_false("Could not read $lc");
496 2     2   1682 }
  2         5  
  2         12  
497              
498             =item * my $result=$self->saveLastConn($ref)
499              
500             Saves the last conenction, returns a Data::Result Object
501              
502             $ref is assumed to be the data strucutre intended to be serialzied into json
503              
504             =cut
505              
506             sub saveLastConn : BENCHMARK_DEBUG {
507 0         0 my ($self,$ref)=@_;
508 0         0 my $json=to_json($ref,{pretty=>1});
509              
510 0         0 my $fh=IO::File->new($self->lastConn,'w');
511 0 0       0 return $self->new_false("Failed to create: [".$self->lastConn."] error was: [$!]") unless $fh;
512              
513 0         0 $fh->print($json);
514              
515 0         0 return $self->new_true($json);
516 2     2   913 }
  2         5  
  2         10  
517              
518             =item * my $job_id=$self->que_deleteLastUrl($cb)
519              
520             Returns a Data::Result Object, when true it contains the url that was deleted, when false it contains why it failed.
521              
522             =cut
523              
524             sub que_deleteLastUrl : BENCHMARK_INFO {
525 0         0 my ($self,$cb)=@_;
526 0         0 my $result=$self->getLastConn();
527              
528 0 0       0 return $self->queue_result($cb,$result) unless $result;
529              
530 0         0 my $json=$result->get_data;
531 0 0       0 return $self->queue_result($cb,$self->new_false('URL not found in json data strucutre')) unless exists $json->{url};
532 0         0 my $url=$json->{url};
533              
534 0         0 my $req=new HTTP::Request(DELETE=>$url,$self->default_headers);
535 0         0 return $self->queue_request($req,$cb);
536 2     2   911 }
  2         5  
  2         8  
537              
538             =item * my $job_id=$self->que_getWsUrl($cb)
539              
540             Gets the WebSocket URL
541              
542             Returns a Data::Result Object: When true it contains the url. When false it contains why it failed.
543              
544             =cut
545              
546             sub que_getWsUrl : BENCHMARK_INFO {
547 0         0 my ($self,$cb)=@_;
548            
549 0         0 $self->que_deleteLastUrl(\&log_delete_call);
550              
551             my $run_cb=sub {
552 0         0 my ($self,$id,$result)=@_;
553              
554 0 0       0 if($result) {
555 0         0 my $json=$result->get_data;
556 0         0 $self->connInfo($json);
557 0         0 $self->saveLastConn($json);
558             }
559            
560 0         0 $cb->(@_);
561 0         0 };
562 0         0 my $req=new HTTP::Request(POST=>$self->defaultUrl,$self->default_headers,$self->deviceDesc);
563 0         0 return $self->queue_request($req,$run_cb);
564 2     2   1032 }
  2         5  
  2         11  
565              
566             =item * $self->log_delete_call($id,$result)
567              
568             Call back to handle logging clean up of previous session
569              
570             =cut
571              
572             sub log_delete_call : BENCHMARK_INFO {
573 0         0 my ($self,$id,$result)=@_;
574 0 0       0 if($result) {
575 0         0 $self->log_always("Removed old device object without error");
576             } else {
577 0         0 $self->log_always("Failed to remove old device, error was: $result");
578             }
579 2     2   768 }
  2         5  
  2         41  
580              
581             =back
582              
583             =head1 AUTHOR
584              
585             Michael Shipper <AKALINUX@CPAN.ORG>
586              
587             =cut
588              
589             1;