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