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

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