git.sesse.net Git - skvidarsync/blob - bin/sync.pl

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 no warnings qw(once);
   5 use Crypt::JWT;
   6 use JSON::XS;
   7 use LWP::UserAgent;
   8 use DBI;
   9 use POSIX;
  10 use Time::HiRes;
  11 use IO::Select;
  12 use Unicode::Collate;
  13 use IO::Socket::SSL;
  14 binmode STDOUT, ':utf8';
  15 binmode STDERR, ':utf8';
  16 use utf8;
  17
  18 require '../include/config.pm';
  19
  20 my $global_ctx = IO::Socket::SSL::SSL_Context->new(
  21         SSL_session_cache_size => 100,  # Probably overkill.
  22 );
  23 IO::Socket::SSL::set_default_context($global_ctx);
  24
  25 my @log = ();
  26 my $uca = Unicode::Collate->new(level => 1);
  27
  28 my %rgb = (
  29         yellow => {
  30                 red => 1,
  31                 green => 1,
  32                 blue => 0,
  33                 alpha => 1
  34         },
  35         orange => {
  36                 red => 0xf9 / 255.0,
  37                 green => 0xcb / 255.0,
  38                 blue => 0x9c / 255.0,
  39                 alpha => 1
  40         },
  41         blue => {
  42                 red => 0,
  43                 green => 1,
  44                 blue => 1,
  45                 alpha => 1
  46         },
  47         white => {
  48                 red => 1,
  49                 green => 1,
  50                 blue => 1,
  51                 alpha => 0
  52         }
  53 );
  54
  55 sub log_timing {
  56         my ($start, $msg) = @_;
  57         my $elapsed = Time::HiRes::tv_interval($start);
  58         printf "%s: %.0f ms.\n", $msg, 1e3 * $elapsed;
  59 }
  60
  61 # Unicode::Collate is seemingly slow, so add a cache for each name part
  62 # (which, of course, only works for equality). Helps especially in
  63 # --daemon mode, where even the first request gets a warm cache.
  64 my %sort_key_cache = ();
  65 my $sort_key_sp = $uca->getSortKey(' ');
  66
  67 sub sort_key {
  68         my $m = shift;
  69         my $sk;
  70         for my $part (split /\s+/, $m) {
  71                 my $psk = \$sort_key_cache{$part};
  72                 if (!defined($$psk)) {
  73                         $$psk = $uca->getSortKey($part);
  74                 }
  75                 if (defined($sk)) {
  76                         $sk .= $sort_key_sp;
  77                         $sk .= $$psk;
  78                 } else {
  79                         $sk = $$psk;
  80                 }
  81         }
  82         return $sk;
  83 }
  84
  85 sub get_oauth_bearer_token {
  86         my ($dbh, $ua) = @_;
  87         my $now = time();
  88
  89         # See if the database already has a token we could use, that doesn't expire in a while.
  90         my $ref = $dbh->selectrow_hashref('SELECT token FROM oauth_tokens WHERE expiry - (TIMESTAMPTZ \'1970-01-01\' + ? * INTERVAL \'1 second\') > INTERVAL \'1 minute\' ORDER BY expiry DESC LIMIT 1', undef, $now);
  91         if (defined($ref->{'token'})) {
  92                 return $ref->{'token'};
  93         }
  94
  95         my $jwt = JSON::XS::encode_json({
  96                 "iss" => $config::jwt_key->{'client_email'},
  97                 "scope" => "https://www.googleapis.com/auth/spreadsheets",
  98                 "aud" => "https://www.googleapis.com/oauth2/v4/token",
  99                 "exp" => $now + 1800,
 100                 "iat" => $now,
 101         });
 102         my $jws_token = Crypt::JWT::encode_jwt(payload=>$jwt, alg=>'RS256', key=>\$config::jwt_key->{'private_key'});
 103         my $start = [Time::HiRes::gettimeofday];
 104         my $response = $ua->post('https://www.googleapis.com/oauth2/v4/token', [
 105                 'grant_type' => 'urn:ietf:params:oauth:grant-type:jwt-bearer',
 106                 'assertion' => $jws_token ]);
 107         log_timing($start, '/oauth2/v4/token');
 108         my $token = JSON::XS::decode_json($response->decoded_content)->{'access_token'};
 109         $dbh->do('INSERT INTO oauth_tokens (token, acquired, expiry) VALUES (?, TIMESTAMPTZ \'1970-01-01\' + ? * INTERVAL \'1 second\', TIMESTAMPTZ \'1970-01-01\' + ? * INTERVAL \'1 second\')',
 110                 undef, $token, $now, $now + 1800);
 111         return $token;
 112 }
 113
 114 sub get_slack_name {
 115         my ($ua, $userid) = @_;
 116         my $req = HTTP::Request->new('GET', 'https://slack.com/api/users.info?user=' . $userid, [
 117                'Authorization' => 'Bearer ' . $config::slack_oauth_token
 118         ]);
 119         my $start = [Time::HiRes::gettimeofday];
 120         my $response = $ua->request($req);
 121         log_timing($start, '/users.info');
 122         die $response->status_line if !$response->is_success;
 123
 124         my $user_json = JSON::XS::decode_json($response->decoded_content);
 125         die "Something went wrong: " . $response->decoded_content if (!defined($user_json) || !$user_json->{'ok'});
 126
 127         return $user_json->{'user'}{'real_name'};
 128 }
 129
 130 sub get_spreadsheet_name {
 131         my $cell = shift;
 132         my $name = $cell->{'userEnteredValue'}{'stringValue'};
 133         return undef if (!defined($name));
 134         return undef if ($name =~ /^G[1-4]\.[1-5]/);
 135         return undef if ($name =~ /^1r/);
 136         $name =~ s/🆕//;
 137         $name =~ s/\(.*\)//g;
 138         $name =~ s/\[.*\]//g;
 139         $name =~ s/ - .*//;
 140         $name =~ s/G\d\.\d?\??//;
 141         $name =~ s/\?//g;
 142         $name =~ s/\s*$//;
 143         $name =~ s/^\s*//;
 144         return $name;
 145 }
 146
 147 sub matches_name {
 148         my ($slack_name, $spreadsheet_name, $ap) = @_;
 149
 150         # No need to check for an exact match; we already did that through $seen_names.
 151         # if (sort_key($slack_name) eq sort_key($spreadsheet_name)) {
 152         #       return 1;
 153         # }
 154
 155         # @ap is precalculated by the caller.
 156         # my @ap = map { sort_key($_) } split /\s+/, $slack_name;
 157         my @bp = map { sort_key($_) } split /\s+/, $spreadsheet_name;
 158         if (scalar @$ap >= 2 && scalar @bp >= 2 && $ap->[0] eq $bp[0]) {
 159                 # First name matches, try to match some surname
 160                 my $found = 0;
 161                 for my $ai (1..(scalar @$ap - 1)) {
 162                         for my $bi (1..$#bp) {
 163                                 $found = 1 if ($ap->[$ai] eq $bp[$bi]);
 164                         }
 165                 }
 166                 if ($found) {
 167                         skv_log("Fuzzy-matchet $slack_name -> $spreadsheet_name.");
 168                         return 1;
 169                 }
 170         }
 171
 172         return 0;
 173 }
 174
 175 sub format_cell_names_for_seen {
 176         my $seen = shift;
 177         my @cells = map { chr(ord('A') + $_->[2]) . ($_->[1] + 1) } @$seen;
 178         return join(', ', @cells);
 179 }
 180
 181 sub skv_log {
 182         my $msg = shift;
 183         print STDERR "$msg\n";
 184         push @log, $msg;
 185 }
 186
 187 sub serialize_skv_log_to_sheet {
 188         return {
 189                 updateCells => {
 190                         rows => [{
 191                                 values => [{
 192                                         userEnteredValue => { stringValue => join("\n", @log) }
 193                                 }]
 194                         }],
 195                         fields => 'userEnteredValue.stringValue',
 196                         range => {
 197                                 sheetId => $config::log_tab_id,
 198                                 startRowIndex => 0,
 199                                 endRowIndex => 1,
 200                                 startColumnIndex => 0,
 201                                 endColumnIndex => 1
 202                         }
 203                 }
 204         };
 205 }
 206
 207 sub sheet_batch_update {
 208         my ($ua, $token, @requests) = @_;
 209         my $update = {
 210                 requests => \@requests
 211         };
 212         my $start = [Time::HiRes::gettimeofday];
 213         my $response = $ua->post(
 214                 'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . ':batchUpdate?key=' . $config::gsheets_api_key,
 215                 Content => JSON::XS::encode_json($update),
 216                 Content_type => 'application/json;charset=UTF-8',
 217                 Authorization => 'Bearer ' . $token
 218         );
 219         log_timing($start, '/spreadsheets/values:batchUpdate');
 220         die $response->decoded_content if !$response->is_success;
 221 }
 222
 223 sub get_group_assignments {
 224         my $json = shift;
 225
 226         my %assignments = ();
 227         my $rows = $json->{'data'}[0]{'rowData'};
 228         my @curr_groups = ();
 229         for my $row (@$rows) {
 230                 my $col = 0;
 231                 for my $val (@{$row->{'values'}}) {
 232                         ++$col;
 233                         my $contents = $val->{'userEnteredValue'}{'stringValue'};
 234                         next if !defined($contents);
 235                         if ($contents =~ /Gruppe /) {
 236                                 @curr_groups = ();
 237                                 last;
 238                         }
 239                         next if $contents =~ /^VL:/;
 240                         next if $contents =~ /^LT\b/;
 241                         next if $contents =~ /^400m/;
 242                         next if $contents =~ /^546m/;
 243                         next if $contents =~ /^1r/;
 244                         if ($contents =~ /^(G\d\.\d)/ || $contents =~ /^(Nye løpere.*)/) {
 245                                 $curr_groups[$col] = $1;
 246                         } else {
 247                                 my $name = get_spreadsheet_name($val);
 248                                 next if (!defined($name));
 249                                 my $group = $curr_groups[$col] // $curr_groups[$col - 1];
 250                                 # print $group, " ", $name, "\n";
 251                                 if (exists($assignments{$name})) {
 252                                         $assignments{$name} = "(flere grupper)";
 253                                 } else {
 254                                         $assignments{$name} = $group;
 255                                 }
 256                         }
 257                 }
 258         }
 259         return %assignments;
 260 }
 261
 262 sub update_assignment_db {
 263         my ($dbh, $channel, $ts, $assignments) = @_;
 264
 265         my %db_assignments = ();
 266         my $q = $dbh->prepare('SELECT name,group_name FROM current_group_membership_history WHERE channel=? AND ts=?');
 267         $q->execute($channel, $ts);
 268         while (my $ref = $q->fetchrow_hashref) {
 269                 if (defined($ref->{'group_name'})) {
 270                         $db_assignments{$ref->{'name'}} = $ref->{'group_name'};
 271                 }
 272         }
 273
 274         $q = $dbh->prepare('INSERT INTO group_membership_history (channel, ts, name, change_seen, group_name) VALUES (?, ?, ?, CURRENT_TIMESTAMP, ?)');
 275         for my $name (keys %$assignments) {
 276                 if (!exists($db_assignments{$name}) || $db_assignments{$name} ne $assignments->{$name}) {
 277                         $q->execute($channel, $ts, $name, $assignments->{$name});
 278                 }
 279         }
 280         for my $name (keys %db_assignments) {
 281                 if (!exists($assignments->{$name})) {
 282                         $q->execute($channel, $ts, $name, undef);
 283                 }
 284         }
 285 }
 286
 287 sub get_spreadsheet_with_title {
 288         my ($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title) = @_;
 289
 290         # See if we have any spreadsheets that match this title.
 291         my $start = [Time::HiRes::gettimeofday];
 292         my $response = $ua->get('https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '?key=' . $config::gsheets_api_key . '&fields=sheets/properties',
 293                 Authorization => 'Bearer ' . $token,
 294                 Accept_Encoding => HTTP::Message::decodable
 295         );
 296         log_timing($start, '/spreadsheets/properties');
 297         my $sheets_json = JSON::XS::decode_json($response->decoded_content);
 298         my ($tab_name, $tab_id);
 299         for my $sheet (@{$sheets_json->{'sheets'}}) {
 300                 my $title = $sheet->{'properties'}{'title'};
 301                 my $sheet_id = $sheet->{'properties'}{'sheetId'};
 302                 if ($title =~ /\Q$wanted_sheet_title\E/) {
 303                         # skv_log("Synkroniserer ($config::invitation_channel, $invitation_ts) mot arket “$title” (fane-ID $sheet_id).");
 304                         $dbh->do('UPDATE message_sheet_link SET tab_name=?, tab_id=? WHERE channel=? AND ts=?',
 305                                 undef, $title, $sheet_id, $config::invitation_channel, $invitation_ts);
 306                         return ($title, $sheet_id);
 307                 }
 308         }
 309         return (undef, undef);
 310 }
 311
 312 # Make a mapping of lowercase name -> list of [canonical name, row number, column number]
 313 sub find_where_each_name_is {
 314         my $json = shift;
 315
 316         my %seen_names = ();
 317         my $rows = $json->{'data'}[0]{'rowData'};
 318         my $rowno = 3;
 319         for my $row (@$rows) {
 320                 my $colno = 0;
 321                 for my $val (@{$row->{'values'}}) {
 322                         my $name = get_spreadsheet_name($val);
 323                         if (defined($name)) {
 324                                 push @{$seen_names{sort_key($name)}}, [$name, $rowno, $colno];
 325                         }
 326                         ++$colno;
 327                 }
 328                 ++$rowno;
 329         }
 330
 331         return %seen_names;
 332 }
 333
 334 sub best_name_for_log {
 335         my ($userid, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
 336         if (exists($slack_userid_to_real_name->{$userid})) {
 337                 return $slack_userid_to_real_name->{$userid};
 338         } elsif (exists($slack_userid_to_slack_name->{$userid})) {
 339                 return $slack_userid_to_slack_name->{$userid} . ' (fant ikke regneark-navn)';
 340         } else {
 341                 # Should only happen if we didn't see the initial reaction_add, only reaction_remove.
 342                 # (TODO: Is the comment above true anymore, now that we use this from multiple contexts?)
 343                 return $userid . ' (fant ikke Slack-navn)';
 344         }
 345 }
 346
 347 # Add the reaction log. (This only takes into account the last change
 348 # for each user; earlier ones are irrelevant and don't count. But it
 349 # doesn't deduplicate across reactions. Meh.)
 350 sub create_reaction_log {
 351         my ($dbh, $invitation_ts, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
 352
 353         my $q = $dbh->prepare('select userid,event_type,reaction,to_char(event_ts,\'YYYY-mm-dd HH24:MI\') as event_ts from ( select distinct on (channel,ts,userid,reaction) userid,event_type,reaction,timestamptz \'1970-01-01 utc\' + event_ts::float * interval \'1 second\' as event_ts from reaction_log where channel=? and ts=? and reaction in (\'heart\',\'open_mouth\',\'blue_heart\',\'orange_heart\') order by channel,ts,userid,reaction,event_ts desc ) t1 where event_ts > current_timestamp - interval \'8 hours\' order by event_ts desc limit 50');
 354         $q->execute($config::invitation_channel, $invitation_ts);
 355         my @recent_changes = ();
 356         while (my $ref = $q->fetchrow_hashref) {
 357                 my $msg = $ref->{'event_ts'};
 358                 if ($ref->{'event_type'} eq 'reaction_added') {
 359                         $msg .= ' +';
 360                 } else {
 361                         $msg .= ' –';
 362                 }
 363                 if ($ref->{'reaction'} eq 'open_mouth') {
 364                         $msg .= '😮';
 365                 } elsif ($ref->{'reaction'} eq 'blue_heart') {
 366                         $msg .= '💙';
 367                 } elsif ($ref->{'reaction'} eq 'orange_heart') {
 368                         $msg .= '🧡';
 369                 } else {
 370                         $msg .= '❤️';
 371                 }
 372                 $msg .= ' ';
 373                 $msg .= best_name_for_log($ref->{'userid'}, $slack_userid_to_real_name, $slack_userid_to_slack_name);
 374                 push @recent_changes, { values => [{ userEnteredValue => { stringValue => $msg } }] };
 375         }
 376         while (scalar @recent_changes < 50) {
 377                 push @recent_changes, { values => [{ userEnteredValue => { stringValue => '' } }] };
 378         }
 379         return @recent_changes;
 380 }
 381
 382 sub create_move_log {
 383          my ($dbh, $invitation_ts, $prev_invitation_ts) = @_;
 384          my $q = $dbh->prepare(<<"EOF");
 385 SELECT
 386   name, g_old.group_name as old_group, g_new.group_name as new_group, TO_CHAR(g_new.change_seen, \'YYYY-mm-dd HH24:MI\') AS change_seen
 387 FROM ( SELECT * FROM current_group_membership_history WHERE channel=? AND ts=? ) g_old
 388   FULL OUTER JOIN ( SELECT * FROM current_group_membership_history WHERE channel=? AND ts=? ) g_new USING (name)
 389 WHERE
 390   g_new.group_name IS DISTINCT FROM g_old.group_name
 391   AND g_new.group_name IS NOT NULL
 392 ORDER BY g_new.change_seen DESC, name
 393 LIMIT 50
 394 EOF
 395         $q->execute($config::invitation_channel, $prev_invitation_ts, $config::invitation_channel, $invitation_ts);
 396         my @recent_moves = ();
 397         while (my $ref = $q->fetchrow_hashref) {
 398                 my $name = $ref->{'name'};
 399                 my $old_group = $ref->{'old_group'};
 400                 my $new_group = $ref->{'new_group'};
 401
 402                 my $msg = $ref->{'change_seen'} . " ";
 403                 if (!defined($old_group)) {
 404                         $msg .= "$name, (ny løper) → $new_group";
 405                 } else {
 406                         $msg .= "$name, $old_group → $new_group";
 407                 }
 408                 push @recent_moves, { values => [{ userEnteredValue => { stringValue => $msg } }] };
 409         }
 410         while (scalar @recent_moves < 50) {
 411                 push @recent_moves, { values => [{ userEnteredValue => { stringValue => '' } }] };
 412         }
 413         return @recent_moves;
 414 }
 415
 416 # Also applies the diff to the database (a bit ugly).
 417 sub find_diff {
 418         my ($dbh, $invitation_ts, $want_colors, $have_colors, $seen_names) = @_;
 419
 420         my @diffs = ();
 421         for my $real_name (keys %$want_colors) {
 422                 my $wc = $want_colors->{$real_name};
 423                 if (exists($have_colors->{$real_name})) {
 424                         if ($have_colors->{$real_name} eq $wc) {
 425                                 # Already good.
 426                                 next;
 427                         }
 428                         skv_log("Markerer at $real_name har byttet treningssted.");
 429                         push @diffs, [
 430                                 $real_name, { backgroundColor => $rgb{$wc} }
 431                         ];
 432                         $dbh->do('UPDATE applied SET color=? WHERE channel=? AND ts=? AND name=?', undef,
 433                                 $wc, $config::invitation_channel, $invitation_ts, $real_name);
 434                 } else {
 435                         skv_log("Markerer at $real_name skal på trening.");
 436                         push @diffs, [
 437                                 $real_name, { backgroundColor => $rgb{$wc} }
 438                         ];
 439                         $dbh->do('INSERT INTO applied (channel, ts, name, color) VALUES (?, ?, ?, ?)', undef,
 440                                 $config::invitation_channel, $invitation_ts, $real_name, $wc);
 441                 }
 442         }
 443         for my $real_name (keys %$have_colors) {
 444                 next if (exists($want_colors->{$real_name}));
 445                 my $sk = sort_key($real_name);
 446                 if (!exists($seen_names->{$sk})) {
 447                         # TODO: This can somehow come if we try to add someone who's not in the sheet, too?
 448                         skv_log("Ønsket å fjerne at $real_name skulle på trening, men de var ikke i regnearket lenger.");
 449                 } elsif (scalar @{$seen_names->{$sk}} > 1) {
 450                         # Don't touch them.
 451                 } else {
 452                         skv_log("Fjerner at $real_name skal på trening.");
 453                         push @diffs, [
 454                                 $real_name, { backgroundColor => $rgb{white} }
 455                         ];
 456                         $dbh->do('DELETE FROM applied WHERE channel=? AND ts=? AND name=?', undef,
 457                                 $config::invitation_channel, $invitation_ts, $real_name);
 458                 }
 459         }
 460         return @diffs;
 461 }
 462
 463 sub possibly_nag_user {
 464         my ($dbh, $ua, $userid, $invitation_ts, $group, $slack_userid_to_slack_name) = @_;
 465
 466         my $slack_name = $slack_userid_to_slack_name->{$userid};
 467
 468         # See if we've nagged this user before.
 469         my $q = $dbh->prepare('SELECT * FROM users_nagged WHERE userid=? AND ts=?');
 470         $q->execute($userid, $invitation_ts);
 471         if (defined($q->fetchrow_hashref)) {
 472                 return;
 473         }
 474
 475         my $msg;
 476         if (!defined($group)) {
 477                 $msg = "Hei! Du meldte deg akkurat på trening, men vi klarer ikke å finne deg i en gruppe i regnearket. For at det skal være enklere for trenerne, ønsker vi gjerne at du går inn på https://regneark.skvidar.run/ og skriver deg inn der med samme navn som du bruker på Slack. Om du er usikker på hvilken gruppe som passer for deg, ta gjerne kontakt med en trener. Velkommen på trening og til klubben!";
 478                 skv_log("Sender Slack-melding til $slack_name ($userid) for å spørre om gruppe.");
 479         } elsif ($group eq '(flere grupper)') {
 480                 $msg = "Hei! Du meldte deg akkurat på trening, men du ser ut til å stå i flere forskjellige grupper i regnearket. For at det skal være enklere for trenerne, ønsker vi gjerne at du går inn på https://regneark.skvidar.run/ og retter der. Om du er usikker på hvilken gruppe som passer for deg, ta gjerne kontakt med en trener. Velkommen på trening!";
 481                 skv_log("Sender Slack-melding til $slack_name ($userid) for å spørre om gruppe.");
 482         } else {
 483                 $msg = "Hei! Du er påmeldt gruppe *$group*. Om dette er feil, gå gjerne inn og endre på https://regneark.skvidar.run/. Vi gleder oss til å se deg på trening!";
 484                 skv_log("Sender Slack-melding om at $slack_name ($userid) er i gruppe $group.");
 485         }
 486
 487         my $content = {
 488                 channel => $config::invitation_channel,
 489                 user => $userid,
 490                 text => $msg
 491         };
 492         my $start = [Time::HiRes::gettimeofday];
 493         my $response = $ua->post(
 494                 'https://slack.com/api/chat.postEphemeral',
 495                 Content => JSON::XS::encode_json($content),
 496                 Content_type => 'application/json;charset=UTF-8',
 497                 Authorization => 'Bearer ' . $config::slack_oauth_token
 498         );
 499         log_timing($start, 'chat.postEphemeral');
 500         die $response->status_line if !$response->is_success;
 501         my $msg_json = JSON::XS::decode_json($response->decoded_content);
 502         die "Something went wrong: " . $response->decoded_content if (!defined($msg_json) || !$msg_json->{'ok'});
 503
 504         # Mark that we've sent the message, so it won't happen again.
 505         $dbh->do('INSERT INTO users_nagged (userid, ts, last_nag) VALUES (?, ?, CURRENT_TIMESTAMP)', undef, $userid, $invitation_ts);
 506 }
 507
 508 sub db_connect {
 509         my $dbh = DBI->connect("dbi:Pg:dbname=$config::dbname;host=127.0.0.1", $config::dbuser, $config::dbpass, {RaiseError => 1})
 510                 or warn "Could not connect to Postgres: " . DBI->errstr;
 511         if (!defined($dbh)) {
 512                 return undef;
 513         }
 514         $dbh->{AutoCommit} = 0;
 515         $dbh->do('LISTEN skvupdate') or return undef;
 516         return $dbh;
 517 }
 518
 519 sub run {
 520         my ($dbh, $ua) = @_;
 521         my $total_start = [Time::HiRes::gettimeofday];
 522
 523         @log = ();
 524         skv_log("Siste sync startet: " . POSIX::ctime(time));
 525
 526         # For the logic on the “applied” table below.
 527         $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE');
 528
 529         my $token = get_oauth_bearer_token($dbh, $ua);
 530
 531         # Find the newest message, what it is linked to, and what was the one before it (for group diffing).
 532         # TODO: Support more than one, and test better for errors here.
 533         my $q = $dbh->prepare('select * from message_sheet_link where channel=? order by ts desc limit 2');
 534         $q->execute($config::invitation_channel);
 535         my $linkref = $q->fetchrow_hashref;
 536         my $invitation_ts = $linkref->{'ts'};
 537         my $wanted_sheet_title = $linkref->{'sheet_title'};
 538         die "Could not get newest sheet title" if (!defined($wanted_sheet_title));
 539         my $tab_name = $linkref->{'tab_name'};
 540         my $tab_id = $linkref->{'tab_id'};
 541
 542         # Store away the second-newest ID.
 543         my $prev_invitation_ts = $q->fetchrow_hashref->{'ts'};
 544
 545         if (!defined($tab_name) || !defined($tab_id)) {
 546                 ($tab_name, $tab_id) = get_spreadsheet_with_title($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title);
 547                 if (!defined($tab_name)) {
 548                         skv_log("Fant ikke noen fane med «$wanted_sheet_title» i navnet; kan ikke synkronisere.\n");
 549                         sheet_batch_update($ua, $token, [ serialize_skv_log_to_sheet() ]);
 550                         die;
 551                 }
 552         }
 553
 554         # Find everyone who are marked as attending on Slack (via reactions).
 555         $q = $dbh->prepare('SELECT DISTINCT userid,reaction FROM current_reactions WHERE channel=? AND ts=? AND reaction IN (\'heart\', \'open_mouth\', \'blue_heart\', \'orange_heart\')');
 556         $q->execute($config::invitation_channel, $invitation_ts);
 557         my @attending_userids = ();
 558         my %colors = ();
 559         my %double = ();
 560         while (my $ref = $q->fetchrow_hashref) {
 561                 my $userid = $ref->{'userid'};
 562                 push @attending_userids, $userid;
 563                 if ($ref->{'reaction'} eq 'blue_heart') {
 564                         if (exists($colors{$userid}) && $colors{$userid} ne 'blue') {
 565                                 $double{$userid} = 1;
 566                         }
 567                         $colors{$userid} = 'blue';
 568                 } elsif ($ref->{'reaction'} eq 'orange_heart') {
 569                         if (exists($colors{$userid}) && $colors{$userid} ne 'orange') {
 570                                 $double{$userid} = 1;
 571                         }
 572                         $colors{$userid} = 'orange';
 573                 } else {
 574                         if (exists($colors{$userid}) && $colors{$userid} ne 'yellow') {
 575                                 $double{$userid} = 1;
 576                         }
 577                         $colors{$userid} = 'yellow';
 578                 }
 579         }
 580
 581         # Remove double-attenders (we will log them as warnings further down).
 582         @attending_userids = grep { !exists($double{$_}) } @attending_userids;
 583         for my $userid (keys %double) {
 584                 delete $colors{$userid};
 585         }
 586
 587         # Get the list of all people in the sheet (we're going to need them soon).
 588         # Also get the Slack mapping when we're doing an API request anyway.
 589         my $start = [Time::HiRes::gettimeofday];
 590         my $response = $ua->get('https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '?key=' . $config::gsheets_api_key . '&ranges=' . $tab_name . '!A4:Z5000&ranges=Slack-mapping!A5:C5000&fields=sheets/data/rowData/values/userEnteredValue',
 591                 Authorization => 'Bearer ' . $token,
 592                 Accept_Encoding => HTTP::Message::decodable
 593         );
 594         log_timing($start, "/spreadsheets/");
 595
 596         my $sheets_json = JSON::XS::decode_json($response->decoded_content);
 597         if (!exists($sheets_json->{'sheets'})) {
 598                 die "Missing sheets (error response?): " . $response->decoded_content;
 599         }
 600         my $main_sheet_json = $sheets_json->{'sheets'}[0];
 601         my $mapping_sheet_json = $sheets_json->{'sheets'}[1];
 602
 603         # Update the list of groups we've seen people in.
 604         $start = [Time::HiRes::gettimeofday];
 605         my %assignments = get_group_assignments($main_sheet_json);
 606         log_timing($start, "Parsing group assignments");
 607         $start = [Time::HiRes::gettimeofday];
 608         update_assignment_db($dbh, $config::invitation_channel, $invitation_ts, \%assignments);
 609         log_timing($start, "Updating assignments in database");
 610
 611         $start = [Time::HiRes::gettimeofday];
 612         my %seen_names = find_where_each_name_is($main_sheet_json);
 613         log_timing($start, "Making sort key reverse mapping");
 614
 615         # Find duplicates.
 616         for my $name (sort keys %seen_names) {
 617                 my $seen = $seen_names{$name};
 618                 if (scalar @$seen >= 2) {
 619                         my $exemplar = $seen->[0][0];
 620                         skv_log("Duplikat: $exemplar (" . format_cell_names_for_seen($seen) . ")");
 621                 }
 622         }
 623
 624         # Get our existing Slack->name mapping, from the sheets.
 625         my %slack_userid_to_real_name = ();
 626         my %slack_userid_to_slack_name = ();
 627         my %slack_userid_to_row = ();
 628
 629         my $mapping_sheet_rows = $mapping_sheet_json->{'data'}[0]{'rowData'};
 630         my $cur_row = 5;
 631         for my $row (@$mapping_sheet_rows) {
 632                 my $slack_id = $row->{'values'}[0]{'userEnteredValue'}{'stringValue'};
 633                 my $slack_name = $row->{'values'}[1]{'userEnteredValue'}{'stringValue'};
 634                 my $real_name = get_spreadsheet_name($row->{'values'}[2]);  # TODO support more
 635                 $slack_userid_to_row{$slack_id} = $cur_row++;
 636                 next if (!defined($slack_name));
 637                 $slack_userid_to_slack_name{$slack_id} = $slack_name;
 638                 next if (!defined($real_name));
 639                 $slack_userid_to_real_name{$slack_id} = $real_name;
 640         }
 641
 642         # See which ones we don't have a mapping for, and look them up in Slack.
 643         # TODO: Use an append call instead of $cur_row?
 644         my @slack_mapping_updates = ();
 645         for my $userid (@attending_userids) {
 646                 next if (exists($slack_userid_to_real_name{$userid}));
 647
 648                 # Make sure they have a row in the spreadsheet.
 649                 my $write_row;
 650                 if (exists($slack_userid_to_row{$userid})) {
 651                         $write_row = $slack_userid_to_row{$userid};
 652                 } else {
 653                         $write_row = $cur_row++;
 654                         $slack_userid_to_row{$userid} = $write_row;
 655                         push @slack_mapping_updates, {
 656                                 range => "Slack-mapping!A$write_row:A$write_row",
 657                                 values => [ [ $userid ]]
 658                         };
 659                 }
 660
 661                 # Fetch their Slack name if we don't already have it.
 662                 my $slack_name;
 663                 if (exists($slack_userid_to_slack_name{$userid})) {
 664                         $slack_name = $slack_userid_to_slack_name{$userid};
 665                 } else {
 666                         $slack_userid_to_slack_name{$userid} = $slack_name;
 667                         $slack_name = get_slack_name($ua, $userid);
 668                         push @slack_mapping_updates, {
 669                                 range => "Slack-mapping!B$write_row:B$write_row",
 670                                 values => [ [ $slack_name ]]
 671                         };
 672                         $slack_userid_to_slack_name{$userid} = $slack_name;
 673                 }
 674
 675                 if (exists($seen_names{sort_key($slack_name)})) {
 676                         # The name exists exactly, once or more, so it's a direct match and we ignore any fuzz.
 677                         $slack_userid_to_real_name{$userid} = $slack_name;
 678                         push @slack_mapping_updates, {
 679                                 range => "Slack-mapping!C$write_row:C$write_row",
 680                                 values => [ [ $slack_name ]]
 681                         };
 682                 } else {
 683                         # Do a search through all the available names in the sheet to find an obvious(ish) match.
 684                         my @candidates = ();
 685                         my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
 686                         $start = [Time::HiRes::gettimeofday];
 687                         my @ap = map { sort_key($_) } split /\s+/, $slack_name;  # Precalc for matches_name().
 688                         for my $row (@$main_sheet_rows) {
 689                                 for my $val (@{$row->{'values'}}) {
 690                                         my $name = get_spreadsheet_name($val);
 691                                         if (defined($name) && matches_name($slack_name, $name, \@ap)) {
 692                                                 push @candidates, $name;
 693                                         }
 694                                 }
 695                         }
 696                         log_timing($start, "Fuzzy-searching for Slack name $slack_name");
 697                         if ($#candidates == -1) {
 698                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men fant ikke et regneark-navn for dem.");
 699                                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, undef, \%slack_userid_to_slack_name);
 700                         } elsif ($#candidates == 0) {
 701                                 my $name = $candidates[0];
 702                                 $slack_userid_to_real_name{$userid} = $name;
 703                                 push @slack_mapping_updates, {
 704                                         range => "Slack-mapping!C$write_row:C$write_row",
 705                                         values => [ [ $name ]]
 706                                 };
 707                         } else {
 708                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men hadde flere fuzzy-matcher; vet ikke hvilket regneark-navn som skal brukes.");
 709                         }
 710                 }
 711         }
 712         # LOCAL CHANGE FOR HKS 2024
 713         # Piece together HKS users.
 714         $q = $dbh->prepare('SELECT userid FROM current_reactions WHERE channel=? and ts=? and reaction=?;');
 715         $q->execute('C06C34L2R6G', '1712686401.430939', 'heart');  # #hks-2024-05-04
 716         my @hks_runners = ();
 717         while (my $ref = $q->fetchrow_hashref) {
 718                 my $userid = $ref->{'userid'};
 719                 if (!exists($slack_userid_to_real_name{$userid}) && !exists($slack_userid_to_slack_name{$userid})) {
 720                         my $slack_name = get_slack_name($ua, $userid);
 721                         my $write_row = $cur_row++;
 722                         push @slack_mapping_updates, {
 723                                 range => "Slack-mapping!A$write_row:A$write_row",
 724                                 values => [ [ $userid ]]
 725                         };
 726                         push @slack_mapping_updates, {
 727                                 range => "Slack-mapping!B$write_row:B$write_row",
 728                                 values => [ [ $slack_name ]]
 729                         };
 730                         $slack_userid_to_slack_name{$userid} = $slack_name;
 731                 }
 732                 my $name = $slack_userid_to_real_name{$userid} // $slack_userid_to_slack_name{$userid} // $userid;
 733                 push @hks_runners, { values => [{ userEnteredValue => { stringValue => $name } }] };
 734         }
 735         push @hks_runners, { values => [{ userEnteredValue => { stringValue => '' } }] };
 736         push @hks_runners, { values => [{ userEnteredValue => { stringValue => '' } }] };
 737         push @hks_runners, { values => [{ userEnteredValue => { stringValue => '' } }] };
 738         # END LOCAL CHANGE FOR HKS 2024
 739         if (scalar @slack_mapping_updates > 0) {
 740                 my $update = {
 741                         valueInputOption => 'USER_ENTERED',
 742                         data => \@slack_mapping_updates
 743                 };
 744                 $start = [Time::HiRes::gettimeofday];
 745                 $response = $ua->post(
 746                         'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '/values:batchUpdate?key=' . $config::gsheets_api_key,
 747                         Content => JSON::XS::encode_json($update),
 748                         Content_type => 'application/json;charset=UTF-8',
 749                         Authorization => 'Bearer ' . $token
 750                 );
 751                 log_timing($start, "/spreadsheets/values:batchUpdate");
 752                 die $response->decoded_content if (!$response->is_success);
 753         }
 754
 755         # Now that we have Slack names, we can log double-reacters.
 756         for my $userid (keys %double) {
 757                 my $name = best_name_for_log($userid, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 758                 skv_log("$name er påmeldt flere steder på Slack; vet ikke hvilken som skal brukes.");
 759         }
 760
 761         # ...and possibly send welcome messages to remind them of groups.
 762         for my $userid (@attending_userids) {
 763                 my $real_name = $slack_userid_to_real_name{$userid};
 764                 next if (!defined($real_name));
 765                 my $group = $assignments{$real_name};
 766                 next if (!defined($group));
 767                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, $group, \%slack_userid_to_slack_name);
 768         }
 769
 770         # Find the list of names to mark yellow.
 771         my %want_colors = ();
 772         my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
 773         for my $userid (@attending_userids) {
 774                 next if (!exists($slack_userid_to_real_name{$userid}));
 775                 my $slack_name = $slack_userid_to_slack_name{$userid};
 776                 my $real_name = $slack_userid_to_real_name{$userid};
 777
 778                 # See if we can find them in the spreadsheet.
 779                 my $sk = sort_key($real_name);
 780                 if (!exists($seen_names{$sk})) {
 781                         # TODO: Perhaps move this logic further down, for consistency?
 782                         skv_log("$slack_name ($userid) er påmeldt på Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
 783                 } else {
 784                         my $seen = $seen_names{$sk};
 785                         if (scalar @$seen >= 2) {
 786                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men står flere steder (se over); vet ikke hvilken celle som skal brukes.");
 787                         } else {
 788                                 $want_colors{$seen->[0][0]} = $colors{$userid};
 789                         }
 790                 }
 791         }
 792
 793         # Find the list of names we already marked yellow.
 794         my %have_colors = ();
 795         $q = $dbh->prepare('SELECT name,color FROM applied WHERE channel=? AND ts=?');
 796         $q->execute($config::invitation_channel, $invitation_ts);
 797         while (my $ref = $q->fetchrow_hashref) {
 798                 $have_colors{$ref->{'name'}} = $ref->{'color'};
 799         }
 800
 801         my @diffs = find_diff($dbh, $invitation_ts, \%want_colors, \%have_colors, \%seen_names);
 802
 803         my @yellow_updates = ();
 804         if (scalar @diffs > 0) {
 805                 # Now fill in the actual stuff.
 806                 for my $diff (@diffs) {
 807                         my $real_name = $diff->[0];
 808
 809                         my $seen = $seen_names{sort_key($real_name)};
 810
 811                         # We've already complained about these earlier, so just skip them silently.
 812                         next if (scalar @$seen > 1);
 813
 814                         # See if we can find them in the spreadsheet.
 815                         die "Could not find $real_name" if (!defined($seen));
 816                         my $rowno = $seen->[0][1];
 817                         my $colno = $seen->[0][2];
 818                         push @yellow_updates, {
 819                                 updateCells => {
 820                                         rows => [{
 821                                                 values => [{
 822                                                         userEnteredFormat => $diff->[1]
 823                                                 }]
 824                                         }],
 825                                         fields => 'userEnteredFormat.backgroundColor',
 826                                         range => {
 827                                                 sheetId => $tab_id,
 828                                                 startRowIndex => $rowno,
 829                                                 endRowIndex => $rowno + 1,
 830                                                 startColumnIndex => $colno,
 831                                                 endColumnIndex => $colno + 1
 832                                         }
 833                                 }
 834                         };
 835                 }
 836         }
 837
 838         my @recent_changes = create_reaction_log($dbh, $invitation_ts, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 839         push @yellow_updates, {
 840                 updateCells => {
 841                         rows => \@recent_changes,
 842                         fields => 'userEnteredValue.stringValue',
 843                         range => {
 844                                 sheetId => $config::log_tab_id,
 845                                 startRowIndex => 4,
 846                                 endRowIndex => 4 + scalar @recent_changes,
 847                                 startColumnIndex => 0,
 848                                 endColumnIndex => 1
 849                         }
 850                 }
 851         };
 852
 853         my @recent_moves = create_move_log($dbh, $invitation_ts, $prev_invitation_ts);
 854         push @yellow_updates, {
 855                 updateCells => {
 856                         rows => \@recent_moves,
 857                         fields => 'userEnteredValue.stringValue',
 858                         range => {
 859                                 sheetId => $config::log_tab_id,
 860                                 startRowIndex => 4,
 861                                 endRowIndex => 4 + scalar @recent_moves,
 862                                 startColumnIndex => 1,
 863                                 endColumnIndex => 2
 864                         }
 865                 }
 866         };
 867
 868         # LOCAL CHANGE FOR HKS 2024
 869         push @yellow_updates, {
 870                 updateCells => {
 871                         rows => \@hks_runners,
 872                         fields => 'userEnteredValue.stringValue',
 873                         range => {
 874                                 sheetId => $config::hks_tab_id,
 875                                 startRowIndex => 1,
 876                                 endRowIndex => 1 + scalar @hks_runners,
 877                                 startColumnIndex => 0,
 878                                 endColumnIndex => 1
 879                         }
 880                 }
 881         };
 882         # END LOCAL CHANGE FOR HKS 2024
 883
 884         # Push the final set of updates (including the log).
 885         skv_log("Ferdig.");
 886         push @yellow_updates, serialize_skv_log_to_sheet();
 887         sheet_batch_update($ua, $token, \@yellow_updates);
 888         $dbh->commit;
 889
 890         my $elapsed = Time::HiRes::tv_interval($total_start);
 891         printf "Tok %.0f ms.\n", 1e3 * $elapsed;
 892         print "\n";
 893 }
 894
 895 # Initialize the handles we need for communication.
 896 my $dbh = db_connect() or die;
 897 my $ua = LWP::UserAgent->new(agent => 'SKVidarLang/1.0', keep_alive => 50);
 898 if ($#ARGV >= 0 && $ARGV[0] eq '--daemon') {
 899         # Start with a single, forced run.
 900         run($dbh, $ua);
 901
 902         while (1) {
 903                 while (!defined($dbh) || !$dbh->ping) {
 904                         print STDERR "Database connection lost, reconnecting...\n";
 905                         sleep 1;
 906                         eval {
 907                                 $dbh = db_connect();
 908                         };
 909                 }
 910                 my $s = IO::Select->new($dbh->{pg_socket});
 911                 my @ready = $s->can_read(150.0);  # slack.com HTTP timeout is ~3 minutes, sheets.googleapis.com is ~4 minutes.
 912                 my @exceptions = $s->has_exception(0.0);
 913
 914                 if (scalar @exceptions > 0) {
 915                         $dbh->disconnect;
 916                         $dbh = undef;
 917                         next;
 918                 }
 919                 if (scalar @ready > 0) {
 920                         eval {
 921                                 run($dbh, $ua);
 922                         };
 923                         if ($@) {
 924                                 warn "Died with: $@";
 925                                 $dbh = undef;
 926                         }
 927                 } else {
 928                         # Keep the connections alive and the token in the database fresh.
 929                         # (The two URLs we use don't really exist. Note that the first time,
 930                         # we might be making the initial connection to slack.com, since it's
 931                         # not a given that run() needed to talk to them.)
 932                         get_oauth_bearer_token($dbh, $ua);
 933                         $dbh->commit;
 934                         #my $start = [Time::HiRes::gettimeofday];
 935                         $ua->get('https://sheets.googleapis.com/ping');
 936                         #log_timing($start, 'sheets.googleapis.com (keepalive)');
 937                         #$start = [Time::HiRes::gettimeofday];
 938                         $ua->get('https://slack.com/api/ping');
 939                         #log_timing($start, 'slack.com (keepalive)');
 940                         #print STDERR "\n";
 941                 }
 942         }
 943 } elsif ($#ARGV >= 0 && $ARGV[0] eq '--benchmark') {
 944         for my $i (0..9) {
 945                 run($dbh, $ua);
 946         }
 947 } else {
 948         run($dbh, $ua);
 949 }