| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package LINE::Notify::Simple; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 2 |  |  | 2 |  | 142318 | use strict; | 
|  | 2 |  |  |  |  | 14 |  | 
|  | 2 |  |  |  |  | 60 |  | 
| 4 | 2 |  |  | 2 |  | 11 | use warnings; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 47 |  | 
| 5 | 2 |  |  | 2 |  | 1298 | use utf8; | 
|  | 2 |  |  |  |  | 29 |  | 
|  | 2 |  |  |  |  | 11 |  | 
| 6 | 2 |  |  | 2 |  | 72 | use feature qw(say); | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 269 |  | 
| 7 | 2 |  |  | 2 |  | 968 | use parent qw(Class::Accessor); | 
|  | 2 |  |  |  |  | 640 |  | 
|  | 2 |  |  |  |  | 11 |  | 
| 8 | 2 |  |  | 2 |  | 6859 | use JSON; | 
|  | 2 |  |  |  |  | 25588 |  | 
|  | 2 |  |  |  |  | 14 |  | 
| 9 | 2 |  |  | 2 |  | 1439 | use Encode; | 
|  | 2 |  |  |  |  | 29209 |  | 
|  | 2 |  |  |  |  | 171 |  | 
| 10 | 2 |  |  | 2 |  | 1023 | use Encode::Guess qw(euc-jp shiftjis 7bit-jis); | 
|  | 2 |  |  |  |  | 7635 |  | 
|  | 2 |  |  |  |  | 8 |  | 
| 11 | 2 |  |  | 2 |  | 17139 | use LWP::UserAgent; | 
|  | 2 |  |  |  |  | 91344 |  | 
|  | 2 |  |  |  |  | 99 |  | 
| 12 | 2 |  |  | 2 |  | 25 | use HTTP::Request; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 53 |  | 
| 13 | 2 |  |  | 2 |  | 12 | use URI::Escape; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 146 |  | 
| 14 | 2 |  |  | 2 |  | 1244 | use LINE::Notify::Simple::Response; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 14 |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | __PACKAGE__->mk_accessors(qw(access_token)); | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | our $LINE_NOTIFY_URL    = 'https://notify-api.line.me/api/notify'; | 
| 19 |  |  |  |  |  |  | our $VERSION            = '1.0'; | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | sub notify { | 
| 22 |  |  |  |  |  |  |  | 
| 23 | 1 |  |  | 1 | 1 | 119 | my($self, $message, $data) = @_; | 
| 24 |  |  |  |  |  |  |  | 
| 25 | 1 |  |  |  |  | 7 | my $headers = [ | 
| 26 |  |  |  |  |  |  | 'Content-Type', 'application/x-www-form-urlencoded', | 
| 27 |  |  |  |  |  |  | 'Authorization', sprintf('Bearer %s', $self->access_token) | 
| 28 |  |  |  |  |  |  | ]; | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 1 | 50 |  |  |  | 31 | if (ref($data) eq "HASH") { | 
| 31 | 0 |  |  |  |  | 0 | $data->{message} = $message; | 
| 32 |  |  |  |  |  |  | } else { | 
| 33 | 1 |  |  |  |  | 4 | $data = { message => $message }; | 
| 34 |  |  |  |  |  |  | } | 
| 35 | 1 |  |  |  |  | 4 | my $content = $self->make_query($data); | 
| 36 |  |  |  |  |  |  |  | 
| 37 | 1 |  |  |  |  | 12 | my $ua  = LWP::UserAgent->new; | 
| 38 | 1 |  |  |  |  | 3084 | my $req = HTTP::Request->new("POST", $LINE_NOTIFY_URL, $headers, $content); | 
| 39 | 1 |  |  |  |  | 9255 | my $res = $ua->request($req); | 
| 40 |  |  |  |  |  |  |  | 
| 41 | 1 |  |  |  |  | 1550719 | my $rate_limit_headers = {}; | 
| 42 | 1 |  |  |  |  | 16 | my @names = $res->header_field_names; | 
| 43 | 1 |  |  |  |  | 151 | foreach my $name (@names) { | 
| 44 | 15 | 50 |  |  |  | 32 | if ($name =~ /^X\-.*/) { | 
| 45 | 0 |  |  |  |  | 0 | $rate_limit_headers->{lc($name)} = $res->header($name); | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  |  | 
| 49 | 1 |  |  |  |  | 29 | my $ref = JSON->new->decode($res->content); | 
| 50 |  |  |  |  |  |  |  | 
| 51 | 1 |  |  |  |  | 42 | return LINE::Notify::Simple::Response->new({ rate_limit_headers => $rate_limit_headers, status => $ref->{status}, message => $ref->{message}, status_line => $res->status_line }); | 
| 52 |  |  |  |  |  |  | } | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | sub make_query { | 
| 56 |  |  |  |  |  |  |  | 
| 57 | 1 |  |  | 1 | 0 | 3 | my($self, $data) = @_; | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 1 |  |  |  |  | 2 | my @pairs; | 
| 60 | 1 |  |  |  |  | 2 | foreach my $key(keys %{$data}) { | 
|  | 1 |  |  |  |  | 5 |  | 
| 61 |  |  |  |  |  |  |  | 
| 62 | 1 |  |  |  |  | 3 | my $val = $data->{$key}; | 
| 63 | 1 | 50 |  |  |  | 5 | if (utf8::is_utf8($val)) { | 
| 64 | 0 |  |  |  |  | 0 | my $enc   = guess_encoding($val); | 
| 65 | 0 | 0 |  |  |  | 0 | my $guess = ref($enc) ? $enc->name : "UTF-8"; | 
| 66 | 0 |  |  |  |  | 0 | $val = Encode::encode($guess, $val); | 
| 67 |  |  |  |  |  |  | } | 
| 68 | 1 |  |  |  |  | 7 | push @pairs, sprintf("%s=%s", $key, uri_escape($val)); | 
| 69 |  |  |  |  |  |  | } | 
| 70 | 1 |  |  |  |  | 49 | return join("&", @pairs); | 
| 71 |  |  |  |  |  |  | } | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | 1; | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | __END__ |