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