From 5ee52eb7f38ca9678139c6ec2015e7314761e64b Mon Sep 17 00:00:00 2001
From: Roman Lacko <xlacko1@fi.muni.cz>
Date: Tue, 22 Aug 2017 22:31:19 +0200
Subject: [PATCH] Implement caching, inversion and blinking
---
Breeze/Cache.pm | 58 +++++++++++++++
Breeze/Core.pm | 175 +++++++++++++++++++++++++++++++++++++---------
Breeze/Counter.pm | 37 ++++++++++
WBM/Fail.pm | 12 ++--
WBM/Time2.pm | 45 ++++++++++++
test.yaml | 21 +++++-
6 files changed, 309 insertions(+), 39 deletions(-)
create mode 100644 Breeze/Cache.pm
create mode 100644 WBM/Time2.pm
diff --git a/Breeze/Cache.pm b/Breeze/Cache.pm
new file mode 100644
index 0000000..5709b3b
--- /dev/null
+++ b/Breeze/Cache.pm
@@ -0,0 +1,58 @@
+package Breeze::Cache;
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use Breeze::Counter;
+use Data::Dumper;
+
+sub new($class, %args) {
+ return bless {
+ storage => {},
+ }, $class;
+}
+
+sub get($self, $key) {
+ my $entry = $self->{storage}->{$key};
+ return unless defined $entry;
+
+ # if entry was zero, the key expired, delete it and move on
+ if (!$entry->[0]--) {
+ delete $self->{storage}->{$key};
+ return;
+ }
+
+ return { $entry->[1]->%* };
+}
+
+sub set($self, $key, $value, $recall = 1) {
+ return if exists $self->{storage}->{$key};
+
+ $self->{storage}->{$key} = [
+ Breeze::Counter->new(current => $recall),
+ { %$value },
+ ];
+
+ print STDERR "cache stored ", Dumper($value);
+ # do not return entry
+ return;
+}
+
+sub flush($self, @keys) {
+ # on total flush, just recreate storage
+ if (!@keys) {
+ $self->{storage} = {};
+ # delete selected keys
+ } else {
+ delete $self->{storage}->@{@keys};
+ }
+}
+
+# vim: syntax=perl5-24
+
+1;
diff --git a/Breeze/Core.pm b/Breeze/Core.pm
index ffa246a..cfcc1b9 100644
--- a/Breeze/Core.pm
+++ b/Breeze/Core.pm
@@ -8,11 +8,13 @@ use warnings;
use feature qw(signatures);
no warnings qw(experimental::signatures);
+use Breeze::Cache;
use Breeze::Counter;
use Breeze::Logger;
use Breeze::Logger::File;
use Breeze::Logger::StdErr;
use Carp;
+use Data::Dumper;
use JSON::XS;
use Module::Load;
use Time::Out qw(timeout);
@@ -20,7 +22,8 @@ use Try::Tiny;
sub new($class, $config) {
my $self = {
- config => $config,
+ config => $config,
+ cache => Breeze::Cache->new,
};
bless $self, $class;
@@ -32,8 +35,9 @@ sub new($class, $config) {
}
# getters
-sub cfg($self) { $self->{config}; }
-sub log($self) { $self->{logger}; }
+sub cfg($self) { $self->{config}; }
+sub log($self) { $self->{logger}; }
+sub cache($self) { $self->{cache}; }
sub mod($self, $name = undef) {
return $self->{mods} if !defined $name;
@@ -154,46 +158,57 @@ sub init_modules($self) {
};
push $self->{mods}->@*, $entry;
- $self->{mods_by_name} = $entry;
+ $self->{mods_by_name}->{$modname} = $entry;
}
}
}
-
sub run($self) {
my $ret;
foreach my $entry ($self->mod->@*) {
# separators will be handled in postprocessing
if (exists $entry->{separator}) {
- push @$ret, $entry;
+ push @$ret, { %$entry };
next;
}
- # TODO cache
-
- # handle module with timeout
- my $data = timeout($self->cfg->{timeout} => sub {
- return try {
- $entry->{mod}->invoke;
- } catch {
- chomp $_;
- $self->log->error("error in '$entry->{conf}->{-name}' ($entry->{conf}->{-driver})");
- $self->log->error($_);
- undef;
- };
- });
-
- # module timeouted?
- if ($@) {
- $data = $self->timeout_module($entry);
- # module failed?
- } elsif (!defined $data) {
- $data = $self->fail_module($entry);
+ # try to get cached output first
+ $self->log->debug("looking for $entry->{conf}->{-name}");
+ my $data = $self->cache->get($entry->{conf}->{-name});
+
+ if (!defined $data) {
+ $data = timeout($self->cfg->{timeout} => sub {
+ return try {
+ $entry->{mod}->invoke;
+ } catch {
+ chomp $_;
+ $self->log->error("error in '$entry->{conf}->{-name}' ($entry->{conf}->{-driver})");
+ $self->log->error($_);
+ undef;
+ };
+ });
+
+ # module timeouted?
+ if ($@) {
+ $data = $self->timeout_module($entry);
+ # module failed?
+ } elsif (!defined $data) {
+ $data = $self->fail_module($entry);
+ }
+ } else {
+ # ignore cached 'blink' and 'invert'
+ delete $data->@{qw(blink invert)};
}
# set entry and instance
$data->@{qw(entry instance)} = $entry->{conf}->@{qw(-name -name)};
+ if (($entry->{conf}->{-refresh} // 0) >= 1) {
+ $self->cache->set($entry->{conf}->{-name}, $data, $entry->{conf}->{-refresh});
+ } elsif (defined $data->{cache} && $data->{cache} >= 0) {
+ $self->cache->set($entry->{conf}->{-name}, $data, $data->{cache});
+ }
+
push @$ret, $data;
}
@@ -206,7 +221,6 @@ sub run($self) {
sub u8($self, $what) {
my $t = join("", map { chr(hex) } ($what =~ m/../g));
utf8::decode($t);
- $self->log->info("decoded '$what' to be '$t'");
return $t;
}
@@ -234,19 +248,93 @@ sub post_process_seg($self, $ret) {
} elsif (defined $data->{text}) {
$data->{full_text} = $data->{text};
}
+ }
+}
+
+sub get_or_set_timer($self, $key, $timer, $ticks) {
+ my $timers = $self->mod($key)->{tmrs};
+
+ print STDERR "timers for '$key'\n";
+ print STDERR Dumper($timers);
+ # nothing to do if no timer set and ticks is undefined
+ return if !defined $timers->{$timer} && !defined $ticks;
+
+ # create timer if there is none
+ $timers->{$timer} = Breeze::Counter->new(current => $ticks)
+ if !defined $timers->{$timer};
+
+ # return a reference to the timer
+ return \$timers->{$timer};
+}
+
+sub delete_timer($self, $key, $timer) {
+ delete $self->mod($key)->{tmrs}->{$timer};
+}
+
+sub post_process_inversion($self, $ret) {
+ foreach my $seg (@$ret) {
+ # separators are not supposed to blink
+ next if exists $seg->{separator};
+
+ print STDERR "invert $seg->{entry}\n";
+ my $timer = $self->get_or_set_timer($seg->{entry}, "invert", $seg->{invert});
+ next if !defined $timer;
+
+ # advance timer
+ my $tick = (--$$timer)->current;
- # cleanup
- delete $data->@{qw(text icon)};
+ # use xor to invert blinking if 'invert' flag is already set
+ $seg->{invert} = 1 if $tick >= 0;
+
+ # remove timer if expired
+ $self->delete_timer($seg->{entry}, "invert") unless $tick;
+ }
+}
+
+sub post_process_blinking($self, $ret) {
+ foreach my $seg (@$ret) {
+ # separators are not supposed to blink
+ next if exists $seg->{separator};
+
+ print STDERR "blink $seg->{entry}\n";
+ my $timer = $self->get_or_set_timer($seg->{entry}, "blink", $seg->{blink});
+ next if !defined $timer;
+
+ # advance timer
+ my $tick = (--$$timer)->current;
+
+ # use xor to invert blinking if 'invert' flag is already set
+ $seg->{invert} = ($seg->{invert} xor ($tick % 2 == 0));
+
+ # remove timer if expired
+ $self->delete_timer($seg->{entry}, "blink") unless $tick;
+ }
+}
+
+sub post_process_inverted($self, $ret) {
+ foreach my $seg (@$ret) {
+ # separators are not to be inverted (here)
+ next if exists $seg->{separator};
+
+ if ($seg->{invert}) {
+ # set sane defaults
+ foreach (qw(color background)) {
+ $seg->{$_} = $self->cfg->{defaults}->{$_}
+ unless defined $seg->{$_};
+ }
+
+ $seg->@{qw(color background)} = $seg->@{qw(background color)};
+ }
}
}
sub post_process_sep($self, $ret) {
my $default_bg = $self->cfg->{defaults}->{background};
+ my $counter = 0;
foreach my $ix (0..$#$ret) {
my $sep = $ret->[$ix];
next if !exists $sep->{separator};
- delete $sep->{separator};
# set separator icon
$sep->{full_text} = "%utf8{ee82b2}";
@@ -263,6 +351,9 @@ sub post_process_sep($self, $ret) {
delete $sep->{border};
$sep->{background} = $ret->[$ix - 1]->{background} // $default_bg;
}
+
+ $sep->{entry} = $sep->{instance} = "__separator_$counter";
+ ++$counter;
}
}
@@ -275,9 +366,16 @@ sub post_process_attr($self, $ret) {
}
}
- # replace 'utf8{byte}' with utf8 character
+ # replace '%utf8{byte}' with utf8 character
$seg->{full_text} =~ s/%utf8\{(.*?)\}/$self->u8($1)/ge;
+ # add padding if requested
+ if ($self->cfg->{padding} && $seg->{entry} !~ m/^__separator_/) {
+ my $pad = " " x $self->cfg->{padding};
+ $seg->{full_text} =~ s/^(\S)/$pad$1/;
+ $seg->{full_text} =~ s/(\S)$/$1$pad/;
+ }
+
# set separator width and distance
$seg->{separator} = JSON::XS::false;
$seg->{separator_block_width} = 0;
@@ -288,11 +386,24 @@ sub post_process($self, $ret) {
# process all module segments
$self->post_process_seg($ret);
- # process separator segments
+ # process inversion and blinking
+ # (colors must be figured before computing separators)
+ $self->post_process_inversion($ret);
+ $self->post_process_blinking($ret);
+
+ # process inverted elements
+ $self->post_process_inverted($ret);
+
+ # process separator segment
$self->post_process_sep($ret);
# fix colors and utf8 characters
$self->post_process_attr($ret);
+
+ # cleanup tags
+ foreach my $seg (@$ret) {
+ delete $seg->@{qw(separator text icon blink invert)};
+ }
}
# vim: syntax=perl5-24
diff --git a/Breeze/Counter.pm b/Breeze/Counter.pm
index 5a88179..5e842bf 100644
--- a/Breeze/Counter.pm
+++ b/Breeze/Counter.pm
@@ -10,6 +10,14 @@ no warnings qw(experimental::signatures);
use Carp;
+use overload
+ "+=" => \&op_peq,
+ "-=" => \&op_meq,
+ "=" => \&op_assign,
+ "bool" => \&op_bool,
+ '""' => \&op_scalar,
+ "0+" => \&op_scalar;
+
sub from($self) { $self->{from}; }
sub to($self) { $self->{to}; }
sub cycle($self) { $self->{cycle}; }
@@ -80,6 +88,35 @@ sub reset($self) {
return $self->{current} = $self->{start};
}
+sub clone($self) {
+ my %attrs = %$self;
+ delete $attrs{start};
+ return __PACKAGE__->new(%attrs);
+}
+
+# operators
+sub op_bool($self, $, $) {
+ return $self->{current} != $self->{from};
+}
+
+sub op_scalar($self, $, $) {
+ return $self->{current};
+}
+
+sub op_peq($self, $o, $swap) {
+ $self->next foreach (1..$o);
+ return $self;
+}
+
+sub op_meq($self, $o, $swap) {
+ $self->prev foreach (1..$o);
+ return $self;
+}
+
+sub op_assign($self, $, $) {
+ return $self->clone;
+}
+
# vim: syntax=perl5-24
1;
diff --git a/WBM/Fail.pm b/WBM/Fail.pm
index 6ceb5c5..dde21b5 100644
--- a/WBM/Fail.pm
+++ b/WBM/Fail.pm
@@ -30,13 +30,17 @@ sub invoke($self) {
full_text => $self->{text},
icon => "%utf8{f09f9eaa}",
color => "ff5f00",
+ cache => "+inf",
};
+ $self->log->info("invoked");
if ($self->{first}) {
- $ret->{blink} = 6;
- $self->{first} = 0;
- } elsif(!$self->{dismissed}) {
- $ret->{inverse} = 1;
+ $ret->{blink} = 6;
+ $self->{first} = 0;
+ }
+
+ if (!$self->{dismissed}) {
+ $ret->{invert} = "+inf";
}
return $ret;
diff --git a/WBM/Time2.pm b/WBM/Time2.pm
new file mode 100644
index 0000000..2a464a9
--- /dev/null
+++ b/WBM/Time2.pm
@@ -0,0 +1,45 @@
+package WBM::Time2;
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use parent qw(WBM::Driver);
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use Carp;
+use Time::Format qw(%strftime);
+
+sub new($class, %args) {
+ my $self = $class->SUPER::new(%args);
+
+ croak "missing 'format' parameter in constructor"
+ unless defined $args{format};
+
+ croak "missing 'icon' parameter in constructor"
+ unless defined $args{icon};
+
+ $self->{format} = $args{format};
+ $self->{icon} = $args{icon};
+ $self->{first} = 1;
+ return $self;
+}
+
+sub invoke($self) {
+ my $ret = {
+ text => $strftime{$self->{format}, localtime},
+ icon => $self->{icon},
+ background => '660033',
+ color => 'ffffff',
+ };
+
+ $ret->{invert} = 8 if $self->{first};
+ delete $self->{first};
+ return $ret;
+}
+
+# vim: syntax=perl5-24
+
+1;
diff --git a/test.yaml b/test.yaml
index 223b8eb..6e08be9 100644
--- a/test.yaml
+++ b/test.yaml
@@ -6,8 +6,8 @@
# - %STDERR write to stderr
# - null disable logging entirely
#logfile: "/tmp/breeze-$$.log"
-#logfile: %STDERR
-logfile: null
+logfile: %STDERR
+#logfile: null
# Turn debugging on or off.
#
@@ -44,6 +44,11 @@ timeouts: 3
# Values: positive integers
failures: 3
+# Spaces to add around full_text entries.
+#
+# Values: non-negative integers
+padding: 1
+
# Default values for output entry.
defaults:
background: 002b36
@@ -58,9 +63,19 @@ defaults:
modules:
# leading separator
- separator
+ - -name: fail
+ -driver: WBM::Fail
+ text: "FAILURE"
+ - separator
+ - -name: time-2
+ -driver: WBM::Time2
+ -refresh: 0
+ format: "%a %y-%m-%d %H:%M:%S"
+ icon: %utf8{ef809720}
+ - separator
- -name: time
-driver: WBM::Time
- -refresh: 1
+ -refresh: 0
format: "%a %y-%m-%d %H:%M:%S"
icon: %utf8{ef809720}
# add trailing separator
--
GitLab