config-reload

#! perl

use v5.20;
use common::sense;

use AnyEvent;
use Linux::FD qw(signalfd);
use POSIX;
use File::Basename qw(dirname);

my $sigset = POSIX::SigSet->new(&POSIX::SIGHUP);
sigprocmask(SIG_BLOCK, $sigset);
my $sigfd = signalfd($sigset);
my $libdir = dirname(__FILE__);
our $config_cmd = "";

our @terms = ();

sub get_xresources {
    my @entries = `xrdb -query`;
    my %resources;
    for (@entries) {
        $resources{$2} = $3 if /^(URxvt[.*]|\*)([^:]+):\t+(.*)/;
    }
    $resources{borderColor} //= $resources{background};
    $resources{cursorColor} //= $resources{foreground};
    return %resources;
}

sub build_command {
    my %resources = @_;
    my $cmd = "";

    for (keys %resources) {
        my $key;
        given ($_) {
            # Codes adapted from https://github.com/sos4nt/dynamic-colors/blob/master/bin/dynamic-colors
            $key = "4;$1" when (/color(\d+)/);
            $key = 10 when "foreground";
            $key = 11 when "background";
            $key = 12 when "cursorColor";
            $key = 13 when "pointerColor2";
            $key = 14 when "pointerColor";
            $key = 17 when "highlight";
            $key = 708 when "borderColor";
            $key = 710 when "font";
            when ("geometry") {
                if (my ($col, $row) = $resources{$_} =~ /(\d+)x(\d+)/) {
                    $cmd .= "\e[8;${row};${col}t";
                }
                next;
            }
            default { next }
        }
        my $val = $resources{$_};
        $cmd .= "\e]$key;$val\a";
    }
    return $cmd;
}

sub reload_all {
    my %resources = get_xresources;
    $config_cmd = build_command(%resources);
    # warn "CMD: " . ($cmd =~ s/\e/\\e/gr =~ s/\a/\\a/gr);
    for (@terms) {
        $_->cmd_parse($config_cmd);
    }
}

our $watch = AnyEvent->io (
             fh   => $sigfd, # which file handle to check
             poll => "r",     # which event to wait for ("r"ead data)
             cb   => sub {    # what callback to execute
                 sysread $sigfd, my $dummy, 4096;
                 reload_all;
             }
          );

sub on_start {
    my ($ext) = @_;
    # warn "START ext=$ext TERM=$TERM";
    push @terms, $TERM;
    $TERM->cmd_parse($config_cmd);
    ();
}

sub on_destroy {
    my ($ext) = @_;
    # warn "END ext=$ext TERM=$TERM";
    @terms = grep { $_ != $TERM } @terms;
    if (!@terms) { undef $watch; }
    ();
}