add & use Local::Desktop::WMIPC class for i3/Sway IPC connections

4 files changed, 91 insertions, 28 deletions

diff --git a/perl5/Local/Desktop.pm b/perl5/Local/Desktop.pm
index 5f30e507..a9051b02 100644
--- a/perl5/Local/Desktop.pm
+++ b/perl5/Local/Desktop.pm
@@ -20,6 +20,7 @@ package Local::Desktop;
 use 5.028;
 use strict;
 use warnings;
+use lib "$ENV{HOME}/src/dotfiles/perl5";
 
 use Carp;
 use JSON;
@@ -29,9 +30,9 @@ use File::Spec::Functions "rel2abs";
 use Exporter "import";
 use File::Copy;
 use List::Util "first";
+use Local::Desktop::WMIPC;
 
 our @EXPORT = qw(
-  $wmipc wmipc
   @all_workspaces
   fresh_workspace
   compact_workspaces
@@ -40,10 +41,6 @@ our @EXPORT = qw(
   resize_for_current_outputs
   pick_random_wallpapers );
 
-`sh -c "command -v i3-msg"`;
-our $wmipc = $? == 0 ? "i3-msg" : "swaymsg";
-sub wmipc { system $wmipc, "-q", join "; ", @_ }
-
 my $output_re = qr/ ([0-9]+)x([0-9]+)\+([0-9]+)\+([0-9]+) /;
 
 our @all_workspaces = (
@@ -79,7 +76,7 @@ sub fresh_workspace {
 	push @cmds, "workspace $next_free_workspace";
 	push @cmds, "workspace back_and_forth" unless $opts{go};
 
-	wmipc @cmds;
+	Local::Desktop::WMIPC->new->cmd(@cmds);
     }
     $next_free_workspace
 }
@@ -96,7 +93,8 @@ return undef if there is no space for a gap.
 
 sub compact_workspaces {
     my %opts       = @_;
-    my @workspaces = @{ decode_json `$wmipc -t get_workspaces` };
+    my $wmipc      = Local::Desktop::WMIPC->new;
+    my @workspaces = $wmipc->get_workspaces->@*;
     @workspaces < @all_workspaces or return;
     my ($current_workspace, $gap_workspace);
     if ($opts{leave_gap}) {
@@ -117,7 +115,7 @@ sub compact_workspaces {
           : unshift @cmds, $pair
     }
 
-    wmipc map "rename workspace $_->[0] to $_->[1]", @cmds;
+    $wmipc->cmd(map "rename workspace $_->[0] to $_->[1]", @cmds);
 
     $opts{leave_gap} and $gap_workspace
 }
diff --git a/perl5/Local/Desktop/WMIPC.pm b/perl5/Local/Desktop/WMIPC.pm
new file mode 100644
index 00000000..effa7797
--- /dev/null
+++ b/perl5/Local/Desktop/WMIPC.pm
@@ -0,0 +1,61 @@
+package Local::Desktop::WMIPC;
+use 5.036;
+
+# Copyright (C) 2024 Sean Whitton
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+use IO::Socket::UNIX;
+use parent "IO::Socket::UNIX";
+use Exporter "import";
+use overload "<>" => sub { shift->recv };
+use JSON;
+use Encode "encode";
+
+our @EXPORT_OK = ();
+
+sub new ($class, $socket = $ENV{SWAYSOCK} || $ENV{I3SOCK}) {
+    bless IO::Socket::UNIX->new(Type => SOCK_STREAM, Peer => $socket)
+      => $class;
+}
+
+sub send ($self, $type, $payload = "") {
+    $payload = encode "UTF-8", $payload;
+    my $head = pack "A6ll", "i3-ipc", length $payload, $type;
+    $self->SUPER::send($head.$payload);
+    return $self->recv;
+}
+
+sub recv ($self) {
+    my $buf;
+    $self->SUPER::recv($buf, 14);
+    length $buf or die "WMIPC socket EOF";
+    my $len = (unpack "A6ll", $buf)[1];
+    $self->SUPER::recv($buf, $len);
+    return decode_json $buf;
+}
+
+sub subscribe ($self, @event_types) {
+    my $reply = $self->send(2, encode_json \@event_types);
+    $reply->{success} or die "WMIPC subscription failed";
+}
+
+sub cmd ($self, @cmds) { $self->send(0, join "; ", @cmds) }
+
+sub get_tree { shift->send(4) }
+sub get_workspaces { shift->send(1) }
+
+sub send_tick ($self, $payload = "") { $self->send(10, $payload) }
+
+1;
diff --git a/scripts/desktop/i3status-wrapper b/scripts/desktop/i3status-wrapper
index 268a5bcd..702e4240 100755
--- a/scripts/desktop/i3status-wrapper
+++ b/scripts/desktop/i3status-wrapper
@@ -26,6 +26,7 @@ use JSON;
 use Local::Desktop;
 use IO::Pipe;
 use IPC::Shareable;
+use Local::Desktop::WMIPC;
 use Sys::Hostname;
 use POSIX "floor", "mkfifo";
 use File::Basename "basename", "dirname";
@@ -46,28 +47,29 @@ unless ($i3status) {
 
 tie my %info, "IPC::Shareable", undef, { destroy => 1 };
 
+my $wmipc = Local::Desktop::WMIPC->new;
 sub with_ignored_events (&) {
-    system $wmipc, "-q", "-t", "send_tick", "i3status-wrapper-ign";
+    $wmipc->send_tick("i3status-wrapper-ign");
     $_[0]->();
-    system $wmipc, "-q", "-t", "send_tick", "i3status-wrapper-unign";
+    $wmipc->send_tick("i3status-wrapper-unign");
 }
 
 unless (fork // warn "couldn't fork monitoring loop") {
-    open my $events, "-|",
-      $wmipc, "-t", "subscribe", "-m", '[ "tick", "window", "workspace" ]';
+    my $events = Local::Desktop::WMIPC->new;
+    $events->subscribe(qw(tick window workspace));
 
     # Determine the initial state -- the WM might just have been reloaded.
     # Move any previously-hidden containers to a fresh workspace for perusal.
 
     my @old_ids;
-    for (@{decode_json `$wmipc -t get_workspaces`}) {
+    for ($wmipc->get_workspaces->@*) {
 	$info{focused_ws} = $_->{name} if $_->{focused};
 	push @old_ids, $1 if $_->{name} =~ /\A\*(\d+)\*\z/;
     }
     if (@old_ids) {
 	fresh_workspace(go => 1);
-	wmipc map("[con_id=$_] move container workspace current", @old_ids),
-	  "focus child";
+	$wmipc->cmd(map("[con_id=$_] move container workspace current", @old_ids),
+		    "focus child");
     }
     update_paper_ws_cols();
 
@@ -84,13 +86,13 @@ unless (fork // warn "couldn't fork monitoring loop") {
 	if ($ws->{monocle} || $cols->@* > $ws->{ncols}) {
 	    with_ignored_events {
 		my $pushed = shift $cols->@*;
-		wmipc hide_con($pushed);
+		$wmipc->cmd(hide_con($pushed));
 		push $ws->{off_left}->@*, $pushed;
 	    };
 	}
     }
     eval {
-	while (my $e = decode_json <$events>) {
+	while (my $e = <$events>) {
 	    state $last_e;
 
 	    # New containers
@@ -147,9 +149,9 @@ unless (fork // warn "couldn't fork monitoring loop") {
 			&& ($i < $mid_i || !$ws->{off_right}->@*)) {
 			with_ignored_events {
 			    my $pulled = pop $ws->{off_left}->@*;
-			    wmipc +("focus left")x$i,
-			      show_con($pulled), "move left",
-			      ("focus right")x$i;
+			    $wmipc->cmd(("focus left")x$i,
+					show_con($pulled), "move left",
+					("focus right")x$i);
 			    unshift @$cols, $pulled;
 			    $ws->{focused_col} = $cols->[$i];
 			};
@@ -158,8 +160,8 @@ unless (fork // warn "couldn't fork monitoring loop") {
 			with_ignored_events {
 			    my $j = $#$cols - $i;
 			    my $pulled = pop $ws->{off_right}->@*;
-			    wmipc +("focus right")x$j,
-			      show_con($pulled), ("focus left")x$j;
+			    $wmipc->cmd(("focus right")x$j,
+					show_con($pulled), ("focus left")x$j);
 			    push @$cols, $pulled;
 			    $ws->{focused_col} = $cols->[$i+1];
 			};
@@ -174,7 +176,7 @@ unless (fork // warn "couldn't fork monitoring loop") {
 		# Ignore everything until tick telling us to unignore.
 		# Thread that sent the ignore is responsible for updating data
 		# structures in the meantime.
-		while (my $next = decode_json <$events>) {
+		while (my $next = <$events>) {
 		    last if $next->{payload}
 		      && $next->{payload} eq "i3status-wrapper-unign";
 		}
@@ -234,7 +236,7 @@ unless (fork // warn "couldn't fork command pipe reader") {
 	    my $move = $1 eq "move";
 	    $2 eq "right" ? $i++ : $i--;
 	    if ($cols->@* > $i >= 0) {
-		wmipc $cmd;
+		$wmipc->cmd($cmd);
 	    } elsif ($i == @$cols && $ws->{off_right}->@*) {
 		with_ignored_events {
 		    my $pushed = shift $cols->@*;
@@ -250,7 +252,7 @@ unless (fork // warn "couldn't fork command pipe reader") {
 			push $cols->@*, $pulled;
 		    }
 
-		    wmipc @cmds, hide_con($pushed);
+		    $wmipc->cmd(@cmds, hide_con($pushed));
 		};
 		kill USR1 => $i3status;
 	    } elsif ($i == -1 && $ws->{off_left}->@*) {
@@ -270,7 +272,7 @@ unless (fork // warn "couldn't fork command pipe reader") {
 			unshift $cols->@*, $pulled;
 		    }
 
-		    wmipc @cmds, hide_con($pushed);
+		    $wmipc->cmd(@cmds, hide_con($pushed));
 		};
 		kill USR1 => $i3status;
 	    }
@@ -316,7 +318,7 @@ while (my ($statusline) = (<> =~ /^,?(.*)/)) {
 
 sub wsbuttons {
     return unless $ENV{XDG_CURRENT_DESKTOP} eq "sway";
-    wmipc "bar bar-0 workspace_buttons $_[0]";
+    $wmipc->cmd("bar bar-0 workspace_buttons $_[0]");
 }
 
 sub register_caffeinated {
@@ -332,7 +334,7 @@ sub clear_caffeinated {
 }
 
 sub update_paper_ws_cols {
-    my @trees = decode_json `$wmipc -t get_tree`;
+    my @trees = $wmipc->get_tree;
     while (@trees) {
 	foreach my $node ((shift @trees)->{nodes}->@*) {
 	    if ($node->{type} eq "workspace"
diff --git a/scripts/desktop/sway-ftp-master b/scripts/desktop/sway-ftp-master
index 0a36feee..5cb3f6a6 100755
--- a/scripts/desktop/sway-ftp-master
+++ b/scripts/desktop/sway-ftp-master
@@ -14,6 +14,8 @@ use lib "$ENV{HOME}/src/dotfiles/perl5";
 use JSON;
 use Local::Desktop;
 
+sub wmipc { system "swaymsg", "-q", join ", ", @_ }
+
 sub walk_tree (&$) {
     my ($pred, $tree) = @_;
     $pred->($tree) and return $tree;