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

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