bin/disorder-notify: Rewrite and take over the functionality of `media-keys'.

[profile] / bin / disorder-propagate-autoplay

#! /usr/bin/perl -w

use autodie qw{:all};
use strict;

use DisOrder;

(my $PROG = $0) =~ s:.*/::;

sub grobble_dir (\@$$$);

sub grobble_dir (\@$$$) {
  my ($list, $sk, $root, $dir) = @_;
  my @d;

  for my $f (send_command $sk, "files", "$root$dir") {
    my ($tail) = $f =~ /\Q$root\E(.*)$/;
    die "`$f' not under root `$root'" unless $tail;
    push @$list, $tail;
  }

  for my $d (send_command $sk, "dirs", "$root$dir") {
    my ($tail) = $d =~ /\Q$root\E(.*)$/;
    die "`$d' not under root `$root'" unless $tail;
    push @d, $tail;
  }
  for my $d (@d) { grobble_dir @$list, $sk, $root, $d; }
}

sub grobble_root ($) {
  my ($sk) = @_;
  my $root = undef;
  my @list = ();

  for my $d (send_command $sk, "dirs", "") {
    my ($pre, $tail) = $d =~ m{^(.*/)([^/]*)$};
    die "no root in `$_'?" unless $pre;
    if (!defined $root) { $root = $pre; }
    elsif ($root ne $pre) { die "root was `$root'; now it's `$pre'"; }
    grobble_dir @list, $sk, $root, $tail;
  }
  return $root, \@list;
}

sub trim_extension ($) {
  my ($f) = @_;
  $f =~ s/\.(flac|mp[23]|ogg|wav)$//;
  return $f;
}

if (@ARGV != 2) { die "usage: $PROG FROM TO\n"; }
my ($from, $to) = @ARGV;

my $sk = connect_to_server $from;
my ($root0, $list) = grobble_root $sk;
my %black = ();
for my $f (@$list) {
  my $pick = send_command $sk, "get", "$root0$f", "pick_at_random";
  if (($pick // 1) eq "0") { $black{trim_extension $f} = 1; }
}
close $sk;

$sk = connect_to_server $to;
(my $root1, $list) = grobble_root $sk;
FILE: for my $f (@$list) {
  my $pick = send_command $sk, "get", "$root1$f", "pick_at_random";
  if (($pick // 1) eq "0") {
    next FILE if $black{trim_extension $f};
    send_command $sk, "unset", "$root1$f", "pick_at_random";
    print STDERR ";; reinstate <$f>\n";
  } else {
    next FILE unless $black{trim_extension $f};
    send_command $sk, "set", "$root1$f", "pick_at_random", 0;
    print STDERR ";; blacklist <$f>\n";
  }
}
close $sk;