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         my %db_assignments = ();
 239         my $q = $dbh->prepare('SELECT name,group_name FROM current_group_membership_history WHERE channel=? AND ts=?');
 240         $q->execute($channel, $ts);
 241         while (my $ref = $q->fetchrow_hashref) {
 242                 if (defined($ref->{'group_name'})) {
 243                         $db_assignments{$ref->{'name'}} = $ref->{'group_name'};
 244                 }
 245         }
 246
 247         $q = $dbh->prepare('INSERT INTO group_membership_history (channel, ts, name, change_seen, group_name) VALUES (?, ?, ?, CURRENT_TIMESTAMP, ?)');
 248         for my $name (keys %$assignments) {
 249                 if (!exists($db_assignments{$name}) || $db_assignments{$name} ne $assignments->{$name}) {
 250                         $q->execute($channel, $ts, $name, $assignments->{$name});
 251                 }
 252         }
 253         for my $name (keys %db_assignments) {
 254                 if (!exists($assignments->{$name})) {
 255                         $q->execute($channel, $ts, $name, undef);
 256                 }
 257         }
 258 }
 259
 260 sub get_spreadsheet_with_title {
 261         my ($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title) = @_;
 262
 263         # See if we have any spreadsheets that match this title.
 264         my $start = [Time::HiRes::gettimeofday];
 265         my $response = $ua->get('https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '?key=' . $config::gsheets_api_key . '&fields=sheets/properties',
 266                 Authorization => 'Bearer ' . $token,
 267                 Accept_Encoding => HTTP::Message::decodable
 268         );
 269         log_timing($start, '/spreadsheets/properties');
 270         my $sheets_json = JSON::XS::decode_json($response->decoded_content);
 271         my ($tab_name, $tab_id);
 272         for my $sheet (@{$sheets_json->{'sheets'}}) {
 273                 my $title = $sheet->{'properties'}{'title'};
 274                 my $sheet_id = $sheet->{'properties'}{'sheetId'};
 275                 if ($title =~ /\Q$wanted_sheet_title\E/) {
 276                         # skv_log("Synkroniserer ($config::invitation_channel, $invitation_ts) mot arket “$title” (fane-ID $sheet_id).");
 277                         $dbh->do('UPDATE message_sheet_link SET tab_name=?, tab_id=? WHERE channel=? AND ts=?',
 278                                 undef, $title, $sheet_id, $config::invitation_channel, $invitation_ts);
 279                         return ($title, $sheet_id);
 280                 }
 281         }
 282         return (undef, undef);
 283 }
 284
 285 # Make a mapping of lowercase name -> list of [canonical name, row number, column number]
 286 sub find_where_each_name_is {
 287         my $json = shift;
 288
 289         my %seen_names = ();
 290         my $rows = $json->{'data'}[0]{'rowData'};
 291         my $rowno = 3;
 292         for my $row (@$rows) {
 293                 my $colno = 0;
 294                 for my $val (@{$row->{'values'}}) {
 295                         my $name = get_spreadsheet_name($val);
 296                         if (defined($name)) {
 297                                 push @{$seen_names{sort_key($name)}}, [$name, $rowno, $colno];
 298                         }
 299                         ++$colno;
 300                 }
 301                 ++$rowno;
 302         }
 303
 304         return %seen_names;
 305 }
 306
 307 sub best_name_for_log {
 308         my ($userid, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
 309         if (exists($slack_userid_to_real_name->{$userid})) {
 310                 return $slack_userid_to_real_name->{$userid};
 311         } elsif (exists($slack_userid_to_slack_name->{$userid})) {
 312                 return $slack_userid_to_slack_name->{$userid} . ' (fant ikke regneark-navn)';
 313         } else {
 314                 # Should only happen if we didn't see the initial reaction_add, only reaction_remove.
 315                 # (TODO: Is the comment above true anymore, now that we use this from multiple contexts?)
 316                 return $userid . ' (fant ikke Slack-navn)';
 317         }
 318 }
 319
 320 # Add the reaction log. (This only takes into account the last change
 321 # for each user; earlier ones are irrelevant and don't count. But it
 322 # doesn't deduplicate across reactions. Meh.)
 323 sub create_reaction_log {
 324         my ($dbh, $invitation_ts, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
 325
 326         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');
 327         $q->execute($config::invitation_channel, $invitation_ts);
 328         my @recent_changes = ();
 329         while (my $ref = $q->fetchrow_hashref) {
 330                 my $msg = $ref->{'event_ts'};
 331                 if ($ref->{'event_type'} eq 'reaction_added') {
 332                         $msg .= ' +';
 333                 } else {
 334                         $msg .= ' –';
 335                 }
 336                 if ($ref->{'reaction'} eq 'open_mouth') {
 337                         $msg .= '😮';
 338                 } elsif ($ref->{'reaction'} eq 'blue_heart') {
 339                         $msg .= '💙';
 340                 } else {
 341                         $msg .= '❤️';
 342                 }
 343                 $msg .= ' ';
 344                 $msg .= best_name_for_log($ref->{'userid'}, $slack_userid_to_real_name, $slack_userid_to_slack_name);
 345                 push @recent_changes, { values => [{ userEnteredValue => { stringValue => $msg } }] };
 346         }
 347         while (scalar @recent_changes < 50) {
 348                 push @recent_changes, { values => [{ userEnteredValue => { stringValue => '' } }] };
 349         }
 350         return @recent_changes;
 351 }
 352
 353 sub create_move_log {
 354          my ($dbh, $invitation_ts, $prev_invitation_ts) = @_;
 355          my $q = $dbh->prepare(<<"EOF");
 356 SELECT
 357   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
 358 FROM ( SELECT * FROM current_group_membership_history WHERE ts=? ) g_old
 359   FULL OUTER JOIN ( SELECT * FROM current_group_membership_history WHERE ts=? ) g_new USING (name)
 360 WHERE
 361   g_new.group_name IS DISTINCT FROM g_old.group_name
 362   AND g_new.group_name IS NOT NULL
 363 ORDER BY g_new.change_seen DESC, name
 364 LIMIT 50
 365 EOF
 366         $q->execute($prev_invitation_ts, $invitation_ts);
 367         my @recent_moves = ();
 368         while (my $ref = $q->fetchrow_hashref) {
 369                 my $name = $ref->{'name'};
 370                 my $old_group = $ref->{'old_group'};
 371                 my $new_group = $ref->{'new_group'};
 372
 373                 my $msg = $ref->{'change_seen'} . " ";
 374                 if (!defined($old_group)) {
 375                         $msg .= "$name, (ny løper) → $new_group";
 376                 } else {
 377                         $msg .= "$name, $old_group → $new_group";
 378                 }
 379                 push @recent_moves, { values => [{ userEnteredValue => { stringValue => $msg } }] };
 380         }
 381         while (scalar @recent_moves < 50) {
 382                 push @recent_moves, { values => [{ userEnteredValue => { stringValue => '' } }] };
 383         }
 384         return @recent_moves;
 385 }
 386
 387 # Also applies the diff to the database (a bit ugly).
 388 sub find_diff {
 389         my ($dbh, $invitation_ts, $want_colors, $have_colors, $seen_names) = @_;
 390
 391         my @diffs = ();
 392         for my $real_name (keys %$want_colors) {
 393                 my $wc = $want_colors->{$real_name};
 394                 if (exists($have_colors->{$real_name})) {
 395                         if ($have_colors->{$real_name} eq $wc) {
 396                                 # Already good.
 397                                 next;
 398                         }
 399                         skv_log("Markerer at $real_name har byttet treningssted.");
 400                         push @diffs, [
 401                                 $real_name, { backgroundColor => $rgb{$wc} }
 402                         ];
 403                         $dbh->do('UPDATE applied SET color=? WHERE channel=? AND ts=? AND name=?', undef,
 404                                 $wc, $config::invitation_channel, $invitation_ts, $real_name);
 405                 } else {
 406                         skv_log("Markerer at $real_name skal på trening.");
 407                         push @diffs, [
 408                                 $real_name, { backgroundColor => $rgb{$wc} }
 409                         ];
 410                         $dbh->do('INSERT INTO applied (channel, ts, name, color) VALUES (?, ?, ?, ?)', undef,
 411                                 $config::invitation_channel, $invitation_ts, $real_name, $wc);
 412                 }
 413         }
 414         for my $real_name (keys %$have_colors) {
 415                 next if (exists($want_colors->{$real_name}));
 416                 if (!exists($seen_names->{sort_key($real_name)})) {
 417                         # TODO: This can somehow come if we try to add someone who's not in the sheet, too?
 418                         skv_log("Ønsket å fjerne at $real_name skulle på trening, men de var ikke i regnearket lenger.");
 419                 } elsif (scalar @{$seen_names->{sort_key($real_name)}} > 1) {
 420                         # Don't touch them.
 421                 } else {
 422                         skv_log("Fjerner at $real_name skal på trening.");
 423                         push @diffs, [
 424                                 $real_name, { backgroundColor => $rgb{white} }
 425                         ];
 426                         $dbh->do('DELETE FROM applied WHERE channel=? AND ts=? AND name=?', undef,
 427                                 $config::invitation_channel, $invitation_ts, $real_name);
 428                 }
 429         }
 430         return @diffs;
 431 }
 432
 433 sub possibly_nag_user {
 434         my ($dbh, $ua, $userid, $invitation_ts, $group, $slack_userid_to_slack_name) = @_;
 435
 436         my $slack_name = $slack_userid_to_slack_name->{$userid};
 437
 438         # See if we've nagged this user before.
 439         my $q = $dbh->prepare('SELECT * FROM users_nagged WHERE userid=? AND ts=?');
 440         $q->execute($userid, $invitation_ts);
 441         if (defined($q->fetchrow_hashref)) {
 442                 return;
 443         }
 444
 445         my $msg;
 446         if (!defined($group)) {
 447                 $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!";
 448                 skv_log("Sender Slack-melding til $slack_name ($userid) for å spørre om gruppe.");
 449         } elsif ($group eq '(flere grupper)') {
 450                 $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!";
 451                 skv_log("Sender Slack-melding til $slack_name ($userid) for å spørre om gruppe.");
 452         } else {
 453                 $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!";
 454                 skv_log("Sender Slack-melding om at $slack_name ($userid) er i gruppe $group.");
 455         }
 456
 457         my $content = {
 458                 channel => $config::invitation_channel,
 459                 user => $userid,
 460                 text => $msg
 461         };
 462         my $start = [Time::HiRes::gettimeofday];
 463         my $response = $ua->post(
 464                 'https://slack.com/api/chat.postEphemeral',
 465                 Content => JSON::XS::encode_json($content),
 466                 Content_type => 'application/json;charset=UTF-8',
 467                 Authorization => 'Bearer ' . $config::slack_oauth_token
 468         );
 469         log_timing($start, 'chat.postEphemeral');
 470         die $response->status_line if !$response->is_success;
 471         my $msg_json = JSON::XS::decode_json($response->decoded_content);
 472         die "Something went wrong: " . $response->decoded_content if (!defined($msg_json) || !$msg_json->{'ok'});
 473
 474         # Mark that we've sent the message, so it won't happen again.
 475         $dbh->do('INSERT INTO users_nagged (userid, ts, last_nag) VALUES (?, ?, CURRENT_TIMESTAMP)', undef, $userid, $invitation_ts);
 476 }
 477
 478 sub db_connect {
 479         my $dbh = DBI->connect("dbi:Pg:dbname=$config::dbname;host=127.0.0.1", $config::dbuser, $config::dbpass, {RaiseError => 1})
 480                 or warn "Could not connect to Postgres: " . DBI->errstr;
 481         if (!defined($dbh)) {
 482                 return undef;
 483         }
 484         $dbh->{AutoCommit} = 0;
 485         $dbh->do('LISTEN skvupdate') or return undef;
 486         return $dbh;
 487 }
 488
 489 sub run {
 490         my ($dbh, $ua) = @_;
 491         my $total_start = [Time::HiRes::gettimeofday];
 492
 493         @log = ();
 494         skv_log("Siste sync startet: " . POSIX::ctime(time));
 495
 496         # For the logic on the “applied” table below.
 497         $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE');
 498
 499         my $token = get_oauth_bearer_token($dbh, $ua);
 500
 501         # Find the newest message, what it is linked to, and what was the one before it (for group diffing).
 502         # TODO: Support more than one, and test better for errors here.
 503         my $q = $dbh->prepare('select * from message_sheet_link where channel=? order by ts desc limit 2');
 504         $q->execute($config::invitation_channel);
 505         my $linkref = $q->fetchrow_hashref;
 506         my $invitation_ts = $linkref->{'ts'};
 507         my $wanted_sheet_title = $linkref->{'sheet_title'};
 508         die "Could not get newest sheet title" if (!defined($wanted_sheet_title));
 509         my $tab_name = $linkref->{'tab_name'};
 510         my $tab_id = $linkref->{'tab_id'};
 511
 512         # Store away the second-newest ID.
 513         my $prev_invitation_ts = $q->fetchrow_hashref->{'ts'};
 514
 515         if (!defined($tab_name) || !defined($tab_id)) {
 516                 ($tab_name, $tab_id) = get_spreadsheet_with_title($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title);
 517                 if (!defined($tab_name)) {
 518                         skv_log("Fant ikke noen fane med «$wanted_sheet_title» i navnet; kan ikke synkronisere.\n");
 519                         sheet_batch_update($ua, $token, [ serialize_skv_log_to_sheet() ]);
 520                         die;
 521                 }
 522         }
 523
 524         # Find everyone who are marked as attending on Slack (via reactions).
 525         $q = $dbh->prepare('SELECT DISTINCT userid,reaction FROM current_reactions WHERE channel=? AND ts=? AND reaction IN (\'heart\', \'open_mouth\', \'blue_heart\')');
 526         $q->execute($config::invitation_channel, $invitation_ts);
 527         my @attending_userids = ();
 528         my %colors = ();
 529         my %double = ();
 530         while (my $ref = $q->fetchrow_hashref) {
 531                 my $userid = $ref->{'userid'};
 532                 push @attending_userids, $userid;
 533                 if ($ref->{'reaction'} eq 'blue_heart') {
 534                         if (exists($colors{$userid}) && $colors{$userid} eq 'yellow') {
 535                                 $double{$userid} = 1;
 536                         }
 537                         $colors{$userid} = 'blue';
 538                 } else {
 539                         if (exists($colors{$userid}) && $colors{$userid} eq 'blue') {
 540                                 $double{$userid} = 1;
 541                         }
 542                         $colors{$userid} = 'yellow';
 543                 }
 544         }
 545
 546         # Remove double-attenders (we will log them as warnings further down).
 547         @attending_userids = grep { !exists($double{$_}) } @attending_userids;
 548         for my $userid (keys %double) {
 549                 delete $colors{$userid};
 550         }
 551
 552         # Get the list of all people in the sheet (we're going to need them soon).
 553         # Also get the Slack mapping when we're doing an API request anyway.
 554         my $start = [Time::HiRes::gettimeofday];
 555         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',
 556                 Authorization => 'Bearer ' . $token,
 557                 Accept_Encoding => HTTP::Message::decodable
 558         );
 559         log_timing($start, "/spreadsheets/");
 560
 561         my $sheets_json = JSON::XS::decode_json($response->decoded_content);
 562         my $main_sheet_json = $sheets_json->{'sheets'}[0];
 563         my $mapping_sheet_json = $sheets_json->{'sheets'}[1];
 564
 565         # Update the list of groups we've seen people in.
 566         my %assignments = get_group_assignments($main_sheet_json);
 567         update_assignment_db($dbh, $config::invitation_channel, $invitation_ts, \%assignments);
 568
 569         $start = [Time::HiRes::gettimeofday];
 570         my %seen_names = find_where_each_name_is($main_sheet_json);
 571         log_timing($start, "Making sort key reverse mapping");
 572
 573         # Find duplicates.
 574         for my $name (sort keys %seen_names) {
 575                 my $seen = $seen_names{$name};
 576                 if (scalar @$seen >= 2) {
 577                         my $exemplar = $seen->[0][0];
 578                         skv_log("Duplikat: $exemplar (" . format_cell_names_for_seen($seen) . ")");
 579                 }
 580         }
 581
 582         # Get our existing Slack->name mapping, from the sheets.
 583         my %slack_userid_to_real_name = ();
 584         my %slack_userid_to_slack_name = ();
 585         my %slack_userid_to_row = ();
 586
 587         my $mapping_sheet_rows = $mapping_sheet_json->{'data'}[0]{'rowData'};
 588         my $cur_row = 5;
 589         for my $row (@$mapping_sheet_rows) {
 590                 my $slack_id = $row->{'values'}[0]{'userEnteredValue'}{'stringValue'};
 591                 my $slack_name = $row->{'values'}[1]{'userEnteredValue'}{'stringValue'};
 592                 my $real_name = get_spreadsheet_name($row->{'values'}[2]);  # TODO support more
 593                 $slack_userid_to_row{$slack_id} = $cur_row++;
 594                 next if (!defined($slack_name));
 595                 $slack_userid_to_slack_name{$slack_id} = $slack_name;
 596                 next if (!defined($real_name));
 597                 $slack_userid_to_real_name{$slack_id} = $real_name;
 598         }
 599
 600         # See which ones we don't have a mapping for, and look them up in Slack.
 601         # TODO: Use an append call instead of $cur_row?
 602         my @slack_mapping_updates = ();
 603         for my $userid (@attending_userids) {
 604                 next if (exists($slack_userid_to_real_name{$userid}));
 605
 606                 # Make sure they have a row in the spreadsheet.
 607                 my $write_row;
 608                 if (exists($slack_userid_to_row{$userid})) {
 609                         $write_row = $slack_userid_to_row{$userid};
 610                 } else {
 611                         $write_row = $cur_row++;
 612                         $slack_userid_to_row{$userid} = $write_row;
 613                         push @slack_mapping_updates, {
 614                                 range => "Slack-mapping!A$write_row:A$write_row",
 615                                 values => [ [ $userid ]]
 616                         };
 617                 }
 618
 619                 # Fetch their Slack name if we don't already have it.
 620                 my $slack_name;
 621                 if (exists($slack_userid_to_slack_name{$userid})) {
 622                         $slack_name = $slack_userid_to_slack_name{$userid};
 623                 } else {
 624                         $slack_userid_to_slack_name{$userid} = $slack_name;
 625                         $slack_name = get_slack_name($ua, $userid);
 626                         push @slack_mapping_updates, {
 627                                 range => "Slack-mapping!B$write_row:B$write_row",
 628                                 values => [ [ $slack_name ]]
 629                         };
 630                         $slack_userid_to_slack_name{$userid} = $slack_name;
 631                 }
 632
 633                 if (exists($seen_names{sort_key($slack_name)})) {
 634                         # The name exists exactly, once or more, so it's a direct match and we ignore any fuzz.
 635                         $slack_userid_to_real_name{$userid} = $slack_name;
 636                         push @slack_mapping_updates, {
 637                                 range => "Slack-mapping!C$write_row:C$write_row",
 638                                 values => [ [ $slack_name ]]
 639                         };
 640                 } else {
 641                         # Do a search through all the available names in the sheet to find an obvious(ish) match.
 642                         my @candidates = ();
 643                         my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
 644                         $start = [Time::HiRes::gettimeofday];
 645                         my @ap = map { sort_key($_) } split /\s+/, $slack_name;  # Precalc for matches_name().
 646                         for my $row (@$main_sheet_rows) {
 647                                 for my $val (@{$row->{'values'}}) {
 648                                         my $name = get_spreadsheet_name($val);
 649                                         if (defined($name) && matches_name($slack_name, $name, \@ap)) {
 650                                                 push @candidates, $name;
 651                                         }
 652                                 }
 653                         }
 654                         log_timing($start, "Fuzzy-searching for Slack name “$slack_name”");
 655                         if ($#candidates == -1) {
 656                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men fant ikke et regneark-navn for dem.");
 657                                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, undef, \%slack_userid_to_slack_name);
 658                         } elsif ($#candidates == 0) {
 659                                 my $name = $candidates[0];
 660                                 $slack_userid_to_real_name{$userid} = $name;
 661                                 push @slack_mapping_updates, {
 662                                         range => "Slack-mapping!C$write_row:C$write_row",
 663                                         values => [ [ $name ]]
 664                                 };
 665                         } else {
 666                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men hadde flere fuzzy-matcher; vet ikke hvilket regneark-navn som skal brukes.");
 667                         }
 668                 }
 669         }
 670         if (scalar @slack_mapping_updates > 0) {
 671                 my $update = {
 672                         valueInputOption => 'USER_ENTERED',
 673                         data => \@slack_mapping_updates
 674                 };
 675                 $start = [Time::HiRes::gettimeofday];
 676                 $response = $ua->post(
 677                         'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '/values:batchUpdate?key=' . $config::gsheets_api_key,
 678                         Content => JSON::XS::encode_json($update),
 679                         Content_type => 'application/json;charset=UTF-8',
 680                         Authorization => 'Bearer ' . $token
 681                 );
 682                 log_timing($start, "/spreadsheets/values:batchUpdate");
 683                 die $response->decoded_content if (!$response->is_success);
 684         }
 685
 686         # Now that we have Slack names, we can log double-reacters.
 687         for my $userid (keys %double) {
 688                 my $name = best_name_for_log($userid, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 689                 skv_log("$name er påmeldt flere steder på Slack; vet ikke hvilken som skal brukes.");
 690         }
 691
 692         # ...and possibly send welcome messages to remind them of groups.
 693         for my $userid (@attending_userids) {
 694                 my $real_name = $slack_userid_to_real_name{$userid};
 695                 next if (!defined($real_name));
 696                 my $group = $assignments{$real_name};
 697                 next if (!defined($group));
 698                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, $group, \%slack_userid_to_slack_name);
 699         }
 700
 701         # Find the list of names to mark yellow.
 702         my %want_colors = ();
 703         my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
 704         for my $userid (@attending_userids) {
 705                 next if (!exists($slack_userid_to_real_name{$userid}));
 706                 my $slack_name = $slack_userid_to_slack_name{$userid};
 707                 my $real_name = $slack_userid_to_real_name{$userid};
 708
 709                 # See if we can find them in the spreadsheet.
 710                 if (!exists($seen_names{sort_key($real_name)})) {
 711                         # TODO: Perhaps move this logic further down, for consistency?
 712                         skv_log("$slack_name ($userid) er påmeldt på Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
 713                 } else {
 714                         my $seen = $seen_names{sort_key($real_name)};
 715                         if (scalar @$seen >= 2) {
 716                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men står flere steder (se over); vet ikke hvilken celle som skal brukes.");
 717                         } else {
 718                                 $want_colors{$seen->[0][0]} = $colors{$userid};
 719                         }
 720                 }
 721         }
 722
 723         # Find the list of names we already marked yellow.
 724         my %have_colors = ();
 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                                 run($dbh, $ua);
 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                 run($dbh, $ua);
 843         }
 844 } else {
 845         run($dbh, $ua);
 846 }