chiark / gitweb /
bin/disorder-notify: Improve error handling in the `select' loop.
[profile] / bin / disorder-notify
CommitLineData
a1b30762
MW
1#! /usr/bin/perl -w
2
3use autodie qw{:all};
4use strict;
5
6use DisOrder;
7use File::FcntlLock;
8use POSIX qw{:errno_h :fcntl_h};
9
10###--------------------------------------------------------------------------
11### Configuration.
12
13my %C = (config => "$ENV{HOME}/.disorder/passwd",
14 lockdir => "$ENV{HOME}/.disorder/",
15 mixer => "Master,0");
16
17my $TITLE = "DisOrder";
18my $VARIANT = "default";
19if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/)
20 { $VARIANT = $1; $TITLE .= " ($1)"; }
21
22###--------------------------------------------------------------------------
23### Random utilities.
24
25sub run_discard_output (@) {
26 my $kid = fork();
27 if (!$kid) {
28 open STDOUT, ">/dev/null" or die "open /dev/null: $!";
29 exec @_;
30 }
31 waitpid $kid, 0;
32 if ($?) {
33 my $st;
34 if ($? >= 256) { $st = sprintf "rc = %d", $? >> 8; }
35 else { $st = sprintf "signal %d", $?; }
36 die "$_[0] failed ($st)";
37 }
38}
6bdf3aad
MW
39
40sub notify ($$) {
41 my ($head, $body) = @_;
42
0452eefc
MW
43 $body =~ s:\&:&:g;
44 $body =~ s:\<:&lt;:g;
45 $body =~ s:\>:&gt;:g;
a1b30762
MW
46
47 ##print "****************\n$head\n\n$body\n"; return;
48
49 run_discard_output "notify-send",
50 "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000",
51 $head, $body;
52}
53
54sub try_unlink ($) {
55 my ($f) = @_;
56 eval { unlink $f; };
57 die $@ if $@ and $@->errno != ENOENT;
58}
59
60###--------------------------------------------------------------------------
61### Locking protocol.
62
63my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock";
64my $LKFH;
65
66sub locked_by () {
67
68 ## Try to open the lock file. If it's not there, then obviously it's not
69 ## locked.
70 my $fh;
71 eval { open $fh, "<", $LKFILE; };
72 if ($@) {
73 return undef if $@->errno == ENOENT;
74 die $@;
6bdf3aad 75 }
a1b30762
MW
76
77 ## Take out a non-exclusive lock on the lock file.
78 my $lk = new File::FcntlLock;
79 $lk->l_type(F_RDLCK); $lk->l_whence(SEEK_SET);
80 $lk->l_start(0); $lk->l_len(0);
81 if ($lk->lock($fh, F_SETLK)) { close $fh; return undef; }
82
83 ## Read the pid of the current lock-holder.
84 chomp (my $pid = (readline $fh) // "<unknown>");
85 close $fh;
86 return $pid;
6bdf3aad
MW
87}
88
a1b30762
MW
89sub claim_lock () {
90 sysopen my $fh, $LKFILE, O_CREAT | O_WRONLY;
91
92 my $lk = new File::FcntlLock;
93 $lk->l_type(F_WRLCK); $lk->l_whence(SEEK_SET);
94 $lk->l_start(0); $lk->l_len(0);
95 if (!$lk->lock($fh, F_SETLK)) {
96 return undef if $! == EAGAIN;
97 die "failed to lock `$LKFILE': $!";
98 }
99
100 truncate $fh, 0;
101 print $fh "$$\n";
102 flush $fh;
103 $LKFH = $fh;
104 1;
994838b7
MW
105}
106
a1b30762
MW
107###--------------------------------------------------------------------------
108### DisOrder utilities.
109
110sub get_state0 ($) {
111 my ($sk) = @_;
112 my %st = ();
113
114 LINE: for (;;) {
115 my @f = split_fields readline $sk;
116 if ($f[1] ne "state") { last LINE; }
117 elsif ($f[2] eq "enable_random") { $st{random} = 1; }
118 elsif ($f[2] eq "disable_random") { $st{random} = 0; }
119 elsif ($f[2] eq "enable_play") { $st{play} = 1; }
120 elsif ($f[2] eq "disable_play") { $st{play} = 0; }
121 elsif ($f[2] eq "resume") { $st{pause} = 0; }
122 elsif ($f[2] eq "pause") { $st{pause} = 1; }
a367c2fe 123 }
a1b30762 124 return \%st;
f1b1fa59
MW
125}
126
a1b30762
MW
127sub get_state () {
128 my $sk = connect_to_server $C{config};
129 send_command0 $sk, "log";
130 my $st = get_state0 $sk;
131 close $sk;
132 return $st;
133}
134
135sub decode_track_name ($\%) {
136 my ($sk, $info) = @_;
137 return unless exists $info->{track};
138 my $track = $info->{track};
139 for my $i ("artist", "album", "title") {
140 my @f = split_fields send_command $sk, "part", $track, "display", "$i";
141 $info->{$i} = $f[0];
142 }
143}
144
16e1b76d
MW
145sub fmt_duration ($) {
146 my ($n) = @_;
147 return sprintf "%d:%02d", int $n/60, $n%60;
148}
149
a1b30762
MW
150sub format_now_playing (\%) {
151 my ($info) = @_;
152 exists $info->{track} or return "Nothing.";
153 my $r = "$info->{artist}: ‘$info->{title}’";
154 $r .= ", from ‘$info->{album}’" if $info->{album};
16e1b76d
MW
155 exists $info->{sofar} && exists $info->{length} and
156 $r .= sprintf " (%s/%s)",
157 fmt_duration $info->{sofar}, fmt_duration $info->{length};
a1b30762
MW
158 $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter};
159 return $r;
160}
161
162sub get_now_playing ($) {
163 my ($sk) = @_;
164 my $r = send_command $sk, "playing";
165 defined $r or return {};
166 my %info = split_fields $r;
167 decode_track_name $sk, %info;
16e1b76d
MW
168 exists $info{sofar} and
169 $info{length} = send_command $sk, "length", $info{track};
a1b30762
MW
170 return \%info;
171}
172
173sub watch_and_notify0 ($) {
174 my ($now_playing) = @_;
175
176 my $sk = connect_to_server $C{config}, 1;
177 my $sk_log = connect_to_server $C{config}, 1;
178
179 send_command0 $sk_log, "log";
180 my $st = get_state0 $sk_log;
181 my $msg = "playing " . ($st->{play} ? "enabled" : "disabled");
182 $msg .= "; random play " . ($st->{random} ? "enabled" : "disabled");
183 $msg .= "; " . ($st->{pause} ? "paused" : "playing");
184 notify "$TITLE state", "Connected: $msg";
185 if ($st->{play} && $now_playing) {
186 my $info = get_now_playing $sk;
187 notify "$TITLE: Now playing", format_now_playing %$info;
188 }
189
f6ef7584
MW
190 fcntl $sk_log, F_SETFL, (fcntl $sk_log, F_GETFL, 0) | O_NONBLOCK;
191 my $buffer = "";
192 my @lines = ();
193 my $rdin = ""; vec($rdin, (fileno $sk_log), 1) = 1;
c7eee684 194 my $loss;
f6ef7584
MW
195
196 WATCH: for (;;) {
197 for my $line (@lines) {
198 my @f = split_fields $line;
199 if ($f[1] eq "state") {
200 my $msg = undef;
201 if ($f[2] eq "disable_random") { $msg = "Random play disabled"; }
202 elsif ($f[2] eq "enable_random") { $msg = "Random play enabled"; }
203 elsif ($f[2] eq "disable_play") { $msg = "Playing disabled"; }
204 elsif ($f[2] eq "enable_play") { $msg = "Playing enabled"; }
205 elsif ($f[2] eq "pause") { $msg = "Paused"; }
206 elsif ($f[2] eq "resume") { $msg = "Playing"; }
207 notify "$TITLE state", $msg if defined $msg;
208 } elsif ($f[1] eq "playing") {
209 my %info;
210 $info{track} = $f[2];
211 $info{submitter} = $f[3] if @f > 3;
212 decode_track_name $sk, %info;
213 notify "$TITLE: Now playing", format_now_playing %info;
214 } elsif ($f[1] eq "scratched") {
215 my %info;
216 $info{track} = $f[2];
217 decode_track_name $sk, %info;
218 notify "$TITLE: Scratched by $f[3]", format_now_playing %info;
219 }
6bdf3aad 220 }
f6ef7584 221
c7eee684 222 if (!$sk_log) { $loss = "EOF from server"; last WATCH; }
f6ef7584
MW
223 select my $rdout = $rdin, undef, undef, undef;
224 READ: for (;;) {
225 my ($b, $n);
226 eval { $n = sysread $sk_log, $b, 4096; };
227 if ($@ && $@->errno == EAGAIN) { last READ; }
c7eee684 228 elsif ($@) { $loss = "error from read: " . $@->errno; last WATCH; }
f6ef7584
MW
229 elsif (!$n) { close $sk_log; $sk_log = undef; }
230 else { $buffer .= $b; }
231 }
232
233 @lines = split /\n/, $buffer, -1;
234 $buffer = pop @lines;
6bdf3aad 235 }
a1b30762 236
c7eee684 237 notify "$TITLE state", "Lost connection: $loss";
a1b30762
MW
238
239 close $sk;
f6ef7584 240 close $sk_log if defined $sk_log;
6bdf3aad 241}
a1b30762
MW
242
243sub watch_and_notify ($) {
244 my ($now_playing) = @_;
245
a1b30762
MW
246 claim_lock or exit 1;
247
248 for (;;) {
249 eval { watch_and_notify0 $now_playing; };
250 $now_playing = 1;
251 sleep 5;
252 }
253}
254
255###--------------------------------------------------------------------------
256### User-facing operations.
257
258my %OP;
259
260$OP{"volume-up"} =
261 sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%+"; };
262$OP{"volume-down"} =
263 sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%-"; };
264
265$OP{"scratch"} = sub {
266 my $sk = connect_to_server $C{config};
267 send_command $sk, "scratch";
268 close $sk;
269};
270
271$OP{"enable/disable"} = sub {
272 my $st = get_state;
273 my $sk = connect_to_server $C{config};
274 if ($st->{play}) { send_command $sk, "disable"; }
275 else { send_command $sk, "enable"; }
276 close $sk;
277};
278
279$OP{"play/pause"} = sub {
280 my $st = get_state;
281 my $sk = connect_to_server $C{config};
282 if (!$st->{play}) {
283 send_command $sk, "enable";
284 if ($st->{pause}) { send_command $sk, "resume"; }
285 } else {
286 if ($st->{pause}) { send_command $sk, "resume"; }
287 else { send_command $sk, "pause"; }
288 }
289 close $sk;
290};
291
292$OP{"watch"} = sub {
293 if (defined (my $lkpid = locked_by)) {
294 print STDERR "$0: already watched by pid $lkpid\n";
295 exit 2;
296 }
297 watch_and_notify 1;
298};
299
300$OP{"now-playing"} = sub {
301 my $sk = connect_to_server $C{config};
302 my $info = get_now_playing $sk;
303 close $sk;
304 print format_now_playing %$info;
305 print "\n";
306};
307
308$OP{"notify-now-playing"} = sub {
309 my $sk = connect_to_server $C{config};
310 my $info = get_now_playing $sk;
311 close $sk;
312 notify "$TITLE: Now playing", format_now_playing %$info;
a9e2532b
MW
313 unless (defined locked_by) {
314 fork and exit 0;
315 watch_and_notify 0;
316 }
a1b30762
MW
317};
318
70291d8d
MW
319$OP{"next-config"} = sub {
320 (my $dir = $C{config}) =~ s:/[^/]*$::;
321 my (@conf, $curr, $conf, $min);
322
323 if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/)
324 { $curr = $1; }
325
326 opendir my $dh, +$dir;
327 FILE: while (my $f = readdir $dh)
328 { push @conf, $1 if $f =~ /^passwd\.(.*[^~])$/; }
329
330 for (my $i = 0; $i < @conf; $i++) {
331 $min = $conf[$i] if (!defined $min) || $conf[$i] lt $min;
332 $conf = $conf[$i]
333 if ((!defined $curr) || $curr lt $conf[$i]) &&
334 ((!defined $conf) || $conf[$i] lt $conf);
335 }
336 $conf = $min unless defined $conf;
337
338 try_unlink "$dir/passwd.new";
339 symlink "passwd.$conf", "$dir/passwd.new";
340 rename "$dir/passwd.new", "$dir/passwd";
341 notify "DisOrder configuration", "Switched to `$conf'";
342};
343
a1b30762
MW
344###--------------------------------------------------------------------------
345### Main program.
346
347if (@ARGV != 1) { print STDERR "usage: $0 OP\n"; exit 2; }
348my $op = $ARGV[0];
349if (!exists $OP{$op}) { print STDERR "$0: unknown op `$op'\n"; exit 2; }
350$OP{$op}();
351
352###----- That's all, folks --------------------------------------------------