Add development version with basic event loop

Breeze/Core.pm

+package Breeze::Core;
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use feature     qw(signatures);
+no  warnings    qw(experimental::signatures);
+
+use Breeze::Logger;
+use Breeze::Logger::File;
+use Breeze::Logger::StdErr;
+use Carp;
+use Module::Load;
+use Try::Tiny;
+
+sub new($class, $config) {
+    my $self = {
+        config => $config,
+    };
+
+    bless $self, $class;
+
+    $self->validate;
+    $self->init_logger;
+    $self->init_modules;
+    return $self;
+}
+
+# getters
+sub cfg($self) { $self->{config}; }
+sub log($self) { $self->{logger}; }
+
+# primitive validate configuration
+sub validate($self) {
+}
+
+# initializers
+sub init_logger($self) {
+    my $f = $self->cfg->{logfile};
+    my %a = $self->cfg->%{qw(debug)};
+    my $c = "Breeze::Core";
+
+    if (!defined $f) {
+        $self->{logger} = Breeze::Logger->new($c, %a);
+    } elsif ($f eq "%STDERR") {
+        $self->{logger} = Breeze::Logger::StdErr->new($c, %a);
+    } else {
+        $f =~ s/\$\$/$$/g;
+        $self->{logger} = Breeze::Logger::File->new($c, filename => $f, %a);
+    }
+}
+
+sub init_modules($self) {
+    $self->{mods} = [];
+    $self->{mods_by_name} = {};
+
+    # stack modules in reverse order, first module will be added to
+    # the list as the last
+    foreach my $modcfg (reverse $self->cfg->{modules}->@*) {
+        # is $modcfg is a scalar?
+        if (ref $modcfg eq "") {
+            # it might be a separator
+            if ($modcfg eq "separator") {
+                push $self->{mods}->@*, { separator => undef };
+            # otherwise it's an error
+            } else {
+                $self->log->fatal("scalar '$modcfg' found instead of module description");
+            }
+        } else {
+            # check for required parameters
+            foreach my $key (qw(-name -driver)) {
+                $self->log->fatal("missing '$key' in module description")
+                    unless defined $modcfg->{$key};
+            }
+
+            # check that only known keys begin with '-'
+            foreach my $key (grep { $_ =~ m/^-/ } (keys $modcfg->%*)) {
+                $self->log->warn("unknown '$key' in module description")
+                    unless $key =~ m/^-(name|refresh|driver)$/;
+            }
+
+            my ($moddrv, $modname) = $modcfg->@{qw(-driver -name)};
+            $self->log->info("trying to load '$moddrv' as '$modname'");
+
+            # initialize the module instance
+            my $module = try {
+                load $moddrv;
+
+                # pass only the '-name' parameter and those that
+                # do not begin with '-'
+                my @keys = grep { $_ !~ m/^-/ } (keys $modcfg->%*);
+                my %args = $modcfg->%{-name, @keys};
+                $args{-log} = $self->log->clone(category => $modname);
+
+                # create instance
+                return $moddrv->new(%args);
+            } catch {
+                chomp $_;
+                $self->log->error("failed to initialize '$modname'");
+                $self->log->error($_);
+                return undef;
+            };
+
+            if (!defined $module && $moddrv ne "WBM::Fail") {
+                # replace module description with dummy text and redo
+                $self->log->info("replacing '$moddrv' with failed placeholder");
+                $modcfg = $self->failed_module($modname, $moddrv);
+                redo;
+            } elsif (!defined $module) {
+                # WBM::Fail failed, well fuck
+                $self->log->fatal("WBM::Fail failed");
+            }
+
+            # got here so far, save all
+            my $entry = {
+                conf => $modcfg,
+                mod  => $module,
+            };
+
+            push $self->{mods}->@*, $entry;
+            $self->{mods_by_name} = $entry;
+        }
+    }
+}
+
+sub failed_module($self, $name, $driver) {
+    return {
+        -name   => $name,
+        -driver => "WBM::Fail",
+        text    => "'$name' ($driver)",
+    };
+}
+
+# vim: syntax=perl5-24
+
+1;

Breeze/Logger.pm

+package Breeze::Logger;
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use feature     qw(signatures);
+no  warnings    qw(experimental::signatures);
+
+use Carp;
+
+sub new($class, $category, %args) {
+    croak "missing 'category' argument in constructor"
+        unless defined $category;
+
+    return bless { %args, category => $category }, $class;
+}
+
+sub clone($self, %override) {
+    return bless { %$self, %override }, ref $self;
+}
+
+sub info($, @) {}
+sub error($, @) {}
+sub debug($, @) {}
+
+sub fatal($self, @msg) {
+    my $text = join("", @msg);
+    $self->error($text);
+    $Carp::CarpLevel = 1;
+    croak $text;
+}
+
+sub warn($self, @msg) {
+    my $text = join("", @msg);
+    $self->error($text);
+    $Carp::CarpLevel = 1;
+    carp $text;
+}
+
+# vim: syntax=perl5-24
+
+1;

