File Coverage

blib/lib/LINE/Bot/API/Event.pm
Criterion Covered Total %
statement 76 77 98.7
branch 3 6 50.0
condition 4 6 66.6
subroutine 20 20 100.0
pod 0 2 0.0
total 103 111 92.7


line stmt bran cond sub pod time code
1             package LINE::Bot::API::Event;
2 51     51   140566 use strict;
  51         115  
  51         1510  
3 51     51   259 use warnings;
  51         90  
  51         1319  
4              
5 51     51   251 use Carp 'carp';
  51         96  
  51         3296  
6             our @CARP_NOT = qw( LINE::Bot::API::Event LINE::Bot::API);
7              
8 51     51   28795 use Digest::SHA 'hmac_sha256';
  51         163973  
  51         4852  
9 51     51   1235 use JSON::XS 'decode_json';
  51         7897  
  51         2792  
10 51     51   26002 use MIME::Base64 'decode_base64';
  51         32731  
  51         3105  
11              
12 51     51   24795 use LINE::Bot::API::Event::Message;
  51         159  
  51         1541  
13 51     51   24634 use LINE::Bot::API::Event::Follow;
  51         147  
  51         1456  
14 51     51   23404 use LINE::Bot::API::Event::Unfollow;
  51         145  
  51         1453  
15 51     51   22478 use LINE::Bot::API::Event::Join;
  51         147  
  51         1484  
16 51     51   23144 use LINE::Bot::API::Event::Leave;
  51         155  
  51         1639  
17 51     51   22646 use LINE::Bot::API::Event::MemberJoin;
  51         149  
  51         1447  
18 51     51   22571 use LINE::Bot::API::Event::MemberLeave;
  51         140  
  51         1463  
19 51     51   22889 use LINE::Bot::API::Event::Postback;
  51         144  
  51         1427  
20 51     51   23134 use LINE::Bot::API::Event::BeaconDetection;
  51         158  
  51         1491  
21 51     51   23164 use LINE::Bot::API::Event::Things;
  51         136  
  51         1438  
22 51     51   23019 use LINE::Bot::API::Event::AccountLink;
  51         148  
  51         19102  
23              
24             my %TYPE2CLASS = (
25             message => 'LINE::Bot::API::Event::Message',
26             follow => 'LINE::Bot::API::Event::Follow',
27             unfollow => 'LINE::Bot::API::Event::Unfollow',
28             join => 'LINE::Bot::API::Event::Join',
29             leave => 'LINE::Bot::API::Event::Leave',
30             memberJoined => 'LINE::Bot::API::Event::MemberJoin',
31             memberLeft => 'LINE::Bot::API::Event::MemberLeave',
32             postback => 'LINE::Bot::API::Event::Postback',
33             beacon => 'LINE::Bot::API::Event::BeaconDetection',
34             things => 'LINE::Bot::API::Event::Things',
35             accountLink => 'LINE::Bot::API::Event::AccountLink',
36             );
37              
38             sub parse_events_json {
39 2     2 0 5825 my($self, $json) = @_;
40 2         5 my $events = [];
41              
42 2         260 my $data = decode_json $json;
43 2         10 for my $event_data (@{ $data->{events} }) {
  2         9  
44 40         60 my $type = $event_data->{type};
45 40         64 my $event_class = $TYPE2CLASS{$type};
46 40 50       72 unless ($event_class) {
47 0         0 carp 'Unsupported event type: ' . $type;
48             }
49              
50 40         48 my $event = $event_class->new(%{ $event_data });
  40         268  
51 40         69 push @{ $events }, $event;
  40         79  
52             }
53              
54 2         25 $events;
55             }
56              
57             sub validate_signature {
58 4     4 0 6993 my($class, $json, $channel_secret, $signature) = @_;
59 4 50 66     59 return unless $signature && $json && $channel_secret;
      66        
60 2         130 my $json_signature = hmac_sha256($json, $channel_secret);
61 2         21 _secure_compare(decode_base64($signature), $json_signature);
62             }
63              
64             # Constant time string comparison for timing attacks.
65             sub _secure_compare {
66 2     2   8 my($x, $y) = @_;
67 2 50       10 return unless length $x == length $y;
68 2         19 my @a = unpack 'C*', $x;
69 2         24 my @b = unpack 'C*', $y;
70 2         6 my $compare = 0;
71 2         13 for my $i (0..(scalar(@a) - 1)) {
72 64         95 $compare |= $a[$i] ^ $b[$i];
73             }
74 2         19 return !$compare;
75             }
76              
77             1;
78             __END__