bylzz
61195bd6b2
Public-facing Mojolicious app for looking up Heaven's Glaives deaths in any WCL report. The nginx vhost, rc.d script, and the runtime SQLite cache are intentionally excluded via .gitignore.
111 lines
3.1 KiB
Perl
111 lines
3.1 KiB
Perl
package WCL;
|
|
use strict;
|
|
use warnings;
|
|
use JSON::PP;
|
|
use MIME::Base64 qw(encode_base64);
|
|
use Exporter 'import';
|
|
|
|
our @EXPORT_OK = qw(
|
|
wcl_token wcl_query fetch_glaive_deaths
|
|
HEAVENS_GLAIVES_ID ENCOUNTER_NAME DIFFICULTY
|
|
);
|
|
|
|
use constant HEAVENS_GLAIVES_ID => 1254076;
|
|
use constant ENCOUNTER_NAME => 'Midnight Falls';
|
|
use constant DIFFICULTY => 5;
|
|
|
|
my $FIGHTS_QUERY = <<'GQL';
|
|
query($code: String!) {
|
|
reportData {
|
|
report(code: $code) {
|
|
startTime title
|
|
zone { name }
|
|
fights { id name difficulty }
|
|
}
|
|
}
|
|
}
|
|
GQL
|
|
|
|
my $TABLE_QUERY = <<'GQL';
|
|
query($code: String!, $fightIDs: [Int]!, $wipeCutoff: Int!) {
|
|
reportData {
|
|
report(code: $code) {
|
|
table(dataType: Deaths, fightIDs: $fightIDs, wipeCutoff: $wipeCutoff,
|
|
startTime: 0, endTime: 999999999999)
|
|
}
|
|
}
|
|
}
|
|
GQL
|
|
|
|
sub wcl_token {
|
|
my ($http, $client_id, $client_secret) = @_;
|
|
my $auth = encode_base64("$client_id:$client_secret", '');
|
|
my $resp = $http->post_form(
|
|
'https://www.warcraftlogs.com/oauth/token',
|
|
{ grant_type => 'client_credentials' },
|
|
{ headers => { Authorization => "Basic $auth" } },
|
|
);
|
|
die "WCL token request failed ($resp->{status} $resp->{reason})\n" unless $resp->{success};
|
|
return decode_json($resp->{content})->{access_token};
|
|
}
|
|
|
|
sub wcl_query {
|
|
my ($http, $token, $query, $variables) = @_;
|
|
my $resp = $http->post(
|
|
'https://www.warcraftlogs.com/api/v2/client',
|
|
{
|
|
headers => {
|
|
Authorization => "Bearer $token",
|
|
'Content-Type' => 'application/json',
|
|
},
|
|
content => encode_json({ query => $query, variables => $variables // {} }),
|
|
},
|
|
);
|
|
die "WCL query failed ($resp->{status} $resp->{reason})\n" unless $resp->{success};
|
|
my $decoded = decode_json($resp->{content});
|
|
return $decoded->{data};
|
|
}
|
|
|
|
sub epoch_to_date {
|
|
my ($epoch) = @_;
|
|
my @t = localtime($epoch);
|
|
return sprintf '%04d-%02d-%02d', $t[5] + 1900, $t[4] + 1, $t[3];
|
|
}
|
|
|
|
sub fetch_glaive_deaths {
|
|
my ($http, $token, $code, $wipe_cutoff) = @_;
|
|
|
|
my $fdata = wcl_query($http, $token, $FIGHTS_QUERY, { code => $code });
|
|
my $report = $fdata->{reportData}{report};
|
|
return undef unless $report;
|
|
|
|
my @fight_ids = map { $_->{id} }
|
|
grep { $_->{name} eq ENCOUNTER_NAME && ($_->{difficulty} // -1) == DIFFICULTY }
|
|
@{ $report->{fights} };
|
|
|
|
my @deaths;
|
|
if (@fight_ids) {
|
|
my $tdata = wcl_query($http, $token, $TABLE_QUERY, {
|
|
code => $code,
|
|
fightIDs => \@fight_ids,
|
|
wipeCutoff => $wipe_cutoff,
|
|
});
|
|
my $entries = $tdata->{reportData}{report}{table}{data}{entries} // [];
|
|
for my $e (@$entries) {
|
|
my $kb = $e->{killingBlow} or next;
|
|
next unless ($kb->{guid} // -1) == HEAVENS_GLAIVES_ID;
|
|
push @deaths, $e->{name};
|
|
}
|
|
}
|
|
|
|
return {
|
|
title => $report->{title},
|
|
raid_date => epoch_to_date($report->{startTime} / 1000),
|
|
zone_name => $report->{zone}{name} // 'Unknown',
|
|
fight_count => scalar(@fight_ids),
|
|
deaths => \@deaths,
|
|
};
|
|
}
|
|
|
|
1;
|