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