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) = @_;
 426
 427         # See if we've nagged this user before.
 428         my $q = $dbh->prepare('SELECT * FROM users_nagged WHERE userid=? AND ts=?');
 429         $q->execute($userid, $invitation_ts);
 430         if (defined($q->fetchrow_hashref)) {
 431                 return;
 432         }
 433
 434         my $msg;
 435         if (!defined($group)) {
 436                 $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!";
 437                 skv_log("Sender Slack-melding til $userid for å spørre om gruppe.");
 438         } elsif ($group eq '(flere grupper)') {
 439                 $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!";
 440                 skv_log("Sender Slack-melding til $userid for å spørre om gruppe.");
 441         } else {
 442                 $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!";
 443                 skv_log("Sender Slack-melding om at $userid er i gruppe $group.");
 444         }
 445
 446         my $content = {
 447                 channel => $config::invitation_channel,
 448                 user => $userid,
 449                 text => $msg
 450         };
 451         my $start = [Time::HiRes::gettimeofday];
 452         my $response = $ua->post(
 453                 'https://slack.com/api/chat.postEphemeral',
 454                 Content => JSON::XS::encode_json($content),
 455                 Content_type => 'application/json;charset=UTF-8',
 456                 Authorization => 'Bearer ' . $config::slack_oauth_token
 457         );
 458         log_timing($start, 'chat.postEphemeral');
 459         die $response->status_line if !$response->is_success;
 460         my $msg_json = JSON::XS::decode_json($response->decoded_content);
 461         die "Something went wrong: " . $response->decoded_content if (!defined($msg_json) || !$msg_json->{'ok'});
 462
 463         # Mark that we've sent the message, so it won't happen again.
 464         $dbh->do('INSERT INTO users_nagged (userid, ts, last_nag) VALUES (?, ?, CURRENT_TIMESTAMP)', undef, $userid, $invitation_ts);
 465 }
 466
 467 sub db_connect {
 468         my $dbh = DBI->connect("dbi:Pg:dbname=$config::dbname;host=127.0.0.1", $config::dbuser, $config::dbpass, {RaiseError => 1})
 469                 or warn "Could not connect to Postgres: " . DBI->errstr;
 470         if (!defined($dbh)) {
 471                 return undef;
 472         }
 473         $dbh->do('LISTEN skvupdate') or return undef;
 474         return $dbh;
 475 }
 476
 477 sub run {
 478         my $dbh = shift;
 479         my $total_start = [Time::HiRes::gettimeofday];
 480
 481         @log = ();
 482         skv_log("Siste sync startet: " . POSIX::ctime(time));
 483
 484         # Initialize the handles we need for communication.
 485         my $ua = LWP::UserAgent->new('SKVidarLang/1.0');
 486         my $token = get_oauth_bearer_token($dbh, $ua);
 487
 488         # Find the newest message, what it is linked to, and what was the one before it (for group diffing).
 489         # TODO: Support more than one, and test better for errors here.
 490         my $q = $dbh->prepare('select * from message_sheet_link where channel=? order by ts desc limit 2');
 491         $q->execute($config::invitation_channel);
 492         my $linkref = $q->fetchrow_hashref;
 493         my $invitation_ts = $linkref->{'ts'};
 494         my $wanted_sheet_title = $linkref->{'sheet_title'};
 495         die "Could not get newest sheet title" if (!defined($wanted_sheet_title));
 496
 497         my ($tab_name, $tab_id) = get_spreadsheet_with_title($ua, $token, $wanted_sheet_title);
 498         if (!defined($tab_name)) {
 499                 skv_log("Fant ikke noen fane med «$wanted_sheet_title» i navnet; kan ikke synkronisere.\n");
 500                 sheet_batch_update($ua, $token, [ serialize_skv_log_to_sheet() ]);
 501                 die;
 502         }
 503
 504         # Store away the second-newest ID.
 505         my $prev_invitation_ts = $q->fetchrow_hashref->{'ts'};
 506
 507         # Find everyone who are marked as attending on Slack (via reactions).
 508         $q = $dbh->prepare('SELECT DISTINCT userid,reaction FROM current_reactions WHERE channel=? AND ts=? AND reaction IN (\'heart\', \'open_mouth\', \'blue_heart\')');
 509         $q->execute($config::invitation_channel, $invitation_ts);
 510         my @attending_userids = ();
 511         my %colors = ();
 512         my %double = ();
 513         while (my $ref = $q->fetchrow_hashref) {
 514                 my $userid = $ref->{'userid'};
 515                 push @attending_userids, $userid;
 516                 if ($ref->{'reaction'} eq 'blue_heart') {
 517                         if (exists($colors{$userid}) && $colors{$userid} eq 'yellow') {
 518                                 $double{$userid} = 1;
 519                         }
 520                         $colors{$userid} = 'blue';
 521                 } else {
 522                         if (exists($colors{$userid}) && $colors{$userid} eq 'blue') {
 523                                 $double{$userid} = 1;
 524                         }
 525                         $colors{$userid} = 'yellow';
 526                 }
 527         }
 528
 529         # Remove double-attenders (we will log them as warnings further down).
 530         @attending_userids = grep { !exists($double{$_}) } @attending_userids;
 531         for my $userid (keys %double) {
 532                 delete $colors{$userid};
 533         }
 534
 535         # Get the list of all people in the sheet (we're going to need them soon anyway).
 536         my $start = [Time::HiRes::gettimeofday];
 537         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',
 538                 Authorization => 'Bearer ' . $token,
 539                 Accept_Encoding => HTTP::Message::decodable
 540         );
 541         log_timing($start, "/spreadsheets/$tab_name");
 542
 543         my $main_sheet_json = JSON::XS::decode_json($response->decoded_content);
 544
 545         # Update the list of groups we've seen people in.
 546         my %assignments = get_group_assignments($main_sheet_json);
 547         update_assignment_db($dbh, $config::invitation_channel, $invitation_ts, \%assignments);
 548
 549         my %seen_names = find_where_each_name_is($main_sheet_json);
 550
 551         # Find duplicates.
 552         for my $name (sort keys %seen_names) {
 553                 my $seen = $seen_names{$name};
 554                 if (scalar @$seen >= 2) {
 555                         my $exemplar = $seen->[0][0];
 556                         skv_log("Duplikat: $exemplar (" . format_cell_names_for_seen($seen) . ")");
 557                 }
 558         }
 559
 560         # Get our existing Slack->name mapping, from the sheets.
 561         my %slack_userid_to_real_name = ();
 562         my %slack_userid_to_slack_name = ();
 563         my %slack_userid_to_row = ();
 564
 565         $start = [Time::HiRes::gettimeofday];
 566         $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',
 567                 Authorization => 'Bearer ' . $token,
 568                 Accept_Encoding => HTTP::Message::decodable
 569         );
 570         log_timing($start, "/spreadsheets/Slack-mapping");
 571         my $mapping_sheet_json = JSON::XS::decode_json($response->decoded_content);
 572         my $mapping_sheet_rows = $mapping_sheet_json->{'sheets'}[0]{'data'}[0]{'rowData'};
 573         my $cur_row = 5;
 574         for my $row (@$mapping_sheet_rows) {
 575                 my $slack_id = $row->{'values'}[0]{'userEnteredValue'}{'stringValue'};
 576                 my $slack_name = $row->{'values'}[1]{'userEnteredValue'}{'stringValue'};
 577                 my $real_name = get_spreadsheet_name($row->{'values'}[2]);  # TODO support more
 578                 $slack_userid_to_row{$slack_id} = $cur_row++;
 579                 next if (!defined($slack_name));
 580                 $slack_userid_to_slack_name{$slack_id} = $slack_name;
 581                 next if (!defined($real_name));
 582                 $slack_userid_to_real_name{$slack_id} = $real_name;
 583         }
 584
 585         # See which ones we don't have a mapping for, and look them up in Slack.
 586         # TODO: Use an append call instead of $cur_row?
 587         my @slack_mapping_updates = ();
 588         for my $userid (@attending_userids) {
 589                 next if (exists($slack_userid_to_real_name{$userid}));
 590
 591                 # Make sure they have a row in the spreadsheet.
 592                 my $write_row;
 593                 if (exists($slack_userid_to_row{$userid})) {
 594                         $write_row = $slack_userid_to_row{$userid};
 595                 } else {
 596                         $write_row = $cur_row++;
 597                         $slack_userid_to_row{$userid} = $write_row;
 598                         push @slack_mapping_updates, {
 599                                 range => "Slack-mapping!A$write_row:A$write_row",
 600                                 values => [ [ $userid ]]
 601                         };
 602                 }
 603
 604                 # Fetch their Slack name if we don't already have it.
 605                 my $slack_name;
 606                 if (exists($slack_userid_to_slack_name{$userid})) {
 607                         $slack_name = $slack_userid_to_slack_name{$userid};
 608                 } else {
 609                         $slack_userid_to_slack_name{$userid} = $slack_name;
 610                         $slack_name = get_slack_name($ua, $userid);
 611                         push @slack_mapping_updates, {
 612                                 range => "Slack-mapping!B$write_row:B$write_row",
 613                                 values => [ [ $slack_name ]]
 614                         };
 615                         $slack_userid_to_slack_name{$userid} = $slack_name;
 616                 }
 617
 618                 if (exists($seen_names{sort_key($slack_name)})) {
 619                         # The name exists exactly, once or more, so it's a direct match and we ignore any fuzz.
 620                         $slack_userid_to_real_name{$userid} = $slack_name;
 621                         push @slack_mapping_updates, {
 622                                 range => "Slack-mapping!C$write_row:C$write_row",
 623                                 values => [ [ $slack_name ]]
 624                         };
 625                 } else {
 626                         # Do a search through all the available names in the sheet to find an obvious(ish) match.
 627                         my @candidates = ();
 628                         my $main_sheet_rows = $main_sheet_json->{'sheets'}[0]{'data'}[0]{'rowData'};
 629                         for my $row (@$main_sheet_rows) {
 630                                 for my $val (@{$row->{'values'}}) {
 631                                         my $name = get_spreadsheet_name($val);
 632                                         if (defined($name) && matches_name($slack_name, $name)) {
 633                                                 push @candidates, $name;
 634                                         }
 635                                 }
 636                         }
 637                         if ($#candidates == -1) {
 638                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men fant ikke et regneark-navn for dem.");
 639                                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, undef);
 640                         } elsif ($#candidates == 0) {
 641                                 my $name = $candidates[0];
 642                                 $slack_userid_to_real_name{$userid} = $name;
 643                                 push @slack_mapping_updates, {
 644                                         range => "Slack-mapping!C$write_row:C$write_row",
 645                                         values => [ [ $name ]]
 646                                 };
 647                         } else {
 648                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men hadde flere fuzzy-matcher; vet ikke hvilket regneark-navn som skal brukes.");
 649                         }
 650                 }
 651         }
 652         if (scalar @slack_mapping_updates > 0) {
 653                 my $update = {
 654                         valueInputOption => 'USER_ENTERED',
 655                         data => \@slack_mapping_updates
 656                 };
 657                 $start = [Time::HiRes::gettimeofday];
 658                 $response = $ua->post(
 659                         'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '/values:batchUpdate?key=' . $config::gsheets_api_key,
 660                         Content => JSON::XS::encode_json($update),
 661                         Content_type => 'application/json;charset=UTF-8',
 662                         Authorization => 'Bearer ' . $token
 663                 );
 664                 log_timing($start, "/spreadsheets/values:batchUpdate");
 665                 die $response->decoded_content if (!$response->is_success);
 666         }
 667
 668         # Now that we have Slack names, we can log double-reacters.
 669         for my $userid (keys %double) {
 670                 my $name = best_name_for_log($userid, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 671                 skv_log("$name er påmeldt flere steder på Slack; vet ikke hvilken som skal brukes.");
 672         }
 673
 674         # ...and possibly send welcome messages to remind them of groups.
 675         for my $userid (@attending_userids) {
 676                 my $real_name = $slack_userid_to_real_name{$userid};
 677                 next if (!defined($real_name));
 678                 my $group = $assignments{$real_name};
 679                 next if (!defined($group));
 680                 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, $group);
 681         }
 682
 683         # Find the list of names to mark yellow.
 684         my %want_colors = ();
 685         my $main_sheet_rows = $main_sheet_json->{'sheets'}[0]{'data'}[0]{'rowData'};
 686         for my $userid (@attending_userids) {
 687                 next if (!exists($slack_userid_to_real_name{$userid}));
 688                 my $slack_name = $slack_userid_to_slack_name{$userid};
 689                 my $real_name = $slack_userid_to_real_name{$userid};
 690
 691                 # See if we can find them in the spreadsheet.
 692                 if (!exists($seen_names{sort_key($real_name)})) {
 693                         # TODO: Perhaps move this logic further down, for consistency?
 694                         skv_log("$slack_name ($userid) er påmeldt på Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
 695                 } else {
 696                         my $seen = $seen_names{sort_key($real_name)};
 697                         if (scalar @$seen >= 2) {
 698                                 skv_log("$slack_name ($userid) er påmeldt på Slack, men står flere steder (se over); vet ikke hvilken celle som skal brukes.");
 699                         } else {
 700                                 $want_colors{$seen->[0][0]} = $colors{$userid};
 701                         }
 702                 }
 703         }
 704
 705         # Find the list of names we already marked yellow.
 706         my %have_colors = ();
 707         $dbh->{AutoCommit} = 0;
 708         $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE');
 709         $q = $dbh->prepare('SELECT name,color FROM applied WHERE channel=? AND ts=?');
 710         $q->execute($config::invitation_channel, $invitation_ts);
 711         while (my $ref = $q->fetchrow_hashref) {
 712                 $have_colors{$ref->{'name'}} = $ref->{'color'};
 713         }
 714
 715         my @diffs = find_diff($dbh, $invitation_ts, \%want_colors, \%have_colors, \%seen_names);
 716
 717         my @yellow_updates = ();
 718         if (scalar @diffs > 0) {
 719                 # Now fill in the actual stuff.
 720                 for my $diff (@diffs) {
 721                         my $real_name = $diff->[0];
 722
 723                         my $seen = $seen_names{sort_key($real_name)};
 724
 725                         # We've already complained about these earlier, so just skip them silently.
 726                         next if (scalar @$seen > 1);
 727
 728                         # See if we can find them in the spreadsheet.
 729                         die "Could not find $real_name" if (!defined($seen));
 730                         my $rowno = $seen->[0][1];
 731                         my $colno = $seen->[0][2];
 732                         push @yellow_updates, {
 733                                 updateCells => {
 734                                         rows => [{
 735                                                 values => [{
 736                                                         userEnteredFormat => $diff->[1]
 737                                                 }]
 738                                         }],
 739                                         fields => 'userEnteredFormat.backgroundColor',
 740                                         range => {
 741                                                 sheetId => $tab_id,
 742                                                 startRowIndex => $rowno,
 743                                                 endRowIndex => $rowno + 1,
 744                                                 startColumnIndex => $colno,
 745                                                 endColumnIndex => $colno + 1
 746                                         }
 747                                 }
 748                         };
 749                 }
 750         }
 751
 752         my @recent_changes = create_reaction_log($dbh, $invitation_ts, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
 753         push @yellow_updates, {
 754                 updateCells => {
 755                         rows => \@recent_changes,
 756                         fields => 'userEnteredValue.stringValue',
 757                         range => {
 758                                 sheetId => $config::log_tab_id,
 759                                 startRowIndex => 4,
 760                                 endRowIndex => 4 + scalar @recent_changes,
 761                                 startColumnIndex => 0,
 762                                 endColumnIndex => 1
 763                         }
 764                 }
 765         };
 766
 767         my @recent_moves = create_move_log($dbh, $invitation_ts, $prev_invitation_ts);
 768         push @yellow_updates, {
 769                 updateCells => {
 770                         rows => \@recent_moves,
 771                         fields => 'userEnteredValue.stringValue',
 772                         range => {
 773                                 sheetId => $config::log_tab_id,
 774                                 startRowIndex => 4,
 775                                 endRowIndex => 4 + scalar @recent_moves,
 776                                 startColumnIndex => 1,
 777                                 endColumnIndex => 2
 778                         }
 779                 }
 780         };
 781
 782         # Push the final set of updates (including the log).
 783         skv_log("Ferdig.");
 784         push @yellow_updates, serialize_skv_log_to_sheet();
 785         sheet_batch_update($ua, $token, \@yellow_updates);
 786         $dbh->commit;
 787
 788         my $elapsed = Time::HiRes::tv_interval($total_start);
 789         printf "Tok %.0f ms.\n", 1e3 * $elapsed;
 790 }
 791
 792 my $dbh = db_connect() or die;
 793 if ($#ARGV >= 0 && $ARGV[0] eq '--daemon') {
 794         # Start with a single, forced run.
 795         run($dbh);
 796
 797         while (1) {
 798                 while (!defined($dbh)) {
 799                         print STDERR "Database connection lost, reconnecting...\n";
 800                         sleep 1;
 801                         $dbh = db_connect();
 802                 }
 803                 my $s = IO::Select->new($dbh->{pg_socket});
 804                 my @ready = $s->can_read(10.0);
 805                 my @exceptions = $s->has_exception(0.0);
 806
 807                 if (scalar @exceptions > 0) {
 808                         $dbh->disconnect;
 809                         $dbh = undef;
 810                         next;
 811                 }
 812                 if (scalar @ready > 0) {
 813                         eval {
 814                                 $dbh->{AutoCommit} = 1;
 815                                 run($dbh);
 816                                 $dbh->commit;
 817                         };
 818                         if ($@) {
 819                                 warn "Died with: $@";
 820                                 $dbh = undef;
 821                         }
 822                 }
 823         }
 824 } else {
 825         run($dbh);
 826 }