#! /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;