diff --git a/lib/Synergy/Reactor/Status.pm b/lib/Synergy/Reactor/Status.pm index c0ea9cc6..3cb10151 100644 --- a/lib/Synergy/Reactor/Status.pm +++ b/lib/Synergy/Reactor/Status.pm @@ -11,7 +11,7 @@ use utf8; use experimental qw(signatures); use namespace::clean; use List::Util qw(first); -use Synergy::Util qw(parse_time_hunk); +use Synergy::Util qw(parse_time_hunk day_name_from_abbr); use Time::Duration::Parse; use Time::Duration; @@ -202,8 +202,16 @@ sub _business_hours_status ($self, $event, $user) { ucfirst $user->theyre, $user->their; } - return sprintf "It's currently %s normal business hours.", - $user->their; + my $trailer = ''; + if ($user->is_wfh_on($dow)) { + $trailer = sprintf q{, and usually %s works from home on %ss}, + $user->they, + day_name_from_abbr($dow); + } + + return sprintf "It's currently %s normal business hours%s.", + $user->their, + $trailer, } sub _chatter_status ($self, $event, $user) { diff --git a/lib/Synergy/User.pm b/lib/Synergy/User.pm index b581cf2c..cffba602 100644 --- a/lib/Synergy/User.pm +++ b/lib/Synergy/User.pm @@ -172,6 +172,11 @@ sub hours_for_dow ($self, $dow) { return $hours; } +sub is_wfh_on ($self, $dow) { + my $wfh_days = $self->preference('wfh-days'); + return !! grep {; $_ eq $dow } @$wfh_days; +} + # We must now inject $hub, because the directory is not necessarily attached # to one. sub shift_for_day ($self, $hub, $moment) { diff --git a/lib/Synergy/UserDirectory.pm b/lib/Synergy/UserDirectory.pm index 0116ae16..874203aa 100644 --- a/lib/Synergy/UserDirectory.pm +++ b/lib/Synergy/UserDirectory.pm @@ -14,8 +14,9 @@ use experimental qw(signatures lexical_subs); use namespace::autoclean; use Path::Tiny; use Synergy::User; -use Synergy::Util qw(known_alphabets read_config_file); +use Synergy::Util qw(known_alphabets read_config_file day_name_from_abbr); use Synergy::Logger '$Logger'; +use Lingua::EN::Inflect qw(WORDLIST); use List::Util qw(first shuffle all); use DateTime; use Defined::KV; @@ -382,4 +383,30 @@ __PACKAGE__->add_preference( }, ); +__PACKAGE__->add_preference( + name => 'wfh-days', + help => q{days you work regularly from home; use "Wed, Fri" (etc.)"}, + default => sub { [] }, + describer => sub ($value) { + my @all = map {; day_name_from_abbr($_) } @$value; + return @all ? WORDLIST(@all) : ''; + }, + validator => sub ($self, $value, @) { + my @known = qw(mon tue wed thu fri sat sun); + my %is_valid = map {; $_ => 1 } @known; + + my @got = split /[,;]\s+/, lc $value; + + return [] if @got == 1 and $got[0] eq 'none'; + + my @bad = grep {; ! $is_valid{$_} } @got; + if (@bad) { + my $err = q{use 3-letter day abbreviations, separated with commas, like "Wed, Fri" (or "none")}; + return (undef, $err); + } + + return \@got; + }, +); + 1; diff --git a/lib/Synergy/Util.pm b/lib/Synergy/Util.pm index 6f5b7e90..3f1bb120 100644 --- a/lib/Synergy/Util.pm +++ b/lib/Synergy/Util.pm @@ -37,6 +37,7 @@ use Sub::Exporter -setup => [ qw( transliterate validate_business_hours describe_business_hours + day_name_from_abbr ) ]; sub read_config_file ($filename) { @@ -547,4 +548,18 @@ sub describe_business_hours ($value) { (qw(weekdays sun), @wdays, qw(sat weekends)); } +sub day_name_from_abbr ($dow) { + state $days = { + mon => 'Monday', + tue => 'Tuesday', + wed => 'Wednesday', + thu => 'Thursday', + fri => 'Friday', + sat => 'Saturday', + sun => 'Sunday', + }; + + return $days->{$dow}; +} + 1;