File Coverage

blib/lib/Bot/ChatBots/Trello/WebHook.pm
Criterion Covered Total %
statement 27 49 55.1
branch 0 4 0.0
condition 0 3 0.0
subroutine 9 14 64.2
pod 3 3 100.0
total 39 73 53.4


line stmt bran cond sub pod time code
1             package Bot::ChatBots::Trello::WebHook;
2 1     1   1486 use strict;
  1         2  
  1         25  
3 1     1   4 use warnings;
  1         2  
  1         36  
4             { our $VERSION = '0.002'; }
5              
6 1     1   5 use Ouch;
  1         2  
  1         4  
7 1     1   426 use Log::Any qw< $log >;
  1         6451  
  1         5  
8 1     1   1724 use Data::Dumper;
  1         2  
  1         38  
9 1     1   393 use Mojo::URL;
  1         6444  
  1         6  
10 1     1   31 use Mojo::Path;
  1         2  
  1         3  
11              
12 1     1   481 use Moo;
  1         6810  
  1         6  
13 1     1   1634 use namespace::clean;
  1         9199  
  1         5  
14              
15             with 'Bot::ChatBots::Role::WebHook';
16              
17             sub BUILD {
18 0     0 1   my $self = shift;
19              
20             # this installs the real webhook route
21 0           $self->install_route;
22              
23             # this makes Trello happy upon webhook registration
24             $self->install_route(
25             method => 'get',
26 0     0     handler => sub { shift->render(text => 'OK') }
27 0           );
28             } ## end sub BUILD
29              
30             sub normalize_record {
31 0     0 1   my ($self, $record) = @_;
32              
33 0 0         my $update = $record->{update} or ouch 500, 'no update found';
34 0           $record->{source}{technology} = 'trello';
35 0   0       $record->{source}{token} //= $record->{source}{object_token};
36              
37 0           $record->{payload} = $update;
38 0           $record->{sender} = 'unknown';
39              
40 0           return $self->_normalize_action($record);
41             } ## end sub normalize_record
42              
43 0     0 1   sub parse_request { return $_[1]->json }
44              
45             # paranoid: ensure we return a "200" with some response
46             around process => sub {
47             my ($orig, $self, $record) = @_;
48             my $outcome = $orig->($self, $record);
49             $record->{source}{refs}{controller}->render(text => 'OK')
50             unless $record->{source}{flags}{rendered}++;
51             return $outcome;
52             };
53              
54             sub _normalize_action {
55 0     0     my ($self, $record) = @_;
56 0           my $A = $record->{payload}{action};
57 0           $record->{action} = \my %action;
58 0           my $type = $action{type} = $A->{type};
59 0           $action{subtype} = $A->{display}{translationKey};
60 0 0         if (my ($item_type) = $type =~ m{(Card | List | Board)$}mxs) {
61 0           $item_type = lc $item_type;
62 0           $action{item} = {%{$A->{data}{$item_type}}, type => $item_type};
  0            
63             }
64 0           return $record;
65             } ## end sub _normalize_action
66              
67             1;