File Coverage

blib/lib/Bot/ChatBots/Messenger/WebHook.pm
Criterion Covered Total %
statement 65 66 98.4
branch 7 12 58.3
condition 11 18 61.1
subroutine 12 12 100.0
pod 4 4 100.0
total 99 112 88.3


line stmt bran cond sub pod time code
1             package Bot::ChatBots::Messenger::WebHook;
2 2     2   2730 use strict;
  2         7  
  2         81  
3 2     2   11 use warnings;
  2         3  
  2         121  
4             { our $VERSION = '0.002'; }
5              
6 2     2   12 use Ouch;
  2         3  
  2         190  
7 2     2   533 use Log::Any qw< $log >;
  2         7879  
  2         16  
8 2     2   2680 use Data::Dumper;
  2         5  
  2         141  
9              
10 2     2   692 use Moo;
  2         10097  
  2         20  
11 2     2   2531 use namespace::clean;
  2         12054  
  2         35  
12              
13             with 'Bot::ChatBots::Role::WebHook';
14              
15             has no_routes => (
16             is => 'ro',
17             default => sub { return 0 },
18             );
19              
20             has verify_token => (
21             is => 'ro',
22             lazy => 1,
23             default => sub { ouch 500, 'you MUST set verify_token by yourself' },
24             );
25              
26             sub BUILD {
27 1     1 1 9 my $self = shift;
28 1 50       11 if (!$self->no_routes) {
29 1         4 $self->install_route; # the main POST one
30 1         351 $self->install_get_route; # the FB back-authentication route
31             }
32             } ## end sub BUILD
33              
34             sub install_get_route {
35 1     1 1 3 my $self = shift;
36 1 50 33     7 my $args = (@_ && ref($_[0])) ? $_[0] : {@_};
37 1   33     9 my $r = $args->{routes} // $self->app->routes;
38 1   33     31 my $p = $args->{path} // $self->path;
39             return $r->get(
40             $p => sub {
41 3     3   23279 my $c = shift;
42 3         14 my $qp = $c->req->query_params;
43 3   100     80 my $hmode = $qp->param('hub.mode') // '';
44 3   100     427 my $hvt = $qp->param('hub.verify_token') // '';
45 3 100 100     150 if (($hmode eq 'subscribe') && ($hvt eq $self->verify_token)) {
46 1         22 $log->info('received correct challenge request');
47 1   50     7 my $challenge = $qp->param('hub.challenge') // '';
48 1         31 $c->render(text => $challenge);
49             }
50             else {
51 2         23 $log->error('GET request not accepted');
52 2         14 $c->rendered(403);
53             }
54 3         804 return;
55             }
56 1         18 );
57             } ## end sub install_get_route
58              
59             sub normalize_record {
60 2     2 1 529 my ($self, $record) = @_;
61 2 50       10 my $update = $record->{update} or ouch 500, 'no update found!';
62              
63 2         5 $record->{source}{technology} = 'messenger';
64              
65 2         5 $record->{type} = 'message';
66 2         5 $record->{payload} = $record->{update}{message};
67              
68 2         5 $record->{sender} = $record->{update}{sender};
69              
70 2         2 my $chan = $record->{channel} = {%{$record->{update}{sender}}};
  2         24  
71 2         5 $chan->{fqid} = $chan->{id};
72              
73 2         7 return $record;
74             } ## end sub normalize_record
75              
76             sub parse_request {
77 1     1 1 8956 my ($self, $req) = @_;
78              
79 1         45 my $data = $req->json;
80 1 50       1046 return unless $data->{object} eq 'page';
81              
82 1         4 local $Data::Dumper::Indent = 1;
83 1         2 my @updates;
84 1         2 for my $entry (@{$data->{entry}}) {
  1         5  
85 1         3 my $page_id = $entry->{id};
86 1         2 my $event_time = $entry->{time};
87              
88             EVENT:
89 1         2 for my $event (@{$entry->{messaging}}) {
  1         3  
90 2 50       8 if (exists $event->{message}) {
91 2         6 push @updates, $event;
92             }
93             else {
94 0         0 $log->warn('unknown event: ' . Dumper($event));
95             }
96             } ## end EVENT: for my $event (@{$entry...})
97             } ## end for my $entry (@{$data->...})
98              
99 1         6 return @updates;
100             } ## end sub parse_request
101              
102             1;