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         $start = [Time::HiRes::gettimeofday];
 588         my %assignments = get_group_assignments($main_sheet_json);
 589         log_timing($start, "Parsing group assignments");
 590         $start = [Time::HiRes::gettimeofday];
 591         update_assignment_db($dbh, $config::invitation_channel, $invitation_ts, \%assignments);
 592         log_timing($start, "Updating assignments in database");
 593
 594         $start = [Time::HiRes::gettimeofday];
 595         my %seen_names = find_where_each_name_is($main_sheet_json);
 596         log_timing($start, "Making sort key reverse mapping");
 597
 598         # Find duplicates.
 599         for my $name (sort keys %seen_names) {
 600                 my $seen = $seen_names{$name};
 601                 if (scalar @$seen >= 2) {
 602                         my $exemplar = $seen->[0][0];
 603                         skv_log("Duplikat: $exemplar (" . format_cell_names_for_seen($seen) . ")");
 604                 }
 605         }
 606
 607         # Get our existing Slack->name mapping, from the sheets.
 608         my %slack_userid_to_real_name = ();
 609         my %slack_userid_to_slack_name = ();
 610         my %slack_userid_to_row = ();
 611
 612         my $mapping_sheet_rows = $mapping_sheet_json->{'data'}[0]{'rowData'};
 613         my $cur_row = 5;
 614         for my $row (@$mapping_sheet_rows) {
 615                 my $slack_id = $row->{'values'}[0]{'userEnteredValue'}{'stringValue'};
 616                 my $slack_name = $row->{'values'}[1]{'userEnteredValue'}{'stringValue'};
 617                 my $real_name = get_spreadsheet_name($row->{'values'}[2]);  # TODO support more
 618                 $slack_userid_to_row{$slack_id} = $cur_row++;
 619                 next if (!defined($slack_name));
 620                 $slack_userid_to_slack_name{$slack_id} = $slack_name;
 621                 next if (!defined($real_name));
 622                 $slack_userid_to_real_name{$slack_id} = $real_name;
 623         }
 624
 625         # See which ones we don't have a mapping for, and look them up in Slack.
 626         # TODO: Use an append call instead of $cur_row?
 627         my @slack_mapping_updates = ();
 628         for my $userid (@attending_userids) {
 629                 next if (exists($slack_userid_to_real_name{$userid}));
 630
 631                 # Make sure they have a row in the spreadsheet.
 632                 my $write_row;
 633                 if (exists($slack_userid_to_row{$userid})) {
 634                         $write_row = $slack_userid_to_row{$userid};
 635                 } else {
 636                         $write_row = $cur_row++;
 637                         $slack_userid_to_row{$userid} = $write_row;
 638                         push @slack_mapping_updates, {
 639                                 range => "Slack-mapping!A$write_row:A$write_row",
 640                                 values => [ [ $userid ]]
 641                         };
 642                 }
 643
 644                 # Fetch their Slack name if we don't already have it.
 645                 my $slack_name;
 646                 if (exists($slack_userid_to_slack_name{$userid})) {
 647                         $slack_name = $slack_userid_to_slack_name{$userid};
 648                 } else {
 649                         $slack_userid_to_slack_name{$userid} = $slack_name;
 650                         $slack_name = get_slack_name($ua, $userid);
 651                         push @slack_mapping_updates, {
 652                                 range => "Slack-mapping!B$write_row:B$write_row",
 653                                 values => [ [ $slack_name ]]
 654                         };
 655                         $slack_userid_to_slack_name{$userid} = $slack_name;
 656                 }
 657
 658                 if (exists($seen_names{sort_key($slack_name)})) {
 659                         # The name exists exactly, once or more, so it's a direct match and we ignore any fuzz.
 660                         $slack_userid_to_real_name{$userid} = $slack_name;
 661                         push @slack_mapping_updates, {
 662                                 range => "Slack-mapping!C$write_row:C$write_row",
 663                                 values => [ [ $slack_name ]]
 664                         };
 665                 } else {
 666                         # Do a search through all the available names in the sheet to find an obvious(ish) match.
 667                         my @candidates = ();
 668                         my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
 669                         $start = [Time::HiRes::gettimeofday];
 670                         my @ap = map { sort_key($_) } split /\s+/, $slack_name;  # Precalc for matches_name().
 671                         for my $row (@$main_sheet_rows) {
 672                                 for my $val (@{$row->{'values'}}) {
 673                                         my $name = get_spreadsheet_name($val);
 674                                         if (defined($name) && matches_name($slack_name, $name, \@ap)) {
 675                                                 push @candidates, $name;
 676                                         }
 677                                 }
 678                         }
 679                         log_timing($start, "Fuzzy-searching for Slack name “$slack_name”");
 680                         if ($#candidates == -1) {
 681                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men fant ikke et regneark-navn for dem.");
 682                                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, undef, \%slack_userid_to_slack_name);
 683                         } elsif ($#candidates == 0) {
 684                                 my $name = $candidates[0];
 685                                 $slack_userid_to_real_name{$userid} = $name;
 686                                 push @slack_mapping_updates, {
 687                                         range => "Slack-mapping!C$write_row:C$write_row",
 688                                         values => [ [ $name ]]
 689                                 };
 690                         } else {
 691                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men hadde flere fuzzy-matcher; vet ikke hvilket regneark-navn som skal brukes.");
 692                         }
 693                 }
 694         }
 695         if (scalar @slack_mapping_updates > 0) {
 696                 my $update = {
 697                         valueInputOption => 'USER_ENTERED',
 698                         data => \@slack_mapping_updates
 699                 };
 700                 $start = [Time::HiRes::gettimeofday];
 701                 $response = $ua->post(
 702                         'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '/values:batchUpdate?key=' . $config::gsheets_api_key,
 703                         Content => JSON::XS::encode_json($update),
 704                         Content_type => 'application/json;charset=UTF-8',
 705                         Authorization => 'Bearer ' . $token
 706                 );
 707                 log_timing($start, "/spreadsheets/values:batchUpdate");
 708                 die $response->decoded_content if (!$response->is_success);
 709         }
 710
 711         # Now that we have Slack names, we can log double-reacters.
 712         for my $userid (keys %double) {
 713                 my $name = best_name_for_log($userid, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 714                 skv_log("$name er påmeldt flere steder på Slack; vet ikke hvilken som skal brukes.");
 715         }
 716
 717         # ...and possibly send welcome messages to remind them of groups.
 718         for my $userid (@attending_userids) {
 719                 my $real_name = $slack_userid_to_real_name{$userid};
 720                 next if (!defined($real_name));
 721                 my $group = $assignments{$real_name};
 722                 next if (!defined($group));
 723                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, $group, \%slack_userid_to_slack_name);
 724         }
 725
 726         # Find the list of names to mark yellow.
 727         my %want_colors = ();
 728         my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
 729         for my $userid (@attending_userids) {
 730                 next if (!exists($slack_userid_to_real_name{$userid}));
 731                 my $slack_name = $slack_userid_to_slack_name{$userid};
 732                 my $real_name = $slack_userid_to_real_name{$userid};
 733
 734                 # See if we can find them in the spreadsheet.
 735                 my $sk = sort_key($real_name);
 736                 if (!exists($seen_names{$sk})) {
 737                         # TODO: Perhaps move this logic further down, for consistency?
 738                         skv_log("$slack_name ($userid) er påmeldt på Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
 739                 } else {
 740                         my $seen = $seen_names{$sk};
 741                         if (scalar @$seen >= 2) {
 742                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men står flere steder (se over); vet ikke hvilken celle som skal brukes.");
 743                         } else {
 744                                 $want_colors{$seen->[0][0]} = $colors{$userid};
 745                         }
 746                 }
 747         }
 748
 749         # Find the list of names we already marked yellow.
 750         my %have_colors = ();
 751         $q = $dbh->prepare('SELECT name,color FROM applied WHERE channel=? AND ts=?');
 752         $q->execute($config::invitation_channel, $invitation_ts);
 753         while (my $ref = $q->fetchrow_hashref) {
 754                 $have_colors{$ref->{'name'}} = $ref->{'color'};
 755         }
 756
 757         my @diffs = find_diff($dbh, $invitation_ts, \%want_colors, \%have_colors, \%seen_names);
 758
 759         my @yellow_updates = ();
 760         if (scalar @diffs > 0) {
 761                 # Now fill in the actual stuff.
 762                 for my $diff (@diffs) {
 763                         my $real_name = $diff->[0];
 764
 765                         my $seen = $seen_names{sort_key($real_name)};
 766
 767                         # We've already complained about these earlier, so just skip them silently.
 768                         next if (scalar @$seen > 1);
 769
 770                         # See if we can find them in the spreadsheet.
 771                         die "Could not find $real_name" if (!defined($seen));
 772                         my $rowno = $seen->[0][1];
 773                         my $colno = $seen->[0][2];
 774                         push @yellow_updates, {
 775                                 updateCells => {
 776                                         rows => [{
 777                                                 values => [{
 778                                                         userEnteredFormat => $diff->[1]
 779                                                 }]
 780                                         }],
 781                                         fields => 'userEnteredFormat.backgroundColor',
 782                                         range => {
 783                                                 sheetId => $tab_id,
 784                                                 startRowIndex => $rowno,
 785                                                 endRowIndex => $rowno + 1,
 786                                                 startColumnIndex => $colno,
 787                                                 endColumnIndex => $colno + 1
 788                                         }
 789                                 }
 790                         };
 791                 }
 792         }
 793
 794         my @recent_changes = create_reaction_log($dbh, $invitation_ts, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 795         push @yellow_updates, {
 796                 updateCells => {
 797                         rows => \@recent_changes,
 798                         fields => 'userEnteredValue.stringValue',
 799                         range => {
 800                                 sheetId => $config::log_tab_id,
 801                                 startRowIndex => 4,
 802                                 endRowIndex => 4 + scalar @recent_changes,
 803                                 startColumnIndex => 0,
 804                                 endColumnIndex => 1
 805                         }
 806                 }
 807         };
 808
 809         my @recent_moves = create_move_log($dbh, $invitation_ts, $prev_invitation_ts);
 810         push @yellow_updates, {
 811                 updateCells => {
 812                         rows => \@recent_moves,
 813                         fields => 'userEnteredValue.stringValue',
 814                         range => {
 815                                 sheetId => $config::log_tab_id,
 816                                 startRowIndex => 4,
 817                                 endRowIndex => 4 + scalar @recent_moves,
 818                                 startColumnIndex => 1,
 819                                 endColumnIndex => 2
 820                         }
 821                 }
 822         };
 823
 824         # Push the final set of updates (including the log).
 825         skv_log("Ferdig.");
 826         push @yellow_updates, serialize_skv_log_to_sheet();
 827         sheet_batch_update($ua, $token, \@yellow_updates);
 828         $dbh->commit;
 829
 830         my $elapsed = Time::HiRes::tv_interval($total_start);
 831         printf "Tok %.0f ms.\n", 1e3 * $elapsed;
 832 }
 833
 834 # Initialize the handles we need for communication.
 835 my $dbh = db_connect() or die;
 836 my $ua = LWP::UserAgent->new(agent => 'SKVidarLang/1.0', keep_alive => 50);
 837 if ($#ARGV >= 0 && $ARGV[0] eq '--daemon') {
 838         # Start with a single, forced run.
 839         run($dbh, $ua);
 840
 841         while (1) {
 842                 while (!defined($dbh)) {
 843                         print STDERR "Database connection lost, reconnecting...\n";
 844                         sleep 1;
 845                         $dbh = db_connect();
 846                 }
 847                 my $s = IO::Select->new($dbh->{pg_socket});
 848                 my @ready = $s->can_read(10.0);
 849                 my @exceptions = $s->has_exception(0.0);
 850
 851                 if (scalar @exceptions > 0) {
 852                         $dbh->disconnect;
 853                         $dbh = undef;
 854                         next;
 855                 }
 856                 if (scalar @ready > 0) {
 857                         eval {
 858                                 run($dbh, $ua);
 859                         };
 860                         if ($@) {
 861                                 warn "Died with: $@";
 862                                 $dbh = undef;
 863                         }
 864                 }
 865         }
 866 } elsif ($#ARGV >= 0 && $ARGV[0] eq '--benchmark') {
 867         for my $i (0..9) {
 868                 run($dbh, $ua);
 869         }
 870 } else {
 871         run($dbh, $ua);
 872 }