File Coverage

blib/lib/WebService/Discord/Webhook.pm
Criterion Covered Total %
statement 64 180 35.5
branch 27 94 28.7
condition 7 21 33.3
subroutine 10 15 66.6
pod 7 7 100.0
total 115 317 36.2


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__