14 binmode STDOUT, ':utf8';
15 binmode STDERR, ':utf8';
18 require '../include/config.pm';
20 my $global_ctx = IO::Socket::SSL::SSL_Context->new(
21 SSL_session_cache_size => 100, # Probably overkill.
23 IO::Socket::SSL::set_default_context($global_ctx);
26 my $uca = Unicode::Collate->new(level => 1);
50 my ($start, $msg) = @_;
51 my $elapsed = Time::HiRes::tv_interval($start);
52 printf "%s: %.0f ms.\n", $msg, 1e3 * $elapsed;
55 # Unicode::Collate is seemingly slow, so add a cache for each name part
56 # (which, of course, only works for equality). Helps especially in
57 # --daemon mode, where even the first request gets a warm cache.
58 my %sort_key_cache = ();
59 my $sort_key_sp = $uca->getSortKey(' ');
64 for my $part (split /\s+/, $m) {
65 my $psk = \$sort_key_cache{$part};
66 if (!defined($$psk)) {
67 $$psk = $uca->getSortKey($part);
79 sub get_oauth_bearer_token {
83 # See if the database already has a token we could use, that doesn't expire in a while.
84 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);
85 if (defined($ref->{'token'})) {
86 return $ref->{'token'};
89 my $jwt = JSON::XS::encode_json({
90 "iss" => $config::jwt_key->{'client_email'},
91 "scope" => "https://www.googleapis.com/auth/spreadsheets",
92 "aud" => "https://www.googleapis.com/oauth2/v4/token",
96 my $jws_token = Crypt::JWT::encode_jwt(payload=>$jwt, alg=>'RS256', key=>\$config::jwt_key->{'private_key'});
97 my $start = [Time::HiRes::gettimeofday];
98 my $response = $ua->post('https://www.googleapis.com/oauth2/v4/token', [
99 'grant_type' => 'urn:ietf:params:oauth:grant-type:jwt-bearer',
100 'assertion' => $jws_token ]);
101 log_timing($start, '/oauth2/v4/token');
102 my $token = JSON::XS::decode_json($response->decoded_content)->{'access_token'};
103 $dbh->do('INSERT INTO oauth_tokens (token, acquired, expiry) VALUES (?, TIMESTAMPTZ \'1970-01-01\' + ? * INTERVAL \'1 second\', TIMESTAMPTZ \'1970-01-01\' + ? * INTERVAL \'1 second\')',
104 undef, $token, $now, $now + 1800);
109 my ($ua, $userid) = @_;
110 my $req = HTTP::Request->new('GET', 'https://slack.com/api/users.info?user=' . $userid, [
111 'Authorization' => 'Bearer ' . $config::slack_oauth_token
113 my $start = [Time::HiRes::gettimeofday];
114 my $response = $ua->request($req);
115 log_timing($start, '/users.info');
116 die $response->status_line if !$response->is_success;
118 my $user_json = JSON::XS::decode_json($response->decoded_content);
119 die "Something went wrong: " . $response->decoded_content if (!defined($user_json) || !$user_json->{'ok'});
121 return $user_json->{'user'}{'real_name'};
124 sub get_spreadsheet_name {
126 my $name = $cell->{'userEnteredValue'}{'stringValue'};
127 return undef if (!defined($name));
128 return undef if ($name =~ /^G[1-4]\.[1-5]/);
130 $name =~ s/\(.*\)//g;
131 $name =~ s/\[.*\]//g;
133 $name =~ s/G\d\.\d?\??//;
141 my ($slack_name, $spreadsheet_name, $ap) = @_;
143 # No need to check for an exact match; we already did that through $seen_names.
144 # if (sort_key($slack_name) eq sort_key($spreadsheet_name)) {
148 # @ap is precalculated by the caller.
149 # my @ap = map { sort_key($_) } split /\s+/, $slack_name;
150 my @bp = map { sort_key($_) } split /\s+/, $spreadsheet_name;
151 if (scalar @$ap >= 2 && scalar @bp >= 2 && $ap->[0] eq $bp[0]) {
152 # First name matches, try to match some surname
154 for my $ai (1..(scalar @$ap - 1)) {
155 for my $bi (1..$#bp) {
156 $found = 1 if ($ap->[$ai] eq $bp[$bi]);
160 skv_log("Fuzzy-matchet $slack_name -> $spreadsheet_name.");
168 sub format_cell_names_for_seen {
170 my @cells = map { chr(ord('A') + $_->[2]) . ($_->[1] + 1) } @$seen;
171 return join(', ', @cells);
176 print STDERR "$msg\n";
180 sub serialize_skv_log_to_sheet {
185 userEnteredValue => { stringValue => join("\n", @log) }
188 fields => 'userEnteredValue.stringValue',
190 sheetId => $config::log_tab_id,
193 startColumnIndex => 0,
200 sub sheet_batch_update {
201 my ($ua, $token, @requests) = @_;
203 requests => \@requests
205 my $start = [Time::HiRes::gettimeofday];
206 my $response = $ua->post(
207 'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . ':batchUpdate?key=' . $config::gsheets_api_key,
208 Content => JSON::XS::encode_json($update),
209 Content_type => 'application/json;charset=UTF-8',
210 Authorization => 'Bearer ' . $token
212 log_timing($start, '/spreadsheets/values:batchUpdate');
213 die $response->decoded_content if !$response->is_success;
216 sub get_group_assignments {
219 my %assignments = ();
220 my $rows = $json->{'data'}[0]{'rowData'};
221 my @curr_groups = ();
222 for my $row (@$rows) {
224 for my $val (@{$row->{'values'}}) {
226 my $contents = $val->{'userEnteredValue'}{'stringValue'};
227 next if !defined($contents);
228 if ($contents =~ /Gruppe /) {
232 next if $contents =~ /^VL:/;
233 next if $contents =~ /^LT\b/;
234 next if $contents =~ /^400m/;
235 next if $contents =~ /^546m/;
236 if ($contents =~ /^(G\d\.\d)/ || $contents =~ /^(Nye lĆøpere.*)/) {
237 $curr_groups[$col] = $1;
239 my $name = get_spreadsheet_name($val);
240 next if (!defined($name));
241 my $group = $curr_groups[$col] // $curr_groups[$col - 1];
242 # print $group, " ", $name, "\n";
243 if (exists($assignments{$name})) {
244 $assignments{$name} = "(flere grupper)";
246 $assignments{$name} = $group;
254 sub update_assignment_db {
255 my ($dbh, $channel, $ts, $assignments) = @_;
257 my %db_assignments = ();
258 my $q = $dbh->prepare('SELECT name,group_name FROM current_group_membership_history WHERE channel=? AND ts=?');
259 $q->execute($channel, $ts);
260 while (my $ref = $q->fetchrow_hashref) {
261 if (defined($ref->{'group_name'})) {
262 $db_assignments{$ref->{'name'}} = $ref->{'group_name'};
266 $q = $dbh->prepare('INSERT INTO group_membership_history (channel, ts, name, change_seen, group_name) VALUES (?, ?, ?, CURRENT_TIMESTAMP, ?)');
267 for my $name (keys %$assignments) {
268 if (!exists($db_assignments{$name}) || $db_assignments{$name} ne $assignments->{$name}) {
269 $q->execute($channel, $ts, $name, $assignments->{$name});
272 for my $name (keys %db_assignments) {
273 if (!exists($assignments->{$name})) {
274 $q->execute($channel, $ts, $name, undef);
279 sub get_spreadsheet_with_title {
280 my ($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title) = @_;
282 # See if we have any spreadsheets that match this title.
283 my $start = [Time::HiRes::gettimeofday];
284 my $response = $ua->get('https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '?key=' . $config::gsheets_api_key . '&fields=sheets/properties',
285 Authorization => 'Bearer ' . $token,
286 Accept_Encoding => HTTP::Message::decodable
288 log_timing($start, '/spreadsheets/properties');
289 my $sheets_json = JSON::XS::decode_json($response->decoded_content);
290 my ($tab_name, $tab_id);
291 for my $sheet (@{$sheets_json->{'sheets'}}) {
292 my $title = $sheet->{'properties'}{'title'};
293 my $sheet_id = $sheet->{'properties'}{'sheetId'};
294 if ($title =~ /\Q$wanted_sheet_title\E/) {
295 # skv_log("Synkroniserer ($config::invitation_channel, $invitation_ts) mot arket ā$titleā (fane-ID $sheet_id).");
296 $dbh->do('UPDATE message_sheet_link SET tab_name=?, tab_id=? WHERE channel=? AND ts=?',
297 undef, $title, $sheet_id, $config::invitation_channel, $invitation_ts);
298 return ($title, $sheet_id);
301 return (undef, undef);
304 # Make a mapping of lowercase name -> list of [canonical name, row number, column number]
305 sub find_where_each_name_is {
309 my $rows = $json->{'data'}[0]{'rowData'};
311 for my $row (@$rows) {
313 for my $val (@{$row->{'values'}}) {
314 my $name = get_spreadsheet_name($val);
315 if (defined($name)) {
316 push @{$seen_names{sort_key($name)}}, [$name, $rowno, $colno];
326 sub best_name_for_log {
327 my ($userid, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
328 if (exists($slack_userid_to_real_name->{$userid})) {
329 return $slack_userid_to_real_name->{$userid};
330 } elsif (exists($slack_userid_to_slack_name->{$userid})) {
331 return $slack_userid_to_slack_name->{$userid} . ' (fant ikke regneark-navn)';
333 # Should only happen if we didn't see the initial reaction_add, only reaction_remove.
334 # (TODO: Is the comment above true anymore, now that we use this from multiple contexts?)
335 return $userid . ' (fant ikke Slack-navn)';
339 # Add the reaction log. (This only takes into account the last change
340 # for each user; earlier ones are irrelevant and don't count. But it
341 # doesn't deduplicate across reactions. Meh.)
342 sub create_reaction_log {
343 my ($dbh, $invitation_ts, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
345 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');
346 $q->execute($config::invitation_channel, $invitation_ts);
347 my @recent_changes = ();
348 while (my $ref = $q->fetchrow_hashref) {
349 my $msg = $ref->{'event_ts'};
350 if ($ref->{'event_type'} eq 'reaction_added') {
355 if ($ref->{'reaction'} eq 'open_mouth') {
357 } elsif ($ref->{'reaction'} eq 'blue_heart') {
363 $msg .= best_name_for_log($ref->{'userid'}, $slack_userid_to_real_name, $slack_userid_to_slack_name);
364 push @recent_changes, { values => [{ userEnteredValue => { stringValue => $msg } }] };
366 while (scalar @recent_changes < 50) {
367 push @recent_changes, { values => [{ userEnteredValue => { stringValue => '' } }] };
369 return @recent_changes;
372 sub create_move_log {
373 my ($dbh, $invitation_ts, $prev_invitation_ts) = @_;
374 my $q = $dbh->prepare(<<"EOF");
376 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
377 FROM ( SELECT * FROM current_group_membership_history WHERE channel=? AND ts=? ) g_old
378 FULL OUTER JOIN ( SELECT * FROM current_group_membership_history WHERE channel=? AND ts=? ) g_new USING (name)
380 g_new.group_name IS DISTINCT FROM g_old.group_name
381 AND g_new.group_name IS NOT NULL
382 ORDER BY g_new.change_seen DESC, name
385 $q->execute($config::invitation_channel, $prev_invitation_ts, $config::invitation_channel, $invitation_ts);
386 my @recent_moves = ();
387 while (my $ref = $q->fetchrow_hashref) {
388 my $name = $ref->{'name'};
389 my $old_group = $ref->{'old_group'};
390 my $new_group = $ref->{'new_group'};
392 my $msg = $ref->{'change_seen'} . " ";
393 if (!defined($old_group)) {
394 $msg .= "$name, (ny lĆøper) ā $new_group";
396 $msg .= "$name, $old_group ā $new_group";
398 push @recent_moves, { values => [{ userEnteredValue => { stringValue => $msg } }] };
400 while (scalar @recent_moves < 50) {
401 push @recent_moves, { values => [{ userEnteredValue => { stringValue => '' } }] };
403 return @recent_moves;
406 # Also applies the diff to the database (a bit ugly).
408 my ($dbh, $invitation_ts, $want_colors, $have_colors, $seen_names) = @_;
411 for my $real_name (keys %$want_colors) {
412 my $wc = $want_colors->{$real_name};
413 if (exists($have_colors->{$real_name})) {
414 if ($have_colors->{$real_name} eq $wc) {
418 skv_log("Markerer at $real_name har byttet treningssted.");
420 $real_name, { backgroundColor => $rgb{$wc} }
422 $dbh->do('UPDATE applied SET color=? WHERE channel=? AND ts=? AND name=?', undef,
423 $wc, $config::invitation_channel, $invitation_ts, $real_name);
425 skv_log("Markerer at $real_name skal pƄ trening.");
427 $real_name, { backgroundColor => $rgb{$wc} }
429 $dbh->do('INSERT INTO applied (channel, ts, name, color) VALUES (?, ?, ?, ?)', undef,
430 $config::invitation_channel, $invitation_ts, $real_name, $wc);
433 for my $real_name (keys %$have_colors) {
434 next if (exists($want_colors->{$real_name}));
435 my $sk = sort_key($real_name);
436 if (!exists($seen_names->{$sk})) {
437 # TODO: This can somehow come if we try to add someone who's not in the sheet, too?
438 skv_log("Ćnsket Ć„ fjerne at $real_name skulle pĆ„ trening, men de var ikke i regnearket lenger.");
439 } elsif (scalar @{$seen_names->{$sk}} > 1) {
442 skv_log("Fjerner at $real_name skal pƄ trening.");
444 $real_name, { backgroundColor => $rgb{white} }
446 $dbh->do('DELETE FROM applied WHERE channel=? AND ts=? AND name=?', undef,
447 $config::invitation_channel, $invitation_ts, $real_name);
453 sub possibly_nag_user {
454 my ($dbh, $ua, $userid, $invitation_ts, $group, $slack_userid_to_slack_name) = @_;
456 my $slack_name = $slack_userid_to_slack_name->{$userid};
458 # See if we've nagged this user before.
459 my $q = $dbh->prepare('SELECT * FROM users_nagged WHERE userid=? AND ts=?');
460 $q->execute($userid, $invitation_ts);
461 if (defined($q->fetchrow_hashref)) {
466 if (!defined($group)) {
467 $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!";
468 skv_log("Sender Slack-melding til $slack_name ($userid) for Ć„ spĆørre om gruppe.");
469 } elsif ($group eq '(flere grupper)') {
470 $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!";
471 skv_log("Sender Slack-melding til $slack_name ($userid) for Ć„ spĆørre om gruppe.");
473 $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!";
474 skv_log("Sender Slack-melding om at $slack_name ($userid) er i gruppe $group.");
478 channel => $config::invitation_channel,
482 my $start = [Time::HiRes::gettimeofday];
483 my $response = $ua->post(
484 'https://slack.com/api/chat.postEphemeral',
485 Content => JSON::XS::encode_json($content),
486 Content_type => 'application/json;charset=UTF-8',
487 Authorization => 'Bearer ' . $config::slack_oauth_token
489 log_timing($start, 'chat.postEphemeral');
490 die $response->status_line if !$response->is_success;
491 my $msg_json = JSON::XS::decode_json($response->decoded_content);
492 die "Something went wrong: " . $response->decoded_content if (!defined($msg_json) || !$msg_json->{'ok'});
494 # Mark that we've sent the message, so it won't happen again.
495 $dbh->do('INSERT INTO users_nagged (userid, ts, last_nag) VALUES (?, ?, CURRENT_TIMESTAMP)', undef, $userid, $invitation_ts);
499 my $dbh = DBI->connect("dbi:Pg:dbname=$config::dbname;host=127.0.0.1", $config::dbuser, $config::dbpass, {RaiseError => 1})
500 or warn "Could not connect to Postgres: " . DBI->errstr;
501 if (!defined($dbh)) {
504 $dbh->{AutoCommit} = 0;
505 $dbh->do('LISTEN skvupdate') or return undef;
511 my $total_start = [Time::HiRes::gettimeofday];
514 skv_log("Siste sync startet: " . POSIX::ctime(time));
516 # For the logic on the āappliedā table below.
517 $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE');
519 my $token = get_oauth_bearer_token($dbh, $ua);
521 # Find the newest message, what it is linked to, and what was the one before it (for group diffing).
522 # TODO: Support more than one, and test better for errors here.
523 my $q = $dbh->prepare('select * from message_sheet_link where channel=? order by ts desc limit 2');
524 $q->execute($config::invitation_channel);
525 my $linkref = $q->fetchrow_hashref;
526 my $invitation_ts = $linkref->{'ts'};
527 my $wanted_sheet_title = $linkref->{'sheet_title'};
528 die "Could not get newest sheet title" if (!defined($wanted_sheet_title));
529 my $tab_name = $linkref->{'tab_name'};
530 my $tab_id = $linkref->{'tab_id'};
532 # Store away the second-newest ID.
533 my $prev_invitation_ts = $q->fetchrow_hashref->{'ts'};
535 if (!defined($tab_name) || !defined($tab_id)) {
536 ($tab_name, $tab_id) = get_spreadsheet_with_title($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title);
537 if (!defined($tab_name)) {
538 skv_log("Fant ikke noen fane med Ā«$wanted_sheet_titleĀ» i navnet; kan ikke synkronisere.\n");
539 sheet_batch_update($ua, $token, [ serialize_skv_log_to_sheet() ]);
544 # Find everyone who are marked as attending on Slack (via reactions).
545 $q = $dbh->prepare('SELECT DISTINCT userid,reaction FROM current_reactions WHERE channel=? AND ts=? AND reaction IN (\'heart\', \'open_mouth\', \'blue_heart\')');
546 $q->execute($config::invitation_channel, $invitation_ts);
547 my @attending_userids = ();
550 while (my $ref = $q->fetchrow_hashref) {
551 my $userid = $ref->{'userid'};
552 push @attending_userids, $userid;
553 if ($ref->{'reaction'} eq 'blue_heart') {
554 if (exists($colors{$userid}) && $colors{$userid} eq 'yellow') {
555 $double{$userid} = 1;
557 $colors{$userid} = 'blue';
559 if (exists($colors{$userid}) && $colors{$userid} eq 'blue') {
560 $double{$userid} = 1;
562 $colors{$userid} = 'yellow';
566 # Remove double-attenders (we will log them as warnings further down).
567 @attending_userids = grep { !exists($double{$_}) } @attending_userids;
568 for my $userid (keys %double) {
569 delete $colors{$userid};
572 # Get the list of all people in the sheet (we're going to need them soon).
573 # Also get the Slack mapping when we're doing an API request anyway.
574 my $start = [Time::HiRes::gettimeofday];
575 my $response = $ua->get('https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '?key=' . $config::gsheets_api_key . '&ranges=' . $tab_name . '!A4:Z5000&ranges=Slack-mapping!A5:C5000&fields=sheets/data/rowData/values/userEnteredValue',
576 Authorization => 'Bearer ' . $token,
577 Accept_Encoding => HTTP::Message::decodable
579 log_timing($start, "/spreadsheets/");
581 my $sheets_json = JSON::XS::decode_json($response->decoded_content);
582 if (!exists($sheets_json->{'sheets'})) {
583 die "Missing sheets (error response?): " . $response->decoded_content;
585 my $main_sheet_json = $sheets_json->{'sheets'}[0];
586 my $mapping_sheet_json = $sheets_json->{'sheets'}[1];
588 # Update the list of groups we've seen people in.
589 $start = [Time::HiRes::gettimeofday];
590 my %assignments = get_group_assignments($main_sheet_json);
591 log_timing($start, "Parsing group assignments");
592 $start = [Time::HiRes::gettimeofday];
593 update_assignment_db($dbh, $config::invitation_channel, $invitation_ts, \%assignments);
594 log_timing($start, "Updating assignments in database");
596 $start = [Time::HiRes::gettimeofday];
597 my %seen_names = find_where_each_name_is($main_sheet_json);
598 log_timing($start, "Making sort key reverse mapping");
601 for my $name (sort keys %seen_names) {
602 my $seen = $seen_names{$name};
603 if (scalar @$seen >= 2) {
604 my $exemplar = $seen->[0][0];
605 skv_log("Duplikat: $exemplar (" . format_cell_names_for_seen($seen) . ")");
609 # Get our existing Slack->name mapping, from the sheets.
610 my %slack_userid_to_real_name = ();
611 my %slack_userid_to_slack_name = ();
612 my %slack_userid_to_row = ();
614 my $mapping_sheet_rows = $mapping_sheet_json->{'data'}[0]{'rowData'};
616 for my $row (@$mapping_sheet_rows) {
617 my $slack_id = $row->{'values'}[0]{'userEnteredValue'}{'stringValue'};
618 my $slack_name = $row->{'values'}[1]{'userEnteredValue'}{'stringValue'};
619 my $real_name = get_spreadsheet_name($row->{'values'}[2]); # TODO support more
620 $slack_userid_to_row{$slack_id} = $cur_row++;
621 next if (!defined($slack_name));
622 $slack_userid_to_slack_name{$slack_id} = $slack_name;
623 next if (!defined($real_name));
624 $slack_userid_to_real_name{$slack_id} = $real_name;
627 # See which ones we don't have a mapping for, and look them up in Slack.
628 # TODO: Use an append call instead of $cur_row?
629 my @slack_mapping_updates = ();
630 for my $userid (@attending_userids) {
631 next if (exists($slack_userid_to_real_name{$userid}));
633 # Make sure they have a row in the spreadsheet.
635 if (exists($slack_userid_to_row{$userid})) {
636 $write_row = $slack_userid_to_row{$userid};
638 $write_row = $cur_row++;
639 $slack_userid_to_row{$userid} = $write_row;
640 push @slack_mapping_updates, {
641 range => "Slack-mapping!A$write_row:A$write_row",
642 values => [ [ $userid ]]
646 # Fetch their Slack name if we don't already have it.
648 if (exists($slack_userid_to_slack_name{$userid})) {
649 $slack_name = $slack_userid_to_slack_name{$userid};
651 $slack_userid_to_slack_name{$userid} = $slack_name;
652 $slack_name = get_slack_name($ua, $userid);
653 push @slack_mapping_updates, {
654 range => "Slack-mapping!B$write_row:B$write_row",
655 values => [ [ $slack_name ]]
657 $slack_userid_to_slack_name{$userid} = $slack_name;
660 if (exists($seen_names{sort_key($slack_name)})) {
661 # The name exists exactly, once or more, so it's a direct match and we ignore any fuzz.
662 $slack_userid_to_real_name{$userid} = $slack_name;
663 push @slack_mapping_updates, {
664 range => "Slack-mapping!C$write_row:C$write_row",
665 values => [ [ $slack_name ]]
668 # Do a search through all the available names in the sheet to find an obvious(ish) match.
670 my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
671 $start = [Time::HiRes::gettimeofday];
672 my @ap = map { sort_key($_) } split /\s+/, $slack_name; # Precalc for matches_name().
673 for my $row (@$main_sheet_rows) {
674 for my $val (@{$row->{'values'}}) {
675 my $name = get_spreadsheet_name($val);
676 if (defined($name) && matches_name($slack_name, $name, \@ap)) {
677 push @candidates, $name;
681 log_timing($start, "Fuzzy-searching for Slack name $slack_name");
682 if ($#candidates == -1) {
683 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men fant ikke et regneark-navn for dem.");
684 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, undef, \%slack_userid_to_slack_name);
685 } elsif ($#candidates == 0) {
686 my $name = $candidates[0];
687 $slack_userid_to_real_name{$userid} = $name;
688 push @slack_mapping_updates, {
689 range => "Slack-mapping!C$write_row:C$write_row",
690 values => [ [ $name ]]
693 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men hadde flere fuzzy-matcher; vet ikke hvilket regneark-navn som skal brukes.");
697 if (scalar @slack_mapping_updates > 0) {
699 valueInputOption => 'USER_ENTERED',
700 data => \@slack_mapping_updates
702 $start = [Time::HiRes::gettimeofday];
703 $response = $ua->post(
704 'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '/values:batchUpdate?key=' . $config::gsheets_api_key,
705 Content => JSON::XS::encode_json($update),
706 Content_type => 'application/json;charset=UTF-8',
707 Authorization => 'Bearer ' . $token
709 log_timing($start, "/spreadsheets/values:batchUpdate");
710 die $response->decoded_content if (!$response->is_success);
713 # Now that we have Slack names, we can log double-reacters.
714 for my $userid (keys %double) {
715 my $name = best_name_for_log($userid, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
716 skv_log("$name er pƄmeldt flere steder pƄ Slack; vet ikke hvilken som skal brukes.");
719 # ...and possibly send welcome messages to remind them of groups.
720 for my $userid (@attending_userids) {
721 my $real_name = $slack_userid_to_real_name{$userid};
722 next if (!defined($real_name));
723 my $group = $assignments{$real_name};
724 next if (!defined($group));
725 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, $group, \%slack_userid_to_slack_name);
728 # Find the list of names to mark yellow.
729 my %want_colors = ();
730 my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
731 for my $userid (@attending_userids) {
732 next if (!exists($slack_userid_to_real_name{$userid}));
733 my $slack_name = $slack_userid_to_slack_name{$userid};
734 my $real_name = $slack_userid_to_real_name{$userid};
736 # See if we can find them in the spreadsheet.
737 my $sk = sort_key($real_name);
738 if (!exists($seen_names{$sk})) {
739 # TODO: Perhaps move this logic further down, for consistency?
740 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
742 my $seen = $seen_names{$sk};
743 if (scalar @$seen >= 2) {
744 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men stƄr flere steder (se over); vet ikke hvilken celle som skal brukes.");
746 $want_colors{$seen->[0][0]} = $colors{$userid};
751 # Find the list of names we already marked yellow.
752 my %have_colors = ();
753 $q = $dbh->prepare('SELECT name,color FROM applied WHERE channel=? AND ts=?');
754 $q->execute($config::invitation_channel, $invitation_ts);
755 while (my $ref = $q->fetchrow_hashref) {
756 $have_colors{$ref->{'name'}} = $ref->{'color'};
759 my @diffs = find_diff($dbh, $invitation_ts, \%want_colors, \%have_colors, \%seen_names);
761 my @yellow_updates = ();
762 if (scalar @diffs > 0) {
763 # Now fill in the actual stuff.
764 for my $diff (@diffs) {
765 my $real_name = $diff->[0];
767 my $seen = $seen_names{sort_key($real_name)};
769 # We've already complained about these earlier, so just skip them silently.
770 next if (scalar @$seen > 1);
772 # See if we can find them in the spreadsheet.
773 die "Could not find $real_name" if (!defined($seen));
774 my $rowno = $seen->[0][1];
775 my $colno = $seen->[0][2];
776 push @yellow_updates, {
780 userEnteredFormat => $diff->[1]
783 fields => 'userEnteredFormat.backgroundColor',
786 startRowIndex => $rowno,
787 endRowIndex => $rowno + 1,
788 startColumnIndex => $colno,
789 endColumnIndex => $colno + 1
796 my @recent_changes = create_reaction_log($dbh, $invitation_ts, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
797 push @yellow_updates, {
799 rows => \@recent_changes,
800 fields => 'userEnteredValue.stringValue',
802 sheetId => $config::log_tab_id,
804 endRowIndex => 4 + scalar @recent_changes,
805 startColumnIndex => 0,
811 my @recent_moves = create_move_log($dbh, $invitation_ts, $prev_invitation_ts);
812 push @yellow_updates, {
814 rows => \@recent_moves,
815 fields => 'userEnteredValue.stringValue',
817 sheetId => $config::log_tab_id,
819 endRowIndex => 4 + scalar @recent_moves,
820 startColumnIndex => 1,
826 # Push the final set of updates (including the log).
828 push @yellow_updates, serialize_skv_log_to_sheet();
829 sheet_batch_update($ua, $token, \@yellow_updates);
832 my $elapsed = Time::HiRes::tv_interval($total_start);
833 printf "Tok %.0f ms.\n", 1e3 * $elapsed;
837 # Initialize the handles we need for communication.
838 my $dbh = db_connect() or die;
839 my $ua = LWP::UserAgent->new(agent => 'SKVidarLang/1.0', keep_alive => 50);
840 if ($#ARGV >= 0 && $ARGV[0] eq '--daemon') {
841 # Start with a single, forced run.
845 while (!defined($dbh) || !$dbh->ping) {
846 print STDERR "Database connection lost, reconnecting...\n";
852 my $s = IO::Select->new($dbh->{pg_socket});
853 my @ready = $s->can_read(150.0); # slack.com HTTP timeout is ~3 minutes, sheets.googleapis.com is ~4 minutes.
854 my @exceptions = $s->has_exception(0.0);
856 if (scalar @exceptions > 0) {
861 if (scalar @ready > 0) {
866 warn "Died with: $@";
870 # Keep the connections alive and the token in the database fresh.
871 # (The two URLs we use don't really exist. Note that the first time,
872 # we might be making the initial connection to slack.com, since it's
873 # not a given that run() needed to talk to them.)
874 get_oauth_bearer_token($dbh, $ua);
876 #my $start = [Time::HiRes::gettimeofday];
877 $ua->get('https://sheets.googleapis.com/ping');
878 #log_timing($start, 'sheets.googleapis.com (keepalive)');
879 #$start = [Time::HiRes::gettimeofday];
880 $ua->get('https://slack.com/api/ping');
881 #log_timing($start, 'slack.com (keepalive)');
885 } elsif ($#ARGV >= 0 && $ARGV[0] eq '--benchmark') {