mdw@git.distorted.org.uk Git - disorder-toys/blob - disorder-autoplay.in

   1 #! @PERL@ -w
   2
   3 use autodie qw{:all};
   4 use strict;
   5
   6 use DisOrder;
   7
   8 (my $PROG = $0) =~ s:.*/::;
   9
  10 sub grobble_dir (\@$$$);
  11
  12 sub grobble_dir (\@$$$) {
  13   my ($list, $sk, $root, $dir) = @_;
  14   my @d;
  15
  16   for my $f (send_command $sk, "files", "$root$dir") {
  17     my ($tail) = $f =~ /\Q$root\E(.*)$/;
  18     die "`$f' not under root `$root'" unless $tail;
  19     push @$list, $tail;
  20   }
  21
  22   for my $d (send_command $sk, "dirs", "$root$dir") {
  23     my ($tail) = $d =~ /\Q$root\E(.*)$/;
  24     die "`$d' not under root `$root'" unless $tail;
  25     push @d, $tail;
  26   }
  27   for my $d (@d) { grobble_dir @$list, $sk, $root, $d; }
  28 }
  29
  30 sub grobble_root ($) {
  31   my ($sk) = @_;
  32   my $root = undef;
  33   my @list = ();
  34
  35   for my $d (send_command $sk, "dirs", "") {
  36     my ($pre, $tail) = $d =~ m{^(.*/)([^/]*)$};
  37     die "no root in `$_'?" unless $pre;
  38     if (!defined $root) { $root = $pre; }
  39     elsif ($root ne $pre) { die "root was `$root'; now it's `$pre'"; }
  40     grobble_dir @list, $sk, $root, $tail;
  41   }
  42   return $root, \@list;
  43 }
  44
  45 sub trim_extension ($) {
  46   my ($f) = @_;
  47   $f =~ s/\.(flac|mp[23]|ogg|wav)$//;
  48   return $f;
  49 }
  50
  51 sub die_usage () {
  52   print STDERR <<EOF;
  53 usage:
  54         $PROG get CONFIG
  55         $PROG set CONFIG [LIST]
  56 EOF
  57   exit 2;
  58 }
  59
  60 defined (my $op = shift @ARGV) or die_usage;
  61 if ($op eq "get") {
  62   defined (my $cf = shift @ARGV) or die_usage;
  63   !@ARGV or die_usage;
  64   my $conf = load_config $cf;
  65   my $sk = connect_to_server %$conf;
  66   my ($root, $list) = grobble_root $sk;
  67
  68   for my $f (sort @$list) {
  69     my $pick = send_command $sk, "get", "$root$f", "pick_at_random";
  70     if (($pick // 1) eq "0") { print trim_extension $f, "\n"; }
  71   }
  72   close $sk;
  73 } else {
  74   defined (my $cf = shift @ARGV) or die_usage;
  75   my $fh;
  76   if (defined (my $list = shift @ARGV)) { open $fh, "<", $list; }
  77   else { $fh = \*STDIN; }
  78   my %black = ();
  79   while (<$fh>) { chomp; $black{$_} = 1; }
  80   my $conf = load_config $cf;
  81   my $sk = connect_to_server %$conf;
  82   my ($root, $list) = grobble_root $sk;
  83
  84   FILE: for my $f (sort @$list) {
  85     my $pick = send_command $sk, "get", "$root$f", "pick_at_random";
  86     if (($pick // 1) eq "0") {
  87       next FILE if $black{trim_extension $f};
  88       send_command $sk, "unset", "$root$f", "pick_at_random";
  89       print STDERR ";; reinstate <$f>\n";
  90     } else {
  91       next FILE unless $black{trim_extension $f};
  92       send_command $sk, "set", "$root$f", "pick_at_random", 0;
  93       print STDERR ";; blacklist <$f>\n";
  94     }
  95   }
  96   close $sk;
  97 }