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).
57 # Doesn't seem to help the initial one, though; I guess not enough people
58 # have the same names.
59 my %sort_key_cache = ();
60 my $sort_key_sp = $uca->getSortKey(' ');
65 for my $part (split /\s+/, $m) {
66 my $psk = \$sort_key_cache{$part};
67 if (!defined($$psk)) {
68 $$psk = $uca->getSortKey($part);
80 sub get_oauth_bearer_token {
84 # See if the database already has a token we could use, that doesn't expire in a while.
85 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);
86 if (defined($ref->{'token'})) {
87 return $ref->{'token'};
90 my $jwt = JSON::XS::encode_json({
91 "iss" => $config::jwt_key->{'client_email'},
92 "scope" => "https://www.googleapis.com/auth/spreadsheets",
93 "aud" => "https://www.googleapis.com/oauth2/v4/token",
97 my $jws_token = Crypt::JWT::encode_jwt(payload=>$jwt, alg=>'RS256', key=>\$config::jwt_key->{'private_key'});
98 my $start = [Time::HiRes::gettimeofday];
99 my $response = $ua->post('https://www.googleapis.com/oauth2/v4/token', [
100 'grant_type' => 'urn:ietf:params:oauth:grant-type:jwt-bearer',
101 'assertion' => $jws_token ]);
102 log_timing($start, '/oauth2/v4/token');
103 my $token = JSON::XS::decode_json($response->decoded_content)->{'access_token'};
104 $dbh->do('INSERT INTO oauth_tokens (token, acquired, expiry) VALUES (?, TIMESTAMPTZ \'1970-01-01\' + ? * INTERVAL \'1 second\', TIMESTAMPTZ \'1970-01-01\' + ? * INTERVAL \'1 second\')',
105 undef, $token, $now, $now + 1800);
110 my ($ua, $userid) = @_;
111 my $req = HTTP::Request->new('GET', 'https://slack.com/api/users.info?user=' . $userid, [
112 'Authorization' => 'Bearer ' . $config::slack_oauth_token
114 my $start = [Time::HiRes::gettimeofday];
115 my $response = $ua->request($req);
116 log_timing($start, '/users.info');
117 die $response->status_line if !$response->is_success;
119 my $user_json = JSON::XS::decode_json($response->decoded_content);
120 die "Something went wrong: " . $response->decoded_content if (!defined($user_json) || !$user_json->{'ok'});
122 return $user_json->{'user'}{'real_name'};
125 sub get_spreadsheet_name {
127 my $name = $cell->{'userEnteredValue'}{'stringValue'};
128 return undef if (!defined($name));
129 return undef if ($name =~ /^G[1-4]\.[1-5]/);
131 $name =~ s/\(.*\)//g;
132 $name =~ s/\[.*\]//g;
134 $name =~ s/G\d\.\d?\??//;
142 my ($slack_name, $spreadsheet_name, $ap) = @_;
144 # No need to check for an exact match; we already did that through $seen_names.
145 # if (sort_key($slack_name) eq sort_key($spreadsheet_name)) {
149 # @ap is precalculated by the caller.
150 # my @ap = map { sort_key($_) } split /\s+/, $slack_name;
151 my @bp = map { sort_key($_) } split /\s+/, $spreadsheet_name;
152 if (scalar @$ap >= 2 && scalar @bp >= 2 && $ap->[0] eq $bp[0]) {
153 # First name matches, try to match some surname
155 for my $ai (1..(scalar @$ap)) {
156 for my $bi (1..$#bp) {
157 $found = 1 if ($ap->[$ai] eq $bp[$bi]);
161 skv_log("Fuzzy-matchet $slack_name -> $spreadsheet_name.");
169 sub format_cell_names_for_seen {
171 my @cells = map { chr(ord('A') + $_->[2]) . ($_->[1] + 1) } @$seen;
172 return join(', ', @cells);
177 print STDERR "$msg\n";
181 sub serialize_skv_log_to_sheet {
186 userEnteredValue => { stringValue => join("\n", @log) }
189 fields => 'userEnteredValue.stringValue',
191 sheetId => $config::log_tab_id,
194 startColumnIndex => 0,
201 sub sheet_batch_update {
202 my ($ua, $token, @requests) = @_;
204 requests => \@requests
206 my $start = [Time::HiRes::gettimeofday];
207 my $response = $ua->post(
208 'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . ':batchUpdate?key=' . $config::gsheets_api_key,
209 Content => JSON::XS::encode_json($update),
210 Content_type => 'application/json;charset=UTF-8',
211 Authorization => 'Bearer ' . $token
213 log_timing($start, '/spreadsheets/values:batchUpdate');
214 die $response->decoded_content if !$response->is_success;
217 sub get_group_assignments {
220 my %assignments = ();
221 my $rows = $json->{'data'}[0]{'rowData'};
222 my @curr_groups = ();
223 for my $row (@$rows) {
225 for my $val (@{$row->{'values'}}) {
227 my $contents = $val->{'userEnteredValue'}{'stringValue'};
228 next if !defined($contents);
229 if ($contents =~ /Gruppe /) {
233 next if $contents =~ /^VL:/;
234 next if $contents =~ /^LT\b/;
235 next if $contents =~ /^400m/;
236 next if $contents =~ /^546m/;
237 if ($contents =~ /^(G\d\.\d)/ || $contents =~ /^(Nye lĆøpere.*)/) {
238 $curr_groups[$col] = $1;
240 my $name = get_spreadsheet_name($val);
241 next if (!defined($name));
242 my $group = $curr_groups[$col] // $curr_groups[$col - 1];
243 # print $group, " ", $name, "\n";
244 if (exists($assignments{$name})) {
245 $assignments{$name} = "(flere grupper)";
247 $assignments{$name} = $group;
255 sub update_assignment_db {
256 my ($dbh, $channel, $ts, $assignments) = @_;
258 my %db_assignments = ();
259 my $q = $dbh->prepare('SELECT name,group_name FROM current_group_membership_history WHERE channel=? AND ts=?');
260 $q->execute($channel, $ts);
261 while (my $ref = $q->fetchrow_hashref) {
262 if (defined($ref->{'group_name'})) {
263 $db_assignments{$ref->{'name'}} = $ref->{'group_name'};
267 $q = $dbh->prepare('INSERT INTO group_membership_history (channel, ts, name, change_seen, group_name) VALUES (?, ?, ?, CURRENT_TIMESTAMP, ?)');
268 for my $name (keys %$assignments) {
269 if (!exists($db_assignments{$name}) || $db_assignments{$name} ne $assignments->{$name}) {
270 $q->execute($channel, $ts, $name, $assignments->{$name});
273 for my $name (keys %db_assignments) {
274 if (!exists($assignments->{$name})) {
275 $q->execute($channel, $ts, $name, undef);
280 sub get_spreadsheet_with_title {
281 my ($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title) = @_;
283 # See if we have any spreadsheets that match this title.
284 my $start = [Time::HiRes::gettimeofday];
285 my $response = $ua->get('https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '?key=' . $config::gsheets_api_key . '&fields=sheets/properties',
286 Authorization => 'Bearer ' . $token,
287 Accept_Encoding => HTTP::Message::decodable
289 log_timing($start, '/spreadsheets/properties');
290 my $sheets_json = JSON::XS::decode_json($response->decoded_content);
291 my ($tab_name, $tab_id);
292 for my $sheet (@{$sheets_json->{'sheets'}}) {
293 my $title = $sheet->{'properties'}{'title'};
294 my $sheet_id = $sheet->{'properties'}{'sheetId'};
295 if ($title =~ /\Q$wanted_sheet_title\E/) {
296 # skv_log("Synkroniserer ($config::invitation_channel, $invitation_ts) mot arket ā$titleā (fane-ID $sheet_id).");
297 $dbh->do('UPDATE message_sheet_link SET tab_name=?, tab_id=? WHERE channel=? AND ts=?',
298 undef, $title, $sheet_id, $config::invitation_channel, $invitation_ts);
299 return ($title, $sheet_id);
302 return (undef, undef);
305 # Make a mapping of lowercase name -> list of [canonical name, row number, column number]
306 sub find_where_each_name_is {
310 my $rows = $json->{'data'}[0]{'rowData'};
312 for my $row (@$rows) {
314 for my $val (@{$row->{'values'}}) {
315 my $name = get_spreadsheet_name($val);
316 if (defined($name)) {
317 push @{$seen_names{sort_key($name)}}, [$name, $rowno, $colno];
327 sub best_name_for_log {
328 my ($userid, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
329 if (exists($slack_userid_to_real_name->{$userid})) {
330 return $slack_userid_to_real_name->{$userid};
331 } elsif (exists($slack_userid_to_slack_name->{$userid})) {
332 return $slack_userid_to_slack_name->{$userid} . ' (fant ikke regneark-navn)';
334 # Should only happen if we didn't see the initial reaction_add, only reaction_remove.
335 # (TODO: Is the comment above true anymore, now that we use this from multiple contexts?)
336 return $userid . ' (fant ikke Slack-navn)';
340 # Add the reaction log. (This only takes into account the last change
341 # for each user; earlier ones are irrelevant and don't count. But it
342 # doesn't deduplicate across reactions. Meh.)
343 sub create_reaction_log {
344 my ($dbh, $invitation_ts, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
346 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');
347 $q->execute($config::invitation_channel, $invitation_ts);
348 my @recent_changes = ();
349 while (my $ref = $q->fetchrow_hashref) {
350 my $msg = $ref->{'event_ts'};
351 if ($ref->{'event_type'} eq 'reaction_added') {
356 if ($ref->{'reaction'} eq 'open_mouth') {
358 } elsif ($ref->{'reaction'} eq 'blue_heart') {
364 $msg .= best_name_for_log($ref->{'userid'}, $slack_userid_to_real_name, $slack_userid_to_slack_name);
365 push @recent_changes, { values => [{ userEnteredValue => { stringValue => $msg } }] };
367 while (scalar @recent_changes < 50) {
368 push @recent_changes, { values => [{ userEnteredValue => { stringValue => '' } }] };
370 return @recent_changes;
373 sub create_move_log {
374 my ($dbh, $invitation_ts, $prev_invitation_ts) = @_;
375 my $q = $dbh->prepare(<<"EOF");
377 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
378 FROM ( SELECT * FROM current_group_membership_history WHERE ts=? ) g_old
379 FULL OUTER JOIN ( SELECT * FROM current_group_membership_history WHERE ts=? ) g_new USING (name)
381 g_new.group_name IS DISTINCT FROM g_old.group_name
382 AND g_new.group_name IS NOT NULL
383 ORDER BY g_new.change_seen DESC, name
386 $q->execute($prev_invitation_ts, $invitation_ts);
387 my @recent_moves = ();
388 while (my $ref = $q->fetchrow_hashref) {
389 my $name = $ref->{'name'};
390 my $old_group = $ref->{'old_group'};
391 my $new_group = $ref->{'new_group'};
393 my $msg = $ref->{'change_seen'} . " ";
394 if (!defined($old_group)) {
395 $msg .= "$name, (ny lĆøper) ā $new_group";
397 $msg .= "$name, $old_group ā $new_group";
399 push @recent_moves, { values => [{ userEnteredValue => { stringValue => $msg } }] };
401 while (scalar @recent_moves < 50) {
402 push @recent_moves, { values => [{ userEnteredValue => { stringValue => '' } }] };
404 return @recent_moves;
407 # Also applies the diff to the database (a bit ugly).
409 my ($dbh, $invitation_ts, $want_colors, $have_colors, $seen_names) = @_;
412 for my $real_name (keys %$want_colors) {
413 my $wc = $want_colors->{$real_name};
414 if (exists($have_colors->{$real_name})) {
415 if ($have_colors->{$real_name} eq $wc) {
419 skv_log("Markerer at $real_name har byttet treningssted.");
421 $real_name, { backgroundColor => $rgb{$wc} }
423 $dbh->do('UPDATE applied SET color=? WHERE channel=? AND ts=? AND name=?', undef,
424 $wc, $config::invitation_channel, $invitation_ts, $real_name);
426 skv_log("Markerer at $real_name skal pƄ trening.");
428 $real_name, { backgroundColor => $rgb{$wc} }
430 $dbh->do('INSERT INTO applied (channel, ts, name, color) VALUES (?, ?, ?, ?)', undef,
431 $config::invitation_channel, $invitation_ts, $real_name, $wc);
434 for my $real_name (keys %$have_colors) {
435 next if (exists($want_colors->{$real_name}));
436 my $sk = sort_key($real_name);
437 if (!exists($seen_names->{$sk})) {
438 # TODO: This can somehow come if we try to add someone who's not in the sheet, too?
439 skv_log("Ćnsket Ć„ fjerne at $real_name skulle pĆ„ trening, men de var ikke i regnearket lenger.");
440 } elsif (scalar @{$seen_names->{$sk}} > 1) {
443 skv_log("Fjerner at $real_name skal pƄ trening.");
445 $real_name, { backgroundColor => $rgb{white} }
447 $dbh->do('DELETE FROM applied WHERE channel=? AND ts=? AND name=?', undef,
448 $config::invitation_channel, $invitation_ts, $real_name);
454 sub possibly_nag_user {
455 my ($dbh, $ua, $userid, $invitation_ts, $group, $slack_userid_to_slack_name) = @_;
457 my $slack_name = $slack_userid_to_slack_name->{$userid};
459 # See if we've nagged this user before.
460 my $q = $dbh->prepare('SELECT * FROM users_nagged WHERE userid=? AND ts=?');
461 $q->execute($userid, $invitation_ts);
462 if (defined($q->fetchrow_hashref)) {
467 if (!defined($group)) {
468 $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!";
469 skv_log("Sender Slack-melding til $slack_name ($userid) for Ć„ spĆørre om gruppe.");
470 } elsif ($group eq '(flere grupper)') {
471 $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!";
472 skv_log("Sender Slack-melding til $slack_name ($userid) for Ć„ spĆørre om gruppe.");
474 $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!";
475 skv_log("Sender Slack-melding om at $slack_name ($userid) er i gruppe $group.");
479 channel => $config::invitation_channel,
483 my $start = [Time::HiRes::gettimeofday];
484 my $response = $ua->post(
485 'https://slack.com/api/chat.postEphemeral',
486 Content => JSON::XS::encode_json($content),
487 Content_type => 'application/json;charset=UTF-8',
488 Authorization => 'Bearer ' . $config::slack_oauth_token
490 log_timing($start, 'chat.postEphemeral');
491 die $response->status_line if !$response->is_success;
492 my $msg_json = JSON::XS::decode_json($response->decoded_content);
493 die "Something went wrong: " . $response->decoded_content if (!defined($msg_json) || !$msg_json->{'ok'});
495 # Mark that we've sent the message, so it won't happen again.
496 $dbh->do('INSERT INTO users_nagged (userid, ts, last_nag) VALUES (?, ?, CURRENT_TIMESTAMP)', undef, $userid, $invitation_ts);
500 my $dbh = DBI->connect("dbi:Pg:dbname=$config::dbname;host=127.0.0.1", $config::dbuser, $config::dbpass, {RaiseError => 1})
501 or warn "Could not connect to Postgres: " . DBI->errstr;
502 if (!defined($dbh)) {
505 $dbh->{AutoCommit} = 0;
506 $dbh->do('LISTEN skvupdate') or return undef;
512 my $total_start = [Time::HiRes::gettimeofday];
515 skv_log("Siste sync startet: " . POSIX::ctime(time));
517 # For the logic on the āappliedā table below.
518 $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE');
520 my $token = get_oauth_bearer_token($dbh, $ua);
522 # Find the newest message, what it is linked to, and what was the one before it (for group diffing).
523 # TODO: Support more than one, and test better for errors here.
524 my $q = $dbh->prepare('select * from message_sheet_link where channel=? order by ts desc limit 2');
525 $q->execute($config::invitation_channel);
526 my $linkref = $q->fetchrow_hashref;
527 my $invitation_ts = $linkref->{'ts'};
528 my $wanted_sheet_title = $linkref->{'sheet_title'};
529 die "Could not get newest sheet title" if (!defined($wanted_sheet_title));
530 my $tab_name = $linkref->{'tab_name'};
531 my $tab_id = $linkref->{'tab_id'};
533 # Store away the second-newest ID.
534 my $prev_invitation_ts = $q->fetchrow_hashref->{'ts'};
536 if (!defined($tab_name) || !defined($tab_id)) {
537 ($tab_name, $tab_id) = get_spreadsheet_with_title($dbh, $ua, $token, $invitation_ts, $wanted_sheet_title);
538 if (!defined($tab_name)) {
539 skv_log("Fant ikke noen fane med Ā«$wanted_sheet_titleĀ» i navnet; kan ikke synkronisere.\n");
540 sheet_batch_update($ua, $token, [ serialize_skv_log_to_sheet() ]);
545 # Find everyone who are marked as attending on Slack (via reactions).
546 $q = $dbh->prepare('SELECT DISTINCT userid,reaction FROM current_reactions WHERE channel=? AND ts=? AND reaction IN (\'heart\', \'open_mouth\', \'blue_heart\')');
547 $q->execute($config::invitation_channel, $invitation_ts);
548 my @attending_userids = ();
551 while (my $ref = $q->fetchrow_hashref) {
552 my $userid = $ref->{'userid'};
553 push @attending_userids, $userid;
554 if ($ref->{'reaction'} eq 'blue_heart') {
555 if (exists($colors{$userid}) && $colors{$userid} eq 'yellow') {
556 $double{$userid} = 1;
558 $colors{$userid} = 'blue';
560 if (exists($colors{$userid}) && $colors{$userid} eq 'blue') {
561 $double{$userid} = 1;
563 $colors{$userid} = 'yellow';
567 # Remove double-attenders (we will log them as warnings further down).
568 @attending_userids = grep { !exists($double{$_}) } @attending_userids;
569 for my $userid (keys %double) {
570 delete $colors{$userid};
573 # Get the list of all people in the sheet (we're going to need them soon).
574 # Also get the Slack mapping when we're doing an API request anyway.
575 my $start = [Time::HiRes::gettimeofday];
576 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',
577 Authorization => 'Bearer ' . $token,
578 Accept_Encoding => HTTP::Message::decodable
580 log_timing($start, "/spreadsheets/");
582 my $sheets_json = JSON::XS::decode_json($response->decoded_content);
583 my $main_sheet_json = $sheets_json->{'sheets'}[0];
584 my $mapping_sheet_json = $sheets_json->{'sheets'}[1];
586 # Update the list of groups we've seen people in.
587 $start = [Time::HiRes::gettimeofday];
588 my %assignments = get_group_assignments($main_sheet_json);
589 log_timing($start, "Parsing group assignments");
590 $start = [Time::HiRes::gettimeofday];
591 update_assignment_db($dbh, $config::invitation_channel, $invitation_ts, \%assignments);
592 log_timing($start, "Updating assignments in database");
594 $start = [Time::HiRes::gettimeofday];
595 my %seen_names = find_where_each_name_is($main_sheet_json);
596 log_timing($start, "Making sort key reverse mapping");
599 for my $name (sort keys %seen_names) {
600 my $seen = $seen_names{$name};
601 if (scalar @$seen >= 2) {
602 my $exemplar = $seen->[0][0];
603 skv_log("Duplikat: $exemplar (" . format_cell_names_for_seen($seen) . ")");
607 # Get our existing Slack->name mapping, from the sheets.
608 my %slack_userid_to_real_name = ();
609 my %slack_userid_to_slack_name = ();
610 my %slack_userid_to_row = ();
612 my $mapping_sheet_rows = $mapping_sheet_json->{'data'}[0]{'rowData'};
614 for my $row (@$mapping_sheet_rows) {
615 my $slack_id = $row->{'values'}[0]{'userEnteredValue'}{'stringValue'};
616 my $slack_name = $row->{'values'}[1]{'userEnteredValue'}{'stringValue'};
617 my $real_name = get_spreadsheet_name($row->{'values'}[2]); # TODO support more
618 $slack_userid_to_row{$slack_id} = $cur_row++;
619 next if (!defined($slack_name));
620 $slack_userid_to_slack_name{$slack_id} = $slack_name;
621 next if (!defined($real_name));
622 $slack_userid_to_real_name{$slack_id} = $real_name;
625 # See which ones we don't have a mapping for, and look them up in Slack.
626 # TODO: Use an append call instead of $cur_row?
627 my @slack_mapping_updates = ();
628 for my $userid (@attending_userids) {
629 next if (exists($slack_userid_to_real_name{$userid}));
631 # Make sure they have a row in the spreadsheet.
633 if (exists($slack_userid_to_row{$userid})) {
634 $write_row = $slack_userid_to_row{$userid};
636 $write_row = $cur_row++;
637 $slack_userid_to_row{$userid} = $write_row;
638 push @slack_mapping_updates, {
639 range => "Slack-mapping!A$write_row:A$write_row",
640 values => [ [ $userid ]]
644 # Fetch their Slack name if we don't already have it.
646 if (exists($slack_userid_to_slack_name{$userid})) {
647 $slack_name = $slack_userid_to_slack_name{$userid};
649 $slack_userid_to_slack_name{$userid} = $slack_name;
650 $slack_name = get_slack_name($ua, $userid);
651 push @slack_mapping_updates, {
652 range => "Slack-mapping!B$write_row:B$write_row",
653 values => [ [ $slack_name ]]
655 $slack_userid_to_slack_name{$userid} = $slack_name;
658 if (exists($seen_names{sort_key($slack_name)})) {
659 # The name exists exactly, once or more, so it's a direct match and we ignore any fuzz.
660 $slack_userid_to_real_name{$userid} = $slack_name;
661 push @slack_mapping_updates, {
662 range => "Slack-mapping!C$write_row:C$write_row",
663 values => [ [ $slack_name ]]
666 # Do a search through all the available names in the sheet to find an obvious(ish) match.
668 my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
669 $start = [Time::HiRes::gettimeofday];
670 my @ap = map { sort_key($_) } split /\s+/, $slack_name; # Precalc for matches_name().
671 for my $row (@$main_sheet_rows) {
672 for my $val (@{$row->{'values'}}) {
673 my $name = get_spreadsheet_name($val);
674 if (defined($name) && matches_name($slack_name, $name, \@ap)) {
675 push @candidates, $name;
679 log_timing($start, "Fuzzy-searching for Slack name ā$slack_nameā");
680 if ($#candidates == -1) {
681 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men fant ikke et regneark-navn for dem.");
682 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, undef, \%slack_userid_to_slack_name);
683 } elsif ($#candidates == 0) {
684 my $name = $candidates[0];
685 $slack_userid_to_real_name{$userid} = $name;
686 push @slack_mapping_updates, {
687 range => "Slack-mapping!C$write_row:C$write_row",
688 values => [ [ $name ]]
691 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men hadde flere fuzzy-matcher; vet ikke hvilket regneark-navn som skal brukes.");
695 if (scalar @slack_mapping_updates > 0) {
697 valueInputOption => 'USER_ENTERED',
698 data => \@slack_mapping_updates
700 $start = [Time::HiRes::gettimeofday];
701 $response = $ua->post(
702 'https://sheets.googleapis.com/v4/spreadsheets/' . $config::sheet_id . '/values:batchUpdate?key=' . $config::gsheets_api_key,
703 Content => JSON::XS::encode_json($update),
704 Content_type => 'application/json;charset=UTF-8',
705 Authorization => 'Bearer ' . $token
707 log_timing($start, "/spreadsheets/values:batchUpdate");
708 die $response->decoded_content if (!$response->is_success);
711 # Now that we have Slack names, we can log double-reacters.
712 for my $userid (keys %double) {
713 my $name = best_name_for_log($userid, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
714 skv_log("$name er pƄmeldt flere steder pƄ Slack; vet ikke hvilken som skal brukes.");
717 # ...and possibly send welcome messages to remind them of groups.
718 for my $userid (@attending_userids) {
719 my $real_name = $slack_userid_to_real_name{$userid};
720 next if (!defined($real_name));
721 my $group = $assignments{$real_name};
722 next if (!defined($group));
723 possibly_nag_user($dbh, $ua, $userid, $invitation_ts, $group, \%slack_userid_to_slack_name);
726 # Find the list of names to mark yellow.
727 my %want_colors = ();
728 my $main_sheet_rows = $main_sheet_json->{'data'}[0]{'rowData'};
729 for my $userid (@attending_userids) {
730 next if (!exists($slack_userid_to_real_name{$userid}));
731 my $slack_name = $slack_userid_to_slack_name{$userid};
732 my $real_name = $slack_userid_to_real_name{$userid};
734 # See if we can find them in the spreadsheet.
735 my $sk = sort_key($real_name);
736 if (!exists($seen_names{$sk})) {
737 # TODO: Perhaps move this logic further down, for consistency?
738 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
740 my $seen = $seen_names{$sk};
741 if (scalar @$seen >= 2) {
742 skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men stƄr flere steder (se over); vet ikke hvilken celle som skal brukes.");
744 $want_colors{$seen->[0][0]} = $colors{$userid};
749 # Find the list of names we already marked yellow.
750 my %have_colors = ();
751 $q = $dbh->prepare('SELECT name,color FROM applied WHERE channel=? AND ts=?');
752 $q->execute($config::invitation_channel, $invitation_ts);
753 while (my $ref = $q->fetchrow_hashref) {
754 $have_colors{$ref->{'name'}} = $ref->{'color'};
757 my @diffs = find_diff($dbh, $invitation_ts, \%want_colors, \%have_colors, \%seen_names);
759 my @yellow_updates = ();
760 if (scalar @diffs > 0) {
761 # Now fill in the actual stuff.
762 for my $diff (@diffs) {
763 my $real_name = $diff->[0];
765 my $seen = $seen_names{sort_key($real_name)};
767 # We've already complained about these earlier, so just skip them silently.
768 next if (scalar @$seen > 1);
770 # See if we can find them in the spreadsheet.
771 die "Could not find $real_name" if (!defined($seen));
772 my $rowno = $seen->[0][1];
773 my $colno = $seen->[0][2];
774 push @yellow_updates, {
778 userEnteredFormat => $diff->[1]
781 fields => 'userEnteredFormat.backgroundColor',
784 startRowIndex => $rowno,
785 endRowIndex => $rowno + 1,
786 startColumnIndex => $colno,
787 endColumnIndex => $colno + 1
794 my @recent_changes = create_reaction_log($dbh, $invitation_ts, \%slack_userid_to_real_name, \%slack_userid_to_slack_name);
795 push @yellow_updates, {
797 rows => \@recent_changes,
798 fields => 'userEnteredValue.stringValue',
800 sheetId => $config::log_tab_id,
802 endRowIndex => 4 + scalar @recent_changes,
803 startColumnIndex => 0,
809 my @recent_moves = create_move_log($dbh, $invitation_ts, $prev_invitation_ts);
810 push @yellow_updates, {
812 rows => \@recent_moves,
813 fields => 'userEnteredValue.stringValue',
815 sheetId => $config::log_tab_id,
817 endRowIndex => 4 + scalar @recent_moves,
818 startColumnIndex => 1,
824 # Push the final set of updates (including the log).
826 push @yellow_updates, serialize_skv_log_to_sheet();
827 sheet_batch_update($ua, $token, \@yellow_updates);
830 my $elapsed = Time::HiRes::tv_interval($total_start);
831 printf "Tok %.0f ms.\n", 1e3 * $elapsed;
834 # Initialize the handles we need for communication.
835 my $dbh = db_connect() or die;
836 my $ua = LWP::UserAgent->new(agent => 'SKVidarLang/1.0', keep_alive => 50);
837 if ($#ARGV >= 0 && $ARGV[0] eq '--daemon') {
838 # Start with a single, forced run.
842 while (!defined($dbh)) {
843 print STDERR "Database connection lost, reconnecting...\n";
847 my $s = IO::Select->new($dbh->{pg_socket});
848 my @ready = $s->can_read(10.0);
849 my @exceptions = $s->has_exception(0.0);
851 if (scalar @exceptions > 0) {
856 if (scalar @ready > 0) {
861 warn "Died with: $@";
866 } elsif ($#ARGV >= 0 && $ARGV[0] eq '--benchmark') {