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