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