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, TO_CHAR(last_added, \'YYYY-mm-dd HH24:MI\') AS last_added FROM current_reactions_with_ts WHERE channel=? and ts=? and reaction=? ORDER BY current_reactions_with_ts.last_added;');
 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, {
 734                         values => [
 735                                 { userEnteredValue => { stringValue => $name } },
 736                                 { userEnteredValue => { stringValue => $ref->{'last_added'} } },
 737                         ]
 738                 };
 739         }
 740         push @hks_runners, { values => [{ userEnteredValue => { stringValue => '' } }, { userEnteredValue => { stringValue => '' } }] };
 741         push @hks_runners, { values => [{ userEnteredValue => { stringValue => '' } }, { userEnteredValue => { stringValue => '' } }] };
 742         push @hks_runners, { values => [{ userEnteredValue => { stringValue => '' } }, { userEnteredValue => { stringValue => '' } }] };
 743         # END LOCAL CHANGE FOR HKS 2024
 744         if (scalar @slack_mapping_updates > 0) {
 745                 my $update = {
 746                         valueInputOption => 'USER_ENTERED',
 747                         data => \@slack_mapping_updates
 748                 };
 749                 $start = [Time::HiRes::gettimeofday];
 750                 $response = $ua->post(
 751                         'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '/values:batchUpdate?key=' . $config::gsheets_api_key,
 752                         Content => JSON::XS::encode_json($update),
 753                         Content_type => 'application/json;charset=UTF-8',
 754                         Authorization => 'Bearer ' . $token
 755                 );
 756                 log_timing($start, "/spreadsheets/values:batchUpdate");
 757                 die $response->decoded_content if (!$response->is_success);
 758         }
 759
 760         # Now that we have Slack names, we can log double-reacters.
 761         for my $userid (keys %double) {
 762                 my $name = best_name_for_log($userid, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 763                 skv_log("$name er påmeldt flere steder på Slack; vet ikke hvilken som skal brukes.");
 764         }
 765
 766         # ...and possibly send welcome messages to remind them of groups.
 767         for my $userid (@attending_userids) {
 768                 my $real_name = $slack_userid_to_real_name{$userid};
 769                 next if (!defined($real_name));
 770                 my $group = $assignments{$real_name};
 771                 next if (!defined($group));
 772                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, $group, \%slack_userid_to_slack_name);
 773         }
 774
 775         # Find the list of names to mark yellow.
 776         my %want_colors = ();
 777         my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
 778         for my $userid (@attending_userids) {
 779                 next if (!exists($slack_userid_to_real_name{$userid}));
 780                 my $slack_name = $slack_userid_to_slack_name{$userid};
 781                 my $real_name = $slack_userid_to_real_name{$userid};
 782
 783                 # See if we can find them in the spreadsheet.
 784                 my $sk = sort_key($real_name);
 785                 if (!exists($seen_names{$sk})) {
 786                         # TODO: Perhaps move this logic further down, for consistency?
 787                         skv_log("$slack_name ($userid) er påmeldt på Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
 788                 } else {
 789                         my $seen = $seen_names{$sk};
 790                         if (scalar @$seen >= 2) {
 791                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men står flere steder (se over); vet ikke hvilken celle som skal brukes.");
 792                         } else {
 793                                 $want_colors{$seen->[0][0]} = $colors{$userid};
 794                         }
 795                 }
 796         }
 797
 798         # Find the list of names we already marked yellow.
 799         my %have_colors = ();
 800         $q = $dbh->prepare('SELECT name,color FROM applied WHERE channel=? AND ts=?');
 801         $q->execute($config::invitation_channel, $invitation_ts);
 802         while (my $ref = $q->fetchrow_hashref) {
 803                 $have_colors{$ref->{'name'}} = $ref->{'color'};
 804         }
 805
 806         my @diffs = find_diff($dbh, $invitation_ts, \%want_colors, \%have_colors, \%seen_names);
 807
 808         my @yellow_updates = ();
 809         if (scalar @diffs > 0) {
 810                 # Now fill in the actual stuff.
 811                 for my $diff (@diffs) {
 812                         my $real_name = $diff->[0];
 813
 814                         my $seen = $seen_names{sort_key($real_name)};
 815
 816                         # We've already complained about these earlier, so just skip them silently.
 817                         next if (scalar @$seen > 1);
 818
 819                         # See if we can find them in the spreadsheet.
 820                         die "Could not find $real_name" if (!defined($seen));
 821                         my $rowno = $seen->[0][1];
 822                         my $colno = $seen->[0][2];
 823                         push @yellow_updates, {
 824                                 updateCells => {
 825                                         rows => [{
 826                                                 values => [{
 827                                                         userEnteredFormat => $diff->[1]
 828                                                 }]
 829                                         }],
 830                                         fields => 'userEnteredFormat.backgroundColor',
 831                                         range => {
 832                                                 sheetId => $tab_id,
 833                                                 startRowIndex => $rowno,
 834                                                 endRowIndex => $rowno + 1,
 835                                                 startColumnIndex => $colno,
 836                                                 endColumnIndex => $colno + 1
 837                                         }
 838                                 }
 839                         };
 840                 }
 841         }
 842
 843         my @recent_changes = create_reaction_log($dbh, $invitation_ts, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 844         push @yellow_updates, {
 845                 updateCells => {
 846                         rows => \@recent_changes,
 847                         fields => 'userEnteredValue.stringValue',
 848                         range => {
 849                                 sheetId => $config::log_tab_id,
 850                                 startRowIndex => 4,
 851                                 endRowIndex => 4 + scalar @recent_changes,
 852                                 startColumnIndex => 0,
 853                                 endColumnIndex => 1
 854                         }
 855                 }
 856         };
 857
 858         my @recent_moves = create_move_log($dbh, $invitation_ts, $prev_invitation_ts);
 859         push @yellow_updates, {
 860                 updateCells => {
 861                         rows => \@recent_moves,
 862                         fields => 'userEnteredValue.stringValue',
 863                         range => {
 864                                 sheetId => $config::log_tab_id,
 865                                 startRowIndex => 4,
 866                                 endRowIndex => 4 + scalar @recent_moves,
 867                                 startColumnIndex => 1,
 868                                 endColumnIndex => 2
 869                         }
 870                 }
 871         };
 872
 873         # LOCAL CHANGE FOR HKS 2024
 874         push @yellow_updates, {
 875                 updateCells => {
 876                         rows => \@hks_runners,
 877                         fields => 'userEnteredValue.stringValue',
 878                         range => {
 879                                 sheetId => $config::hks_tab_id,
 880                                 startRowIndex => 1,
 881                                 endRowIndex => 1 + scalar @hks_runners,
 882                                 startColumnIndex => 0,
 883                                 endColumnIndex => 2
 884                         }
 885                 }
 886         };
 887         # END LOCAL CHANGE FOR HKS 2024
 888
 889         # Push the final set of updates (including the log).
 890         skv_log("Ferdig.");
 891         push @yellow_updates, serialize_skv_log_to_sheet();
 892         sheet_batch_update($ua, $token, \@yellow_updates);
 893         $dbh->commit;
 894
 895         my $elapsed = Time::HiRes::tv_interval($total_start);
 896         printf "Tok %.0f ms.\n", 1e3 * $elapsed;
 897         print "\n";
 898 }
 899
 900 # Initialize the handles we need for communication.
 901 my $dbh = db_connect() or die;
 902 my $ua = LWP::UserAgent->new(agent => 'SKVidarLang/1.0', keep_alive => 50);
 903 if ($#ARGV >= 0 && $ARGV[0] eq '--daemon') {
 904         # Start with a single, forced run.
 905         run($dbh, $ua);
 906
 907         while (1) {
 908                 while (!defined($dbh) || !$dbh->ping) {
 909                         print STDERR "Database connection lost, reconnecting...\n";
 910                         sleep 1;
 911                         eval {
 912                                 $dbh = db_connect();
 913                         };
 914                 }
 915                 my $s = IO::Select->new($dbh->{pg_socket});
 916                 my @ready = $s->can_read(150.0);  # slack.com HTTP timeout is ~3 minutes, sheets.googleapis.com is ~4 minutes.
 917                 my @exceptions = $s->has_exception(0.0);
 918
 919                 if (scalar @exceptions > 0) {
 920                         $dbh->disconnect;
 921                         $dbh = undef;
 922                         next;
 923                 }
 924                 if (scalar @ready > 0) {
 925                         eval {
 926                                 run($dbh, $ua);
 927                         };
 928                         if ($@) {
 929                                 warn "Died with: $@";
 930                                 $dbh = undef;
 931                         }
 932                 } else {
 933                         # Keep the connections alive and the token in the database fresh.
 934                         # (The two URLs we use don't really exist. Note that the first time,
 935                         # we might be making the initial connection to slack.com, since it's
 936                         # not a given that run() needed to talk to them.)
 937                         get_oauth_bearer_token($dbh, $ua);
 938                         $dbh->commit;
 939                         #my $start = [Time::HiRes::gettimeofday];
 940                         $ua->get('https://sheets.googleapis.com/ping');
 941                         #log_timing($start, 'sheets.googleapis.com (keepalive)');
 942                         #$start = [Time::HiRes::gettimeofday];
 943                         $ua->get('https://slack.com/api/ping');
 944                         #log_timing($start, 'slack.com (keepalive)');
 945                         #print STDERR "\n";
 946                 }
 947         }
 948 } elsif ($#ARGV >= 0 && $ARGV[0] eq '--benchmark') {
 949         for my $i (0..9) {
 950                 run($dbh, $ua);
 951         }
 952 } else {
 953         run($dbh, $ua);
 954 }