blue => 0,
alpha => 1
},
+ orange => {
+ red => 0xf9 / 255.0,
+ green => 0xcb / 255.0,
+ blue => 0x9c / 255.0,
+ alpha => 1
+ },
blue => {
red => 0,
green => 1,
printf "%s: %.0f ms.\n", $msg, 1e3 * $elapsed;
}
+# Unicode::Collate is seemingly slow, so add a cache for each name part
+# (which, of course, only works for equality). Helps especially in
+# --daemon mode, where even the first request gets a warm cache.
+my %sort_key_cache = ();
+my $sort_key_sp = $uca->getSortKey(' ');
+
sub sort_key {
my $m = shift;
- return $uca->getSortKey($m);
+ my $sk;
+ for my $part (split /\s+/, $m) {
+ my $psk = \$sort_key_cache{$part};
+ if (!defined($$psk)) {
+ $$psk = $uca->getSortKey($part);
+ }
+ if (defined($sk)) {
+ $sk .= $sort_key_sp;
+ $sk .= $$psk;
+ } else {
+ $sk = $$psk;
+ }
+ }
+ return $sk;
}
sub get_oauth_bearer_token {
my $name = $cell->{'userEnteredValue'}{'stringValue'};
return undef if (!defined($name));
return undef if ($name =~ /^G[1-4]\.[1-5]/);
+ return undef if ($name =~ /^1r/);
$name =~ s/š//;
$name =~ s/\(.*\)//g;
$name =~ s/\[.*\]//g;
if (scalar @$ap >= 2 && scalar @bp >= 2 && $ap->[0] eq $bp[0]) {
# First name matches, try to match some surname
my $found = 0;
- for my $ai (1..(scalar @$ap)) {
+ for my $ai (1..(scalar @$ap - 1)) {
for my $bi (1..$#bp) {
$found = 1 if ($ap->[$ai] eq $bp[$bi]);
}
next if $contents =~ /^LT\b/;
next if $contents =~ /^400m/;
next if $contents =~ /^546m/;
+ next if $contents =~ /^1r/;
if ($contents =~ /^(G\d\.\d)/ || $contents =~ /^(Nye lĆøpere.*)/) {
$curr_groups[$col] = $1;
} else {
sub update_assignment_db {
my ($dbh, $channel, $ts, $assignments) = @_;
- local $dbh->{AutoCommit} = 0;
my %db_assignments = ();
my $q = $dbh->prepare('SELECT name,group_name FROM current_group_membership_history WHERE channel=? AND ts=?');
$q->execute($channel, $ts);
$q->execute($channel, $ts, $name, undef);
}
}
- $dbh->commit;
}
sub get_spreadsheet_with_title {
sub create_reaction_log {
my ($dbh, $invitation_ts, $slack_userid_to_real_name, $slack_userid_to_slack_name) = @_;
- 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');
+ 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\',\'orange_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');
$q->execute($config::invitation_channel, $invitation_ts);
my @recent_changes = ();
while (my $ref = $q->fetchrow_hashref) {
$msg .= 'š®';
} elsif ($ref->{'reaction'} eq 'blue_heart') {
$msg .= 'š';
+ } elsif ($ref->{'reaction'} eq 'orange_heart') {
+ $msg .= 'š§”';
} else {
$msg .= 'ā¤ļø';
}
my $q = $dbh->prepare(<<"EOF");
SELECT
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
-FROM ( SELECT * FROM current_group_membership_history WHERE ts=? ) g_old
- FULL OUTER JOIN ( SELECT * FROM current_group_membership_history WHERE ts=? ) g_new USING (name)
+FROM ( SELECT * FROM current_group_membership_history WHERE channel=? AND ts=? ) g_old
+ FULL OUTER JOIN ( SELECT * FROM current_group_membership_history WHERE channel=? AND ts=? ) g_new USING (name)
WHERE
g_new.group_name IS DISTINCT FROM g_old.group_name
AND g_new.group_name IS NOT NULL
ORDER BY g_new.change_seen DESC, name
LIMIT 50
EOF
- $q->execute($prev_invitation_ts, $invitation_ts);
+ $q->execute($config::invitation_channel, $prev_invitation_ts, $config::invitation_channel, $invitation_ts);
my @recent_moves = ();
while (my $ref = $q->fetchrow_hashref) {
my $name = $ref->{'name'};
}
for my $real_name (keys %$have_colors) {
next if (exists($want_colors->{$real_name}));
- if (!exists($seen_names->{sort_key($real_name)})) {
+ my $sk = sort_key($real_name);
+ if (!exists($seen_names->{$sk})) {
# TODO: This can somehow come if we try to add someone who's not in the sheet, too?
skv_log("Ćnsket Ć„ fjerne at $real_name skulle pĆ„ trening, men de var ikke i regnearket lenger.");
- } elsif (scalar @{$seen_names->{sort_key($real_name)}} > 1) {
+ } elsif (scalar @{$seen_names->{$sk}} > 1) {
# Don't touch them.
} else {
skv_log("Fjerner at $real_name skal pƄ trening.");
if (!defined($dbh)) {
return undef;
}
+ $dbh->{AutoCommit} = 0;
$dbh->do('LISTEN skvupdate') or return undef;
return $dbh;
}
@log = ();
skv_log("Siste sync startet: " . POSIX::ctime(time));
+ # For the logic on the āappliedā table below.
+ $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE');
+
my $token = get_oauth_bearer_token($dbh, $ua);
# Find the newest message, what it is linked to, and what was the one before it (for group diffing).
}
# Find everyone who are marked as attending on Slack (via reactions).
- $q = $dbh->prepare('SELECT DISTINCT userid,reaction FROM current_reactions WHERE channel=? AND ts=? AND reaction IN (\'heart\', \'open_mouth\', \'blue_heart\')');
+ $q = $dbh->prepare('SELECT DISTINCT userid,reaction FROM current_reactions WHERE channel=? AND ts=? AND reaction IN (\'heart\', \'open_mouth\', \'blue_heart\', \'orange_heart\')');
$q->execute($config::invitation_channel, $invitation_ts);
my @attending_userids = ();
my %colors = ();
my $userid = $ref->{'userid'};
push @attending_userids, $userid;
if ($ref->{'reaction'} eq 'blue_heart') {
- if (exists($colors{$userid}) && $colors{$userid} eq 'yellow') {
+ if (exists($colors{$userid}) && $colors{$userid} ne 'blue') {
$double{$userid} = 1;
}
$colors{$userid} = 'blue';
+ } elsif ($ref->{'reaction'} eq 'orange_heart') {
+ if (exists($colors{$userid}) && $colors{$userid} ne 'orange') {
+ $double{$userid} = 1;
+ }
+ $colors{$userid} = 'orange';
} else {
- if (exists($colors{$userid}) && $colors{$userid} eq 'blue') {
+ if (exists($colors{$userid}) && $colors{$userid} ne 'yellow') {
$double{$userid} = 1;
}
$colors{$userid} = 'yellow';
log_timing($start, "/spreadsheets/");
my $sheets_json = JSON::XS::decode_json($response->decoded_content);
+ if (!exists($sheets_json->{'sheets'})) {
+ die "Missing sheets (error response?): " . $response->decoded_content;
+ }
my $main_sheet_json = $sheets_json->{'sheets'}[0];
my $mapping_sheet_json = $sheets_json->{'sheets'}[1];
# Update the list of groups we've seen people in.
+ $start = [Time::HiRes::gettimeofday];
my %assignments = get_group_assignments($main_sheet_json);
+ log_timing($start, "Parsing group assignments");
+ $start = [Time::HiRes::gettimeofday];
update_assignment_db($dbh, $config::invitation_channel, $invitation_ts, \%assignments);
+ log_timing($start, "Updating assignments in database");
$start = [Time::HiRes::gettimeofday];
my %seen_names = find_where_each_name_is($main_sheet_json);
}
}
}
- log_timing($start, "Fuzzy-searching for Slack name ā$slack_nameā");
+ log_timing($start, "Fuzzy-searching for Slack name $slack_name");
if ($#candidates == -1) {
skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men fant ikke et regneark-navn for dem.");
possibly_nag_user($dbh, $ua, $userid, $invitation_ts, undef, \%slack_userid_to_slack_name);
my $real_name = $slack_userid_to_real_name{$userid};
# See if we can find them in the spreadsheet.
- if (!exists($seen_names{sort_key($real_name)})) {
+ my $sk = sort_key($real_name);
+ if (!exists($seen_names{$sk})) {
# TODO: Perhaps move this logic further down, for consistency?
skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, og er mappet til $real_name, men var ikke i noen gruppe.");
} else {
- my $seen = $seen_names{sort_key($real_name)};
+ my $seen = $seen_names{$sk};
if (scalar @$seen >= 2) {
skv_log("$slack_name ($userid) er pƄmeldt pƄ Slack, men stƄr flere steder (se over); vet ikke hvilken celle som skal brukes.");
} else {
# Find the list of names we already marked yellow.
my %have_colors = ();
- $dbh->{AutoCommit} = 0;
- $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE');
$q = $dbh->prepare('SELECT name,color FROM applied WHERE channel=? AND ts=?');
$q->execute($config::invitation_channel, $invitation_ts);
while (my $ref = $q->fetchrow_hashref) {
my $elapsed = Time::HiRes::tv_interval($total_start);
printf "Tok %.0f ms.\n", 1e3 * $elapsed;
+ print "\n";
}
# Initialize the handles we need for communication.
run($dbh, $ua);
while (1) {
- while (!defined($dbh)) {
+ while (!defined($dbh) || !$dbh->ping) {
print STDERR "Database connection lost, reconnecting...\n";
sleep 1;
- $dbh = db_connect();
+ eval {
+ $dbh = db_connect();
+ };
}
my $s = IO::Select->new($dbh->{pg_socket});
- my @ready = $s->can_read(10.0);
+ my @ready = $s->can_read(150.0); # slack.com HTTP timeout is ~3 minutes, sheets.googleapis.com is ~4 minutes.
my @exceptions = $s->has_exception(0.0);
if (scalar @exceptions > 0) {
}
if (scalar @ready > 0) {
eval {
- $dbh->{AutoCommit} = 1;
run($dbh, $ua);
- $dbh->commit;
};
if ($@) {
warn "Died with: $@";
$dbh = undef;
}
+ } else {
+ # Keep the connections alive and the token in the database fresh.
+ # (The two URLs we use don't really exist. Note that the first time,
+ # we might be making the initial connection to slack.com, since it's
+ # not a given that run() needed to talk to them.)
+ get_oauth_bearer_token($dbh, $ua);
+ $dbh->commit;
+ #my $start = [Time::HiRes::gettimeofday];
+ $ua->get('https://sheets.googleapis.com/ping');
+ #log_timing($start, 'sheets.googleapis.com (keepalive)');
+ #$start = [Time::HiRes::gettimeofday];
+ $ua->get('https://slack.com/api/ping');
+ #log_timing($start, 'slack.com (keepalive)');
+ #print STDERR "\n";
}
}
} elsif ($#ARGV >= 0 && $ARGV[0] eq '--benchmark') {
for my $i (0..9) {
- $dbh->{AutoCommit} = 1;
run($dbh, $ua);
- $dbh->commit;
}
} else {
run($dbh, $ua);