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