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