Breeze/Logger/File.pm

+package Breeze::Logger::File;
+
+use utf8;
+use strict;
+use warnings;
+
+use parent      qw(Breeze::Logger);
+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 'filename' argument in constructor"
+        unless defined $self->{filename};
+
+    open $self->{fh}, ">:encoding(utf-8)", $self->{filename}
+        or croak "$self->{filename}: $!";
+
+    $self->info("logging started");
+    return $self;
+}
+
+sub time($self) {
+    return $strftime{"%Y-%m-%d %H:%M:%S", localtime};
+}
+
+sub info($self, @msg) {
+    printf { $self->{fh} } "%s info[%s] %s\n",
+        $self->time, $self->{category}, join("", @msg);
+}
+
+sub error($self, @msg) {
+    printf { $self->{fh} } "%s fail[%s] %s\n",
+        $self->time, $self->{category}, join("", @msg);
+}
+
+sub debug($self, @msg) {
+    return unless $self->{debug};
+    printf { $self->{fh} } "%s debg[%s] %s\n",
+        $self->time, $self->{category}, join("", @msg);
+}
+
+1;

Breeze/Logger/StdErr.pm

+package Breeze::Logger::StdErr;
+
+use utf8;
+use strict;
+use warnings;
+
+use parent      qw(Breeze::Logger);
+use feature     qw(signatures);
+no  warnings    qw(experimental::signatures);
+
+use Carp;
+use Time::Format    qw(%strftime);
+use Term::ANSIColor;
+
+sub new($class, @args) {
+    my $self = $class->SUPER::new(@args);
+
+    $self->{fh} = *STDERR;
+    $self->info("logging started");
+    return $self;
+}
+
+sub time($self) {
+    return $strftime{"%Y-%m-%d %H:%M:%S", localtime};
+}
+
+sub info($self, @msg) {
+    printf { $self->{fh} } "%s %s[%s] %s\n",
+        colored($self->time, "ansi145"),
+        colored("info", "ansi75"),
+        $self->{category},
+        colored(join("", @msg), "ansi75");
+}
+
+sub error($self, @msg) {
+    printf { $self->{fh} } "%s %s[%s] %s\n",
+        colored($self->time, "ansi145"),
+        colored("fail", "ansi202"),
+        $self->{category},
+        colored(join("", @msg), "ansi202");
+}
+
+sub debug($self, @msg) {
+    return unless $self->{debug};
+    printf { $self->{fh} } "%s %s[%s] %s\n",
+        colored($self->time, "ansi145"),
+        colored("debg", "ansi242"),
+        $self->{category},
+        colored(join("", @msg), "ansi242");
+}
+
+1;

WBM/Driver.pm

+package WBM::Driver;
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use feature     qw(signatures);
+no  warnings    qw(experimental::signatures);
+
+sub new($class, %args) {
+    my $self = bless {}, $class;
+    $self->@{log} = delete $args{-log};
+    return $self;
+}
+
+sub log($self) { $self->{log}; }
+
+sub refresh_on_event($) { 0; }
+sub invoke($self) {
+    $self->log->fatal("invoke called on WBM::Driver, perhaps forgotten override?");
+}
+
+sub on_left_click($) {}
+sub on_middle_click($) {}
+sub on_right_click($) {}
+sub on_wheel_up($) {}
+sub on_wheel_down($) {}
+sub on_back($) {}
+sub on_next($) {}
+sub on_event($) {}
+
+# vim: syntax=perl5-24
+
+1;

WBM/Fail.pm

+package WBM::Fail;
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use parent      qw(WBM::Driver);
+use feature     qw(signatures);
+no  warnings    qw(experimental::signatures);
+
+sub new($class, %args) {
+    my $self = $class->SUPER::new(%args);
+
+    $self->log->fatal("missing 'text' parameter in constructor")
+        unless defined $args{text};
+
+    $self->{text}   = $args{text};
+    $self->{first}  = 1;
+    return $self;
+}
+
+sub refresh_on_event($self) { 1; }
+sub on_left_click($self)    { $self->{dismissed} = 1; }
+sub on_middle_click($self)  { $self->{dismissed} = 1; }
+sub on_right_click($self)   { $self->{dismissed} = 1; }
+
+sub invoke($self) {
+    my $ret = {
+        full_text   => $self->{text},
+        icon        => "%utf8{f09f9eaa}",
+        color       => "ff5f00",
+    };
+
+    if ($self->{first}) {
+        $ret->{blink}     = 6;
+        $self->{first}  = 0;
+    } elsif(!$self->{dismissed}) {
+        $ret->{inverse}   = 1;
+    }
+
+    return $ret;
+}
+
+# vim: syntax=perl5-24
+
+1;

WBM/Time.pm

+package WBM::Time;
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use parent      qw(WBM::Driver);
+use feature     qw(signatures);
+no  warnings    qw(experimental::signatures);
+
+sub new($class, %args) {
+    return bless {}, $class;
+}
+
+# vim: syntax=perl5-24
+
+1;

test.yaml

