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