8 (my $PROG = $0) =~ s:.*/::;
10 sub grobble_dir (\@$$$);
12 sub grobble_dir (\@$$$) {
13 my ($list, $sk, $root, $dir) = @_;
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;
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;
27 for my $d (@d) { grobble_dir @$list, $sk, $root, $d; }
30 sub grobble_root ($) {
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;
45 sub trim_extension ($) {
47 $f =~ s/\.(flac|mp[23]|ogg|wav)$//;
51 if (@ARGV != 2) { die "usage: $PROG FROM TO\n"; }
52 my ($from, $to) = @ARGV;
54 my $sk = connect_to_server $from;
55 my ($root0, $list) = grobble_root $sk;
58 my $pick = send_command $sk, "get", "$root0$f", "pick_at_random";
59 if (($pick // 1) eq "0") { $black{trim_extension $f} = 1; }
63 $sk = connect_to_server $to;
64 (my $root1, $list) = grobble_root $sk;
65 FILE: for my $f (@$list) {
66 my $pick = send_command $sk, "get", "$root1$f", "pick_at_random";
67 if (($pick // 1) eq "0") {
68 next FILE if $black{trim_extension $f};
69 send_command $sk, "unset", "$root1$f", "pick_at_random";
70 print STDERR ";; reinstate <$f>\n";
72 next FILE unless $black{trim_extension $f};
73 send_command $sk, "set", "$root1$f", "pick_at_random", 0;
74 print STDERR ";; blacklist <$f>\n";