| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package WebService::Discord::Webhook; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 72389 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 4 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | # Module for interacting with the REST service | 
| 7 | 1 |  |  | 1 |  | 727 | use HTTP::Tiny; | 
|  | 1 |  |  |  |  | 53148 |  | 
|  | 1 |  |  |  |  | 49 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | # JSON decode | 
| 10 | 1 |  |  | 1 |  | 832 | use JSON::PP qw(encode_json decode_json); | 
|  | 1 |  |  |  |  | 17288 |  | 
|  | 1 |  |  |  |  | 72 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | # Base64 encode for avatar images | 
| 13 | 1 |  |  | 1 |  | 543 | use MIME::Base64 qw(encode_base64); | 
|  | 1 |  |  |  |  | 697 |  | 
|  | 1 |  |  |  |  | 72 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | # Parse filename from filepath | 
| 16 | 1 |  |  | 1 |  | 8 | use File::Spec; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 48 |  | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | # better error messages | 
| 19 | 1 |  |  | 1 |  | 6 | use Carp qw(croak); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 2538 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | # PACKAGE VARS | 
| 22 |  |  |  |  |  |  | our $VERSION = '1.10'; | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | # Base URL for all API requests | 
| 25 |  |  |  |  |  |  | our $BASE_URL = 'https://discord.com/api'; | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | ################################################## | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | # Create a new Webhook object. | 
| 30 |  |  |  |  |  |  | #  Pass a hash containing parameters | 
| 31 |  |  |  |  |  |  | #  Requires: | 
| 32 |  |  |  |  |  |  | #   url, or | 
| 33 |  |  |  |  |  |  | #   token and id | 
| 34 |  |  |  |  |  |  | #  Optional: | 
| 35 |  |  |  |  |  |  | #   wait | 
| 36 |  |  |  |  |  |  | #   timeout | 
| 37 |  |  |  |  |  |  | #   verify_SSL | 
| 38 |  |  |  |  |  |  | #  A single scalar is treated as a URL | 
| 39 |  |  |  |  |  |  | sub new { | 
| 40 | 5 |  |  | 5 | 1 | 2116 | my $class = shift; | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 5 |  |  |  |  | 11 | my %params; | 
| 43 | 5 | 100 |  |  |  | 16 | if ( @_ > 1 ) { | 
| 44 | 2 |  |  |  |  | 6 | %params = @_; | 
| 45 |  |  |  |  |  |  | } else { | 
| 46 | 3 |  |  |  |  | 7 | $params{url} = shift; | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | # check parameters | 
| 50 | 5 |  |  |  |  | 10 | my ( $id, $token ); | 
| 51 | 5 | 100 | 33 |  |  | 18 | if ( $params{url} ) { | 
|  |  | 50 |  |  |  |  |  | 
| 52 | 4 | 100 |  |  |  | 33 | if ( $params{url} =~ m{discord(?:app)?\.com/api/webhooks/(\d+)/([^/?]+)}i ) { | 
| 53 | 2 |  |  |  |  | 7 | $id    = $1; | 
| 54 | 2 |  |  |  |  | 7 | $token = $2; | 
| 55 |  |  |  |  |  |  | } else { | 
| 56 | 2 |  |  |  |  | 191 | croak "PARAMETER ERROR: Failed to parse ID and Token from URL"; | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  | } elsif ( $params{id} && $params{token} ) { | 
| 59 | 0 | 0 | 0 |  |  | 0 | if ( $params{id} =~ m/^\d+$/ && $params{token} =~ m{^[^/?]+$} ) { | 
| 60 | 0 |  |  |  |  | 0 | $id    = $params{id}; | 
| 61 | 0 |  |  |  |  | 0 | $token = $params{token}; | 
| 62 |  |  |  |  |  |  | } else { | 
| 63 | 0 |  |  |  |  | 0 | croak "PARAMETER ERROR: Failed to validate ID and Token"; | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  | } else { | 
| 66 | 1 |  |  |  |  | 216 | croak "PARAMETER ERROR: Must provide either URL, or ID and Token"; | 
| 67 |  |  |  |  |  |  | } | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | # Create an LWP UserAgent for REST requests | 
| 70 | 2 |  |  |  |  | 8 | my %attributes = ( | 
| 71 |  |  |  |  |  |  | agent => "p5-WebService-Discord-Webhook (https://github.com/greg-kennedy/p5-WebService-Discord-Webhook, $VERSION)" | 
| 72 |  |  |  |  |  |  | ); | 
| 73 | 2 | 50 |  |  |  | 9 | if ( $params{timeout} )    { $attributes{timeout}    = $params{timeout} } | 
|  | 0 |  |  |  |  | 0 |  | 
| 74 | 2 | 50 |  |  |  | 4 | if ( $params{verify_SSL} ) { $attributes{verify_SSL} = $params{verify_SSL} } | 
|  | 0 |  |  |  |  | 0 |  | 
| 75 |  |  |  |  |  |  |  | 
| 76 | 2 |  |  |  |  | 11 | my $http = HTTP::Tiny->new(%attributes); | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | # create class with some params | 
| 79 | 2 |  |  |  |  | 157 | my $self = bless { id => $id, token => $token, http => $http }, $class; | 
| 80 | 2 | 50 |  |  |  | 6 | if ( $params{wait} ) { $self->{wait} = 1 } | 
|  | 0 |  |  |  |  | 0 |  | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | # call get to populate additional details | 
| 83 |  |  |  |  |  |  | #$self->get(); | 
| 84 |  |  |  |  |  |  |  | 
| 85 | 2 |  |  |  |  | 13 | return $self; | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | # updates internal structures after a webhook request | 
| 89 |  |  |  |  |  |  | sub _parse_response { | 
| 90 | 0 |  |  | 0 |  | 0 | my $self = shift; | 
| 91 | 0 |  |  |  |  | 0 | my $json = shift; | 
| 92 |  |  |  |  |  |  |  | 
| 93 | 0 |  |  |  |  | 0 | my $response = decode_json($json); | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | # sanity | 
| 96 | 0 | 0 |  |  |  | 0 | if ( $self->{id} ne $response->{id} ) { | 
| 97 |  |  |  |  |  |  | croak "SERVICE ERROR: get() returned ID='" | 
| 98 |  |  |  |  |  |  | . $response->{id} | 
| 99 |  |  |  |  |  |  | . "', expected ID='" | 
| 100 | 0 |  |  |  |  | 0 | . $self->{id} . "'"; | 
| 101 |  |  |  |  |  |  | } | 
| 102 | 0 | 0 |  |  |  | 0 | if ( $self->{token} ne $response->{token} ) { | 
| 103 |  |  |  |  |  |  | croak "SERVICE ERROR: get() returned Token='" | 
| 104 |  |  |  |  |  |  | . $response->{token} | 
| 105 |  |  |  |  |  |  | . "', expected Token='" | 
| 106 | 0 |  |  |  |  | 0 | . $self->{token} . "'"; | 
| 107 |  |  |  |  |  |  | } | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | # store / update details | 
| 110 | 0 | 0 |  |  |  | 0 | if ( $response->{guild_id} ) { | 
| 111 | 0 |  |  |  |  | 0 | $self->{guild_id} = $response->{guild_id}; | 
| 112 |  |  |  |  |  |  | } else { | 
| 113 | 0 |  |  |  |  | 0 | delete $self->{guild_id}; | 
| 114 |  |  |  |  |  |  | } | 
| 115 | 0 |  |  |  |  | 0 | $self->{channel_id} = $response->{channel_id}; | 
| 116 | 0 |  |  |  |  | 0 | $self->{name}       = $response->{name}; | 
| 117 | 0 |  |  |  |  | 0 | $self->{avatar}     = $response->{avatar}; | 
| 118 |  |  |  |  |  |  |  | 
| 119 | 0 |  |  |  |  | 0 | return $response; | 
| 120 |  |  |  |  |  |  | } | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | # GET request | 
| 123 |  |  |  |  |  |  | #  Retrieves some info about the webhook setup | 
| 124 |  |  |  |  |  |  | #  No parameters | 
| 125 |  |  |  |  |  |  | sub get { | 
| 126 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 127 |  |  |  |  |  |  |  | 
| 128 | 0 |  |  |  |  | 0 | my $url = $BASE_URL . '/webhooks/' . $self->{id} . '/' . $self->{token}; | 
| 129 |  |  |  |  |  |  |  | 
| 130 | 0 |  |  |  |  | 0 | my $response = $self->{http}->get($url); | 
| 131 | 0 | 0 |  |  |  | 0 | if ( !$response->{success} ) { | 
|  |  | 0 |  |  |  |  |  | 
| 132 |  |  |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | # non-200 code returned | 
| 134 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->get($url) returned error\n" | 
| 135 |  |  |  |  |  |  | . "\tcode: " . $response->{status} . " " . $response->{reason} . "\n" | 
| 136 | 0 |  |  |  |  | 0 | . "\tcontent: " . $response->{content}; | 
| 137 |  |  |  |  |  |  | } elsif ( !$response->{content} ) { | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | # empty result | 
| 140 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->get($url) returned empty response\n" | 
| 141 | 0 |  |  |  |  | 0 | . "\tcode: " . $response->{status} . " " . $response->{reason}; | 
| 142 |  |  |  |  |  |  | } | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | # update internal structs and return | 
| 145 | 0 |  |  |  |  | 0 | return $self->_parse_response( $response->{content} ); | 
| 146 |  |  |  |  |  |  | } | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | # PATCH request | 
| 149 |  |  |  |  |  |  | #  Allows webhook to alter its Name or Avatar | 
| 150 |  |  |  |  |  |  | sub modify { | 
| 151 | 2 |  |  | 2 | 1 | 621 | my $self = shift; | 
| 152 |  |  |  |  |  |  |  | 
| 153 | 2 |  |  |  |  | 4 | my %params; | 
| 154 | 2 | 50 |  |  |  | 7 | if ( @_ > 1 ) { | 
| 155 | 2 |  |  |  |  | 7 | %params = @_; | 
| 156 |  |  |  |  |  |  | } else { | 
| 157 | 0 |  |  |  |  | 0 | $params{name} = shift; | 
| 158 |  |  |  |  |  |  | } | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | # check params | 
| 161 | 2 | 100 | 66 |  |  | 15 | if ( !( $params{name} || exists $params{avatar} ) ) { | 
| 162 | 1 |  |  |  |  | 117 | croak "PARAMETER ERROR: Modify request with no valid parameters"; | 
| 163 |  |  |  |  |  |  | } | 
| 164 |  |  |  |  |  |  |  | 
| 165 | 1 |  |  |  |  | 3 | my %request; | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | # retrieve the two allowed params and place in request if needed | 
| 168 | 1 | 50 |  |  |  | 4 | if ( $params{name} ) { $request{name} = $params{name} } | 
|  | 0 |  |  |  |  | 0 |  | 
| 169 |  |  |  |  |  |  |  | 
| 170 | 1 | 50 |  |  |  | 4 | if ( exists $params{avatar} ) { | 
| 171 | 1 | 50 |  |  |  | 3 | if ( $params{avatar} ) { | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | # try to infer type from data string | 
| 174 | 1 |  |  |  |  | 2 | my $type; | 
| 175 | 1 | 50 | 33 |  |  | 12 | if ( | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | substr( $params{avatar}, 0, 8 ) eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" ) | 
| 177 |  |  |  |  |  |  | { | 
| 178 | 0 |  |  |  |  | 0 | $type = 'image/png'; | 
| 179 |  |  |  |  |  |  | } elsif ( substr( $params{avatar}, 0, 2 ) eq "\xff\xd8" | 
| 180 |  |  |  |  |  |  | && substr( $params{avatar}, -2 ) eq "\xff\xd9" ) | 
| 181 |  |  |  |  |  |  | { | 
| 182 | 0 |  |  |  |  | 0 | $type = 'image/jpeg'; | 
| 183 |  |  |  |  |  |  | } elsif ( substr( $params{avatar}, 0, 4 ) eq 'GIF8' ) { | 
| 184 | 0 |  |  |  |  | 0 | $type = 'image/gif'; | 
| 185 |  |  |  |  |  |  | } else { | 
| 186 | 1 |  |  |  |  | 75 | croak | 
| 187 |  |  |  |  |  |  | "PARAMETER ERROR: Could not determine image type from data (not a valid png, jpeg or gif image)"; | 
| 188 |  |  |  |  |  |  | } | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | $request{avatar} = | 
| 191 | 0 |  |  |  |  | 0 | 'data:' . $type . ';base64,' . encode_base64( $params{avatar} ); | 
| 192 |  |  |  |  |  |  | } else { | 
| 193 | 0 |  |  |  |  | 0 | $request{avatar} = undef; | 
| 194 |  |  |  |  |  |  | } | 
| 195 |  |  |  |  |  |  | } | 
| 196 |  |  |  |  |  |  |  | 
| 197 | 0 |  |  |  |  | 0 | my $url = $BASE_URL . '/webhooks/' . $self->{id} . '/' . $self->{token}; | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | # PATCH method not yet built-in as of 0.076 | 
| 200 |  |  |  |  |  |  | #my $response = $self->{http}->patch($url, \%request); | 
| 201 |  |  |  |  |  |  | my $response = $self->{http}->request( | 
| 202 | 0 |  |  |  |  | 0 | 'PATCH', $url, | 
| 203 |  |  |  |  |  |  | { | 
| 204 |  |  |  |  |  |  | headers => { 'Content-Type' => 'application/json' }, | 
| 205 |  |  |  |  |  |  | content => encode_json( \%request ) | 
| 206 |  |  |  |  |  |  | } | 
| 207 |  |  |  |  |  |  | ); | 
| 208 | 0 | 0 |  |  |  | 0 | if ( !$response->{success} ) { | 
|  |  | 0 |  |  |  |  |  | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | # non-200 code returned | 
| 211 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->patch($url) returned error\n" | 
| 212 |  |  |  |  |  |  | . "\tcode: " . $response->{status} . " " . $response->{reason} . "\n" | 
| 213 | 0 |  |  |  |  | 0 | . "\tcontent: " . $response->{content}; | 
| 214 |  |  |  |  |  |  | } elsif ( !$response->{content} ) { | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | # empty result | 
| 217 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->patch($url) returned empty response\n" | 
| 218 | 0 |  |  |  |  | 0 | . "\tcode: " . $response->{status} . " " . $response->{reason}; | 
| 219 |  |  |  |  |  |  | } | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | # update internal structs and return | 
| 222 | 0 |  |  |  |  | 0 | return $self->_parse_response( $response->{content} ); | 
| 223 |  |  |  |  |  |  | } | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | # DELETE request - deletes the webhook | 
| 226 |  |  |  |  |  |  | sub destroy { | 
| 227 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 228 |  |  |  |  |  |  |  | 
| 229 | 0 |  |  |  |  | 0 | my $url = $BASE_URL . '/webhooks/' . $self->{id} . '/' . $self->{token}; | 
| 230 |  |  |  |  |  |  |  | 
| 231 | 0 |  |  |  |  | 0 | my $response = $self->{http}->delete($url); | 
| 232 | 0 | 0 |  |  |  | 0 | if ( !$response->{success} ) { | 
| 233 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->delete($url) returned error\n" | 
| 234 |  |  |  |  |  |  | . "\tcode: " . $response->{status} . " " . $response->{reason} . "\n" | 
| 235 | 0 |  |  |  |  | 0 | . "\tcontent: " . $response->{content}; | 
| 236 |  |  |  |  |  |  | } | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | # DELETE response is 204 NO CONTENT, so there is no return code. | 
| 239 |  |  |  |  |  |  | } | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | # EXECUTE - posts the message. | 
| 242 |  |  |  |  |  |  | # Required parameters: one of | 
| 243 |  |  |  |  |  |  | #  content | 
| 244 |  |  |  |  |  |  | #  files | 
| 245 |  |  |  |  |  |  | #  embeds | 
| 246 |  |  |  |  |  |  | # Optional paremeters: | 
| 247 |  |  |  |  |  |  | #  username | 
| 248 |  |  |  |  |  |  | #  avatar_url | 
| 249 |  |  |  |  |  |  | #  tts | 
| 250 |  |  |  |  |  |  | #  allowed_mentions | 
| 251 |  |  |  |  |  |  | sub execute { | 
| 252 | 2 |  |  | 2 | 1 | 1227 | my $self = shift; | 
| 253 |  |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | # extract params | 
| 255 | 2 |  |  |  |  | 4 | my %params; | 
| 256 | 2 | 50 |  |  |  | 7 | if ( @_ > 1 ) { | 
| 257 | 2 |  |  |  |  | 7 | %params = @_; | 
| 258 |  |  |  |  |  |  | } else { | 
| 259 | 0 |  |  |  |  | 0 | $params{content} = shift; | 
| 260 |  |  |  |  |  |  | } | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | # convenience params | 
| 263 | 2 | 100 |  |  |  | 6 | if ( $params{file} )  { $params{files}  = [ delete $params{file} ] } | 
|  | 1 |  |  |  |  | 3 |  | 
| 264 | 2 | 100 |  |  |  | 7 | if ( $params{embed} ) { $params{embeds} = [ delete $params{embed} ] } | 
|  | 1 |  |  |  |  | 3 |  | 
| 265 |  |  |  |  |  |  |  | 
| 266 |  |  |  |  |  |  | # test required fields | 
| 267 | 2 | 100 | 66 |  |  | 20 | if ( !( $params{content} || $params{files} || $params{embeds} ) ) { | 
|  |  | 50 | 33 |  |  |  |  | 
| 268 | 1 |  |  |  |  | 78 | croak | 
| 269 |  |  |  |  |  |  | "PARAMETER ERROR: Execute request missing required parameters (must have at least content, embed, or file)"; | 
| 270 |  |  |  |  |  |  | } elsif ( $params{embeds} && $params{files} ) { | 
| 271 | 1 |  |  |  |  | 128 | croak | 
| 272 |  |  |  |  |  |  | "PARAMETER ERROR: Execute request cannot combine file and embed request in one call."; | 
| 273 |  |  |  |  |  |  | } | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | # construct JSON request | 
| 276 | 0 |  |  |  |  |  | my %request; | 
| 277 |  |  |  |  |  |  |  | 
| 278 |  |  |  |  |  |  | # all messages types may have these params | 
| 279 | 0 | 0 |  |  |  |  | if ( $params{content} ) { $request{content} = $params{content} } | 
|  | 0 |  |  |  |  |  |  | 
| 280 |  |  |  |  |  |  |  | 
| 281 | 0 | 0 |  |  |  |  | if ( $params{username} )   { $request{username}   = $params{username} } | 
|  | 0 |  |  |  |  |  |  | 
| 282 | 0 | 0 |  |  |  |  | if ( $params{avatar_url} ) { $request{avatar_url} = $params{avatar_url} } | 
|  | 0 |  |  |  |  |  |  | 
| 283 | 0 | 0 |  |  |  |  | if ( $params{tts} )        { $request{tts}        = JSON::PP::true } | 
|  | 0 |  |  |  |  |  |  | 
| 284 | 0 | 0 |  |  |  |  | if ( $params{allowed_mentions} ) { $request{allowed_mentions} = $params{allowed_mentions} } | 
|  | 0 |  |  |  |  |  |  | 
| 285 |  |  |  |  |  |  |  | 
| 286 |  |  |  |  |  |  | # compose URL | 
| 287 | 0 |  |  |  |  |  | my $url = $BASE_URL . '/webhooks/' . $self->{id} . '/' . $self->{token}; | 
| 288 | 0 | 0 |  |  |  |  | if ( $self->{wait} ) { $url .= '?wait=true' } | 
|  | 0 |  |  |  |  |  |  | 
| 289 |  |  |  |  |  |  |  | 
| 290 |  |  |  |  |  |  | # switch mode for request based on file upload or no | 
| 291 | 0 |  |  |  |  |  | my $response; | 
| 292 | 0 | 0 |  |  |  |  | if ( !$params{files} ) { | 
| 293 |  |  |  |  |  |  |  | 
| 294 |  |  |  |  |  |  | # This is a regular, no-fuss JSON request | 
| 295 | 0 | 0 |  |  |  |  | if ( $params{embeds} ) { $request{embeds} = $params{embeds} } | 
|  | 0 |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  | $response = $self->{http}->post( | 
| 298 | 0 |  |  |  |  |  | $url, | 
| 299 |  |  |  |  |  |  | { | 
| 300 |  |  |  |  |  |  | headers => { 'Content-Type' => 'application/json' }, | 
| 301 |  |  |  |  |  |  | content => encode_json( \%request ) | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  | ); | 
| 304 |  |  |  |  |  |  | } else { | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  | # File upload, construct a multipart/form-data message | 
| 307 |  |  |  |  |  |  | #  32 random chars to make a boundary | 
| 308 | 0 |  |  |  |  |  | my @chars    = ( 'A' .. 'Z', 'a' .. 'z', '0' .. '9' ); | 
| 309 | 0 |  |  |  |  |  | my $boundary = ''; | 
| 310 | 0 |  |  |  |  |  | for ( 0 .. 31 ) { | 
| 311 | 0 |  |  |  |  |  | $boundary .= $chars[ rand @chars ]; | 
| 312 |  |  |  |  |  |  | } | 
| 313 |  |  |  |  |  |  |  | 
| 314 |  |  |  |  |  |  | # Build request body | 
| 315 | 0 |  |  |  |  |  | my $content = ''; | 
| 316 |  |  |  |  |  |  |  | 
| 317 | 0 |  |  |  |  |  | for my $i ( 0 .. $#{ $params{files} } ) { | 
|  | 0 |  |  |  |  |  |  | 
| 318 | 0 |  |  |  |  |  | my $file = $params{files}[$i]; | 
| 319 | 0 |  |  |  |  |  | $content .= "\r\n--$boundary\r\n"; | 
| 320 |  |  |  |  |  |  | $content .= | 
| 321 |  |  |  |  |  |  | "Content-Disposition: form-data; name=\"file$i\"; filename=\"" | 
| 322 |  |  |  |  |  |  | . $file->{name} | 
| 323 | 0 |  |  |  |  |  | . "\"\r\n"; | 
| 324 |  |  |  |  |  |  |  | 
| 325 |  |  |  |  |  |  | # Discord ignores content-type, just put octet-stream for everything | 
| 326 | 0 |  |  |  |  |  | $content .= "Content-Type: application/octet-stream\r\n"; | 
| 327 | 0 |  |  |  |  |  | $content .= "\r\n"; | 
| 328 | 0 |  |  |  |  |  | $content .= $file->{data} . "\r\n"; | 
| 329 |  |  |  |  |  |  | } | 
| 330 |  |  |  |  |  |  |  | 
| 331 |  |  |  |  |  |  | # add the json payload for the rest of the message | 
| 332 | 0 |  |  |  |  |  | $content .= "\r\n--$boundary\r\n"; | 
| 333 | 0 |  |  |  |  |  | $content .= "Content-Disposition: form-data; name=\"payload_json\";\r\n"; | 
| 334 | 0 |  |  |  |  |  | $content .= "Content-Type: application/json\r\n"; | 
| 335 | 0 |  |  |  |  |  | $content .= "\r\n"; | 
| 336 | 0 |  |  |  |  |  | $content .= encode_json( \%request ) . "\r\n"; | 
| 337 |  |  |  |  |  |  |  | 
| 338 | 0 |  |  |  |  |  | $content .= "\r\n--$boundary--\r\n"; | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  | $response = $self->{http}->post( | 
| 341 | 0 |  |  |  |  |  | $url, | 
| 342 |  |  |  |  |  |  | { | 
| 343 |  |  |  |  |  |  | headers => | 
| 344 |  |  |  |  |  |  | { 'Content-Type' => "multipart/form-data; boundary=$boundary" }, | 
| 345 |  |  |  |  |  |  | content => $content | 
| 346 |  |  |  |  |  |  | } | 
| 347 |  |  |  |  |  |  | ); | 
| 348 |  |  |  |  |  |  | } | 
| 349 |  |  |  |  |  |  |  | 
| 350 | 0 | 0 |  |  |  |  | if ( !$response->{success} ) { | 
| 351 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->post($url) returned error\n" | 
| 352 |  |  |  |  |  |  | . "\tcode: " . $response->{status} . " " . $response->{reason} . "\n" | 
| 353 | 0 |  |  |  |  |  | . "\tcontent: " . $response->{content}; | 
| 354 |  |  |  |  |  |  | } | 
| 355 |  |  |  |  |  |  |  | 
| 356 |  |  |  |  |  |  | # return details, or just true if content is empty (wait=0) | 
| 357 | 0 | 0 |  |  |  |  | if ( $response->{content} ) { return decode_json( $response->{content} ) } | 
|  | 0 |  |  |  |  |  |  | 
| 358 |  |  |  |  |  |  | } | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | sub execute_slack { | 
| 361 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 362 |  |  |  |  |  |  |  | 
| 363 | 0 |  |  |  |  |  | my $json; | 
| 364 | 0 | 0 |  |  |  |  | if ( @_ > 1 ) { | 
| 365 | 0 |  |  |  |  |  | my %params = @_; | 
| 366 | 0 |  |  |  |  |  | $json = encode_json( \%params ); | 
| 367 |  |  |  |  |  |  | } else { | 
| 368 | 0 |  |  |  |  |  | $json = shift; | 
| 369 |  |  |  |  |  |  | } | 
| 370 |  |  |  |  |  |  |  | 
| 371 |  |  |  |  |  |  | # create a slack-format post url | 
| 372 |  |  |  |  |  |  | my $url = | 
| 373 | 0 |  |  |  |  |  | $BASE_URL . '/webhooks/' . $self->{id} . '/' . $self->{token} . '/slack'; | 
| 374 | 0 | 0 |  |  |  |  | if ( $self->{wait} ) { $url .= '?wait=true' } | 
|  | 0 |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  |  | 
| 376 | 0 |  |  |  |  |  | my $response = $self->{http}->post( $url, | 
| 377 |  |  |  |  |  |  | { headers => { 'Content-Type' => 'application/json' }, content => $json } ); | 
| 378 | 0 | 0 |  |  |  |  | if ( !$response->{success} ) { | 
| 379 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->post($url) returned error\n" | 
| 380 |  |  |  |  |  |  | . "\tcode: " . $response->{status} . " " . $response->{reason} . "\n" | 
| 381 | 0 |  |  |  |  |  | . "\tcontent: " . $response->{content}; | 
| 382 |  |  |  |  |  |  | } | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | # return details, or just undef if content is empty (wait=0) | 
| 385 |  |  |  |  |  |  | #  Slack request usually returns the string "ok" | 
| 386 | 0 | 0 |  |  |  |  | if ( $response->{content} ) { return $response->{content} } | 
|  | 0 |  |  |  |  |  |  | 
| 387 |  |  |  |  |  |  | } | 
| 388 |  |  |  |  |  |  |  | 
| 389 |  |  |  |  |  |  | sub execute_github { | 
| 390 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 391 |  |  |  |  |  |  |  | 
| 392 | 0 |  |  |  |  |  | my %params = @_; | 
| 393 |  |  |  |  |  |  |  | 
| 394 |  |  |  |  |  |  | # check params | 
| 395 | 0 | 0 | 0 |  |  |  | if ( !( $params{event} && $params{json} ) ) { | 
| 396 | 0 |  |  |  |  |  | croak | 
| 397 |  |  |  |  |  |  | "PARAMETER ERROR: execute_github missing required event and json parameters"; | 
| 398 |  |  |  |  |  |  | } | 
| 399 |  |  |  |  |  |  |  | 
| 400 |  |  |  |  |  |  | # create a github-format post url | 
| 401 |  |  |  |  |  |  | my $url = | 
| 402 | 0 |  |  |  |  |  | $BASE_URL . '/webhooks/' . $self->{id} . '/' . $self->{token} . '/github'; | 
| 403 | 0 | 0 |  |  |  |  | if ( $self->{wait} ) { $url .= '?wait=true' } | 
|  | 0 |  |  |  |  |  |  | 
| 404 |  |  |  |  |  |  |  | 
| 405 |  |  |  |  |  |  | my $response = $self->{http}->post( | 
| 406 |  |  |  |  |  |  | $url, | 
| 407 |  |  |  |  |  |  | { | 
| 408 |  |  |  |  |  |  | headers => { | 
| 409 |  |  |  |  |  |  | 'Content-Type'   => 'application/json', | 
| 410 |  |  |  |  |  |  | 'X-GitHub-Event' => $params{event} | 
| 411 |  |  |  |  |  |  | }, | 
| 412 |  |  |  |  |  |  | content => $params{json} | 
| 413 |  |  |  |  |  |  | } | 
| 414 | 0 |  |  |  |  |  | ); | 
| 415 | 0 | 0 |  |  |  |  | if ( !$response->{success} ) { | 
| 416 |  |  |  |  |  |  | croak "HTTP ERROR: HTTP::Tiny->post($url) returned error\n" | 
| 417 |  |  |  |  |  |  | . "\tcode: " . $response->{status} . " " . $response->{reason} . "\n" | 
| 418 | 0 |  |  |  |  |  | . "\tcontent: " . $response->{content}; | 
| 419 |  |  |  |  |  |  | } | 
| 420 |  |  |  |  |  |  |  | 
| 421 |  |  |  |  |  |  | # return details, or just undef if content is empty (wait=0) | 
| 422 |  |  |  |  |  |  | #  github request usually has no response | 
| 423 | 0 | 0 |  |  |  |  | if ( $response->{content} ) { return $response->{content} } | 
|  | 0 |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | } | 
| 425 |  |  |  |  |  |  |  | 
| 426 |  |  |  |  |  |  | 1; | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  | __END__ |