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

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