Commit | Line | Data |
---|---|---|
d22be3ab MW |
1 | #! /usr/bin/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") { | |
be626dd5 | 62 | defined (my $cf = shift @ARGV) or die_usage; |
d22be3ab | 63 | !@ARGV or die_usage; |
be626dd5 MW |
64 | my $conf = load_config $cf; |
65 | my $sk = connect_to_server %$conf; | |
d22be3ab MW |
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 { | |
be626dd5 | 74 | defined (my $cf = shift @ARGV) or die_usage; |
d22be3ab MW |
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; } | |
be626dd5 MW |
80 | my $conf = load_config $cf; |
81 | my $sk = connect_to_server %$conf; | |
d22be3ab MW |
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 | } |