File Coverage

blib/lib/LINE/Bot/API/Event.pm
Criterion Covered Total %
statement 87 87 100.0
branch 4 6 66.6
condition 4 6 66.6
subroutine 23 23 100.0
pod 0 2 0.0
total 118 124 95.1


line stmt bran cond sub pod time code
1             package LINE::Bot::API::Event;
2 53     53   127102 use strict;
  53         102  
  53         2259  
3 53     53   265 use warnings;
  53         107  
  53         2741  
4              
5 53     53   278 use Carp 'carp';
  53         934  
  53         4522  
6             our @CARP_NOT = qw( LINE::Bot::API::Event LINE::Bot::API);
7              
8 53     53   30430 use Digest::SHA 'hmac_sha256';
  53         189506  
  53         5797  
9 53     53   1603 use JSON::XS 'decode_json';
  53         10594  
  53         4670  
10 53     53   27346 use MIME::Base64 'decode_base64';
  53         41137  
  53         4090  
11              
12 53     53   32874 use LINE::Bot::API::Event::Message;
  53         207  
  53         1810  
13 53     53   29315 use LINE::Bot::API::Event::Follow;
  53         221  
  53         2011  
14 53     53   25979 use LINE::Bot::API::Event::Unfollow;
  53         173  
  53         1872  
15 53     53   26039 use LINE::Bot::API::Event::Join;
  53         171  
  53         2106  
16 53     53   27115 use LINE::Bot::API::Event::Leave;
  53         171  
  53         1727  
17 53     53   27401 use LINE::Bot::API::Event::MemberJoin;
  53         487  
  53         2219  
18 53     53   26092 use LINE::Bot::API::Event::MemberLeave;
  53         167  
  53         1934  
19 53     53   25809 use LINE::Bot::API::Event::Postback;
  53         188  
  53         1738  
20 53     53   31233 use LINE::Bot::API::Event::BeaconDetection;
  53         182  
  53         1980  
21 53     53   25678 use LINE::Bot::API::Event::Things;
  53         194  
  53         1876  
22 53     53   25701 use LINE::Bot::API::Event::AccountLink;
  53         182  
  53         1868  
23 53     53   25959 use LINE::Bot::API::Event::Unsend;
  53         168  
  53         1890  
24 53     53   26237 use LINE::Bot::API::Event::VideoViewingComplete;
  53         202  
  53         1889  
25 53     53   25561 use LINE::Bot::API::Event::Unknown;
  53         184  
  53         25780  
26              
27             my %TYPE2CLASS = (
28             message => 'LINE::Bot::API::Event::Message',
29             follow => 'LINE::Bot::API::Event::Follow',
30             unfollow => 'LINE::Bot::API::Event::Unfollow',
31             join => 'LINE::Bot::API::Event::Join',
32             leave => 'LINE::Bot::API::Event::Leave',
33             memberJoined => 'LINE::Bot::API::Event::MemberJoin',
34             memberLeft => 'LINE::Bot::API::Event::MemberLeave',
35             postback => 'LINE::Bot::API::Event::Postback',
36             beacon => 'LINE::Bot::API::Event::BeaconDetection',
37             things => 'LINE::Bot::API::Event::Things',
38             accountLink => 'LINE::Bot::API::Event::AccountLink',
39             unsend => 'LINE::Bot::API::Event::Unsend',
40             unknown => 'LINE::Bot::API::Event::Unknown',
41             videoPlayComplete => 'LINE::Bot::API::Event::VideoViewingComplete',
42             );
43              
44             sub parse_events_json {
45 2     2 0 6982 my($self, $json) = @_;
46 2         5 my $events = [];
47              
48 2         328 my $data = decode_json $json;
49 2         7 for my $event_data (@{ $data->{events} }) {
  2         7  
50 43         70 my $type = $event_data->{type};
51 43         72 my $event_class = $TYPE2CLASS{$type};
52 43 100       80 unless ($event_class) {
53 1         291 carp 'Unsupported event type: ' . $type . ", parse as unknown event";
54 1         6 $event_class = $TYPE2CLASS{'unknown'};
55             }
56              
57 43         65 my $event = $event_class->new(%{ $event_data });
  43         356  
58 43         76 push @{ $events }, $event;
  43         111  
59             }
60              
61 2         43 $events;
62             }
63              
64             sub validate_signature {
65 4     4 0 277833 my($class, $json, $channel_secret, $signature) = @_;
66 4 50 66     50 return unless $signature && $json && $channel_secret;
      66        
67 2         67 my $json_signature = hmac_sha256($json, $channel_secret);
68 2         15 _secure_compare(decode_base64($signature), $json_signature);
69             }
70              
71             # Constant time string comparison for timing attacks.
72             sub _secure_compare {
73 2     2   7 my($x, $y) = @_;
74 2 50       8 return unless length $x == length $y;
75 2         91 my @a = unpack 'C*', $x;
76 2         12 my @b = unpack 'C*', $y;
77 2         3 my $compare = 0;
78 2         9 for my $i (0..(scalar(@a) - 1)) {
79 64         91 $compare |= $a[$i] ^ $b[$i];
80             }
81 2         16 return !$compare;
82             }
83              
84             1;
85             __END__