bin/disorder-autoplay: Restructure into a two-pass arrangement.

One command to fetch a server's current settings; another to update them
to match an input file.

diff --git a/Makefile b/Makefile
index 0e89741e1826854ce04a2506549c7580006eb808..5af43c235c7a64146556a590f17b70f2f7b4f7b7 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -223,7 +223,7 @@ DOTLINKS            += .tclshrc .wishrc
 MISCLINKS              += lib/perl/DisOrder.pm
 lib/perl/DisOrder.pm_SRC = pl/DisOrder.pm
 SCRIPTLINKS            += disorder-switch-config
 MISCLINKS              += lib/perl/DisOrder.pm
 lib/perl/DisOrder.pm_SRC = pl/DisOrder.pm
 SCRIPTLINKS            += disorder-switch-config

-SCRIPTLINKS            += disorder-propagate-autoplay
+SCRIPTLINKS            += disorder-autoplay

 SCRIPTLINKS            += disorder-notify
 
 ## Random scripts.
 SCRIPTLINKS            += disorder-notify
 
 ## Random scripts.

diff --git a/bin/disorder-autoplay b/bin/disorder-autoplay
new file mode 100755 (executable)
index 0000000..0ab0051
--- /dev/null
+++ b/bin/disorder-autoplay
@@ -0,0 +1,95 @@
+#! /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;
+}
+
+sub die_usage () {
+  print STDERR <<EOF;
+usage:
+       $PROG get CONFIG
+       $PROG set CONFIG [LIST]
+EOF
+  exit 2;
+}
+
+defined (my $op = shift @ARGV) or die_usage;
+if ($op eq "get") {
+  defined (my $conf = shift @ARGV) or die_usage;
+  !@ARGV or die_usage;
+  my $sk = connect_to_server $conf;
+  my ($root, $list) = grobble_root $sk;
+
+  for my $f (sort @$list) {
+    my $pick = send_command $sk, "get", "$root$f", "pick_at_random";
+    if (($pick // 1) eq "0") { print trim_extension $f, "\n"; }
+  }
+  close $sk;
+} else {
+  defined (my $conf = shift @ARGV) or die_usage;
+  my $fh;
+  if (defined (my $list = shift @ARGV)) { open $fh, "<", $list; }
+  else { $fh = \*STDIN; }
+  my %black = ();
+  while (<$fh>) { chomp; $black{$_} = 1; }
+  my $sk = connect_to_server $conf;
+  my ($root, $list) = grobble_root $sk;
+
+  FILE: for my $f (sort @$list) {
+    my $pick = send_command $sk, "get", "$root$f", "pick_at_random";
+    if (($pick // 1) eq "0") {
+      next FILE if $black{trim_extension $f};
+      send_command $sk, "unset", "$root$f", "pick_at_random";
+      print STDERR ";; reinstate <$f>\n";
+    } else {
+      next FILE unless $black{trim_extension $f};
+      send_command $sk, "set", "$root$f", "pick_at_random", 0;
+      print STDERR ";; blacklist <$f>\n";
+    }
+  }
+  close $sk;
+}

diff --git a/bin/disorder-propagate-autoplay b/bin/disorder-propagate-autoplay
deleted file mode 100755 (executable)
index be38510..0000000
--- a/bin/disorder-propagate-autoplay
+++ /dev/null
@@ -1,77 +0,0 @@
-#! /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;