+# Log file location. The filename can contain '$$' which will be replaced
+# by the PID of the program.
+#
+# Values:
+#   - string      write to a file
+#   - %STDERR     write to stderr
+#   - null        disable logging entirely
+#logfile: "/tmp/breeze-$$.log"
+logfile: %STDERR
+#logfile: null
+
+# Turn debugging on or off.
+#
+# Values: (yes|no)
+debug: yes
+
+# Show performance component in the first position. Usually useful only
+# for debugging.
+#
+# Values: (yes|no)
+perfmon: yes
+
+# A duration between 'ticks'. All intervals here are 'ticks'. If this
+# value is set to 1 (as it should be), all ticks are equivalent to seconds.
+tick: 1
+
+# Default values for output entry.
+defaults:
+    background: null
+    color:      1c1c1c
+    border:     %background
+# The following two will be _always_ set up by wind-breeze.
+#   separator:              no
+#   separator_block_width:  0
+
+# Modules
+modules:
+    - -name:        time
+      -driver:      WBM::Time
+      -refresh:     1
+      format:       "%a %y-%m-%d %H-%M-%S"
+      icon:         %utf8{f09f9590}
+    - separator
+    - -name:        time2
+      -driver:      WBM::Time
+      -refresh:     2

wild-breeze

+#!/usr/bin/perl
+
+use v5.26;
+use utf8;
+use strict;
+use warnings;
+
+use lib     ".";
+
+use feature     qw(signatures);
+no  warnings    qw(experimental::signatures);
+
+use Breeze::Core;
+use Carp;
+use Data::Dumper;
+use File::Slurp;
+use FindBin         qw($Bin);
+use Getopt::Long    qw(:config bundling);
+use JSON::XS;
+use Pod::Usage;
+use IO::Select;
+use YAML::Syck;
+
+#-------------------------------------------------------------------------------
+# Configuration
+#-------------------------------------------------------------------------------
+
+$YAML::Syck::ImplicitTyping     = 1;
+$YAML::Syck::ImplicitUnicode    = 1;
+
+#-------------------------------------------------------------------------------
+# Subroutines
+#-------------------------------------------------------------------------------
+
+sub read_config($filename) {
+    open my $fh, "<:encoding(utf-8)", $filename
+        or die "$filename: $!\n";
+
+    return LoadFile($fh);
+    # $fh gets closed when it goes out of scope
+}
+
+#-------------------------------------------------------------------------------
+# Entry
+#-------------------------------------------------------------------------------
+
+# initialize config and options
+my $config      = {};
+my $options     = {
+    conf    => "$ENV{HOME}/.config/wbreeze.yaml",
+};
+
+# set encoding on all input and output streams
+binmode $_, ":encoding(utf-8)" foreach (*STDIN, *STDOUT, *STDERR);
+
+# encode argv to utf-8 first
+utf8::decode($_) foreach @ARGV;
+
+# get options
+GetOptions($options, qw(man|help h))
+    or pod2usage({ -exitval => 1, -verbose => 1 });
+
+if (@ARGV == 1) {
+    $options->{conf} = $ARGV[0];
+} elsif (@ARGV > 1) {
+    print STDERR "Too many arguments.\nTry '$0 -h' for help.\n";
+    exit 1;
+}
+
+# read configuration file
+$config = read_config($options->{conf});
+
+# set up JSON event parser
+my $ev_parser   = JSON::XS->new->utf8(0);
+my $ev_started  = 0;
+
+# set up Breeze
+my $breeze = Breeze::Core->new($config);
+my $log    = $breeze->log->clone(category => "CORE");
+
+print Dumper($breeze->{mods});
+
+# set up IO::Select
+my $select = IO::Select->new(*STDIN)
+    or $log->fatal("failed to set up IO::Select");
+
+# print protocol setup
+
+# enter the main loop
+MAIN_LOOP:
+while (1) {
+    # print output
+    # $breeze->run;
+
+    # wait for an event, at most a second by default
+    foreach my $hndl ($select->can_read($config->{tick} // 1)) {
+        my $line = <$hndl>;
+        last MAIN_LOOP unless defined $line;
+        chomp $line;
+        print "# got line $line\n";
+
+        # add data to parser
+        $ev_parser->incr_parse($line);
+
+        print "parser text: '", $ev_parser->incr_text, "'\n";
+
+        # first, get rid of leading '['
+        if (!$ev_started && $ev_parser->incr_text =~ s/^\s*\[//) {
+            $ev_started = 1;
+        } elsif (!$ev_started) {
+            next;
+        }
+
+        # exit if we encounter ']'
+        if ($ev_parser->incr_text =~ s/^\s*\]//) {
+            last MAIN_LOOP;
+        }
+
+        # remove separators and process events
+        $ev_parser->incr_text =~ s/^\s*,//;
+        while (my $event = $ev_parser->incr_parse) {
+            print Dumper($event);
+            $ev_parser->incr_text =~ s/^\s*,//;
+        }
+    }
+}
+
+# vim: syntax=perl5-24