-#! /usr/bin/perl
+#! /usr/bin/perl -w
+
+use autodie qw{:all};
+use strict;
+
+use DisOrder;
+use File::FcntlLock;
+use POSIX qw{:errno_h :fcntl_h};
+
+###--------------------------------------------------------------------------
+### Configuration.
+
+my %C = (config => "$ENV{HOME}/.disorder/passwd",
+ lockdir => "$ENV{HOME}/.disorder/",
+ mixer => "Master,0");
+
+my $TITLE = "DisOrder";
+my $VARIANT = "default";
+if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/)
+ { $VARIANT = $1; $TITLE .= " ($1)"; }
+
+###--------------------------------------------------------------------------
+### Random utilities.
+
+sub run_discard_output (@) {
+ my $kid = fork();
+ if (!$kid) {
+ open STDOUT, ">/dev/null" or die "open /dev/null: $!";
+ exec @_;
+ }
+ waitpid $kid, 0;
+ if ($?) {
+ my $st;
+ if ($? >= 256) { $st = sprintf "rc = %d", $? >> 8; }
+ else { $st = sprintf "signal %d", $?; }
+ die "$_[0] failed ($st)";
+ }
+}
sub notify ($$) {
my ($head, $body) = @_;
$body =~ s:\&:&:g;
$body =~ s:\<:<:g;
$body =~ s:\>:>:g;
- my $kid = fork;
- defined $kid or return;
- if (!$kid) {
- open STDOUT, ">", "/dev/null";
- exec "notify-send",
- "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000",
- $head, $body;
+
+ ##print "****************\n$head\n\n$body\n"; return;
+
+ run_discard_output "notify-send",
+ "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000",
+ $head, $body;
+}
+
+sub try_unlink ($) {
+ my ($f) = @_;
+ eval { unlink $f; };
+ die $@ if $@ and $@->errno != ENOENT;
+}
+
+###--------------------------------------------------------------------------
+### Locking protocol.
+
+my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock";
+my $LKFH;
+
+sub locked_by () {
+
+ ## Try to open the lock file. If it's not there, then obviously it's not
+ ## locked.
+ my $fh;
+ eval { open $fh, "<", $LKFILE; };
+ if ($@) {
+ return undef if $@->errno == ENOENT;
+ die $@;
}
- waitpid $kid, 0;
+
+ ## Take out a non-exclusive lock on the lock file.
+ my $lk = new File::FcntlLock;
+ $lk->l_type(F_RDLCK); $lk->l_whence(SEEK_SET);
+ $lk->l_start(0); $lk->l_len(0);
+ if ($lk->lock($fh, F_SETLK)) { close $fh; return undef; }
+
+ ## Read the pid of the current lock-holder.
+ chomp (my $pid = (readline $fh) // "<unknown>");
+ close $fh;
+ return $pid;
}
-sub cmd (@) {
- my @args = @_;
- open my $f, "-|", "disorder", @args;
- chomp (my @r = <$f>);
- close $f;
- if (wantarray) { return @r; }
- elsif (@r == 1) { return $r[0]; }
- else { return "??? multiple lines"; }
+sub claim_lock () {
+ sysopen my $fh, $LKFILE, O_CREAT | O_WRONLY;
+
+ my $lk = new File::FcntlLock;
+ $lk->l_type(F_WRLCK); $lk->l_whence(SEEK_SET);
+ $lk->l_start(0); $lk->l_len(0);
+ if (!$lk->lock($fh, F_SETLK)) {
+ return undef if $! == EAGAIN;
+ die "failed to lock `$LKFILE': $!";
+ }
+
+ truncate $fh, 0;
+ print $fh "$$\n";
+ flush $fh;
+ $LKFH = $fh;
+ 1;
}
-sub now_playing (;$) {
- my ($track) = @_;
- if (!defined $track) {
- my @r = cmd "playing";
- if ($r[0] =~ /^track\s+(.*)$/) { $track = $1; }
- else { return; }
+###--------------------------------------------------------------------------
+### DisOrder utilities.
+
+sub get_state0 ($) {
+ my ($sk) = @_;
+ my %st = ();
+
+ LINE: for (;;) {
+ my @f = split_fields readline $sk;
+ if ($f[1] ne "state") { last LINE; }
+ elsif ($f[2] eq "enable_random") { $st{random} = 1; }
+ elsif ($f[2] eq "disable_random") { $st{random} = 0; }
+ elsif ($f[2] eq "enable_play") { $st{play} = 1; }
+ elsif ($f[2] eq "disable_play") { $st{play} = 0; }
+ elsif ($f[2] eq "resume") { $st{pause} = 0; }
+ elsif ($f[2] eq "pause") { $st{pause} = 1; }
}
- my %p;
- for my $p ("artist", "album", "title")
- { $p{$p} = cmd "part", $track, "display", $p; }
- if ($p{artist} =~ /^[A-Z]$/)
- { $p{artist} = $p{album}; $p{album} = undef; }
- elsif ($p{artist} eq "share" && $p{album} eq "disorder")
- { next LINE; }
- my $r = "$p{artist}: ‘$p{title}’";
- if (defined $p{album}) { $r .= ", from ‘$p{album}’"; }
- notify "DisOrder: now playing", $r;
+ return \%st;
}
-for (;;) {
- open my $log, "-|", "disorder", "log";
- my $startp = 1;
- my $stateinfo = undef;
- LINE: while (<$log>) {
- chomp;
- my @f = ();
- my $q = my $t = undef;
- my $e = 0;
- my $j = -1;
- for (my $i = 0; $i < length $_; $i++) {
- my $ch = substr($_, $i, 1);
- if ($e) {
- if ($ch eq "n") { $ch = "\n"; }
- $t .= $ch; $e = 0;
- } elsif ($ch eq $q) {
- push @f, $t; $q = $t = undef;
- } elsif (defined $q) {
- if ($ch eq "\\") { $e = 1; }
- else { $t .= $ch; }
- } elsif ($ch eq " ") {
- push @f, $t if defined $t; $t = undef;
- } elsif (!defined $t && ($ch eq '"' || $ch eq "'")) {
- $t //= ""; $q = $ch; $j = $i;
- } else {
- $t //= ""; $t .= $ch;
- }
- }
- defined $q and die "unmatched $q (pos $j) in: $_";
- push @f, $t if defined $t;
-
- my $what = $f[1];
- if ($what eq "volume" && $startp) {
- $startp = 0;
- notify "DisOrder state", "Connected: $startinfo";
- now_playing;
- } elsif ($what eq "state") {
- my $st = $f[2];
- my $msg;
- my $np = 0;
- if ($st eq "disable_random") { $msg = "random play disabled"; }
- elsif ($st eq "enable_random") { $msg = "random play enabled"; }
- elsif ($st eq "disable_play") { $msg = "playing disabled"; }
- elsif ($st eq "enable_play") { $msg = "playing enabled"; }
- elsif ($st eq "pause") { $msg = "paused"; }
- elsif ($st eq "resume") { $msg = "playing"; $np = 1; }
- else { next LINE; }
- if (!$startp) {
- notify "DisOrder state", ucfirst $msg;
- now_playing if $np;
- } else {
- if (defined $startinfo) { $startinfo .= "; " . $msg; }
- else { $startinfo = $msg; }
- }
- } elsif ($what eq "scratched") {
- notify "DisOrder state", "Scratched playing track";
- } elsif ($what eq "playing") {
- now_playing $f[2];
+sub get_state () {
+ my $sk = connect_to_server $C{config};
+ send_command0 $sk, "log";
+ my $st = get_state0 $sk;
+ close $sk;
+ return $st;
+}
+
+sub decode_track_name ($\%) {
+ my ($sk, $info) = @_;
+ return unless exists $info->{track};
+ my $track = $info->{track};
+ for my $i ("artist", "album", "title") {
+ my @f = split_fields send_command $sk, "part", $track, "display", "$i";
+ $info->{$i} = $f[0];
+ }
+}
+
+sub format_now_playing (\%) {
+ my ($info) = @_;
+ exists $info->{track} or return "Nothing.";
+ my $r = "$info->{artist}: ‘$info->{title}’";
+ $r .= ", from ‘$info->{album}’" if $info->{album};
+ $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter};
+ return $r;
+}
+
+sub get_now_playing ($) {
+ my ($sk) = @_;
+ my $r = send_command $sk, "playing";
+ defined $r or return {};
+ my %info = split_fields $r;
+ decode_track_name $sk, %info;
+ return \%info;
+}
+
+sub watch_and_notify0 ($) {
+ my ($now_playing) = @_;
+
+ my $sk = connect_to_server $C{config}, 1;
+ my $sk_log = connect_to_server $C{config}, 1;
+
+ send_command0 $sk_log, "log";
+ my $st = get_state0 $sk_log;
+ my $msg = "playing " . ($st->{play} ? "enabled" : "disabled");
+ $msg .= "; random play " . ($st->{random} ? "enabled" : "disabled");
+ $msg .= "; " . ($st->{pause} ? "paused" : "playing");
+ notify "$TITLE state", "Connected: $msg";
+ if ($st->{play} && $now_playing) {
+ my $info = get_now_playing $sk;
+ notify "$TITLE: Now playing", format_now_playing %$info;
+ }
+
+ while (my $line = readline $sk_log) {
+ my @f = split_fields $line;
+
+ if ($f[1] eq "state") {
+ my $msg = undef;
+ if ($f[2] eq "disable_random") { $msg = "Random play disabled"; }
+ elsif ($f[2] eq "enable_random") { $msg = "Random play enabled"; }
+ elsif ($f[2] eq "disable_play") { $msg = "Playing disabled"; }
+ elsif ($f[2] eq "enable_play") { $msg = "Playing enabled"; }
+ elsif ($f[2] eq "pause") { $msg = "Paused"; }
+ elsif ($f[2] eq "resume") { $msg = "Playing"; }
+ notify "$TITLE state", $msg if defined $msg;
+ } elsif ($f[1] eq "playing") {
+ my %info;
+ $info{track} = $f[2];
+ $info{submitter} = $f[3] if @f > 3;
+ decode_track_name $sk, %info;
+ notify "$TITLE: Now playing", format_now_playing %info;
+ } elsif ($f[1] eq "scratched") {
+ my %info;
+ $info{track} = $f[2];
+ decode_track_name $sk, %info;
+ notify "$TITLE: Scratched by $f[3]", format_now_playing %info;
}
}
- close $log;
- sleep 5;
+
+ notify "$TITLE state", "Lost connection";
+
+ close $sk;
+ close $sk_log;
}
+
+sub watch_and_notify ($) {
+ my ($now_playing) = @_;
+
+ fork and exit 0;
+ claim_lock or exit 1;
+
+ for (;;) {
+ eval { watch_and_notify0 $now_playing; };
+ $now_playing = 1;
+ sleep 5;
+ }
+}
+
+###--------------------------------------------------------------------------
+### User-facing operations.
+
+my %OP;
+
+$OP{"volume-up"} =
+ sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%+"; };
+$OP{"volume-down"} =
+ sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%-"; };
+
+$OP{"scratch"} = sub {
+ my $sk = connect_to_server $C{config};
+ send_command $sk, "scratch";
+ close $sk;
+};
+
+$OP{"enable/disable"} = sub {
+ my $st = get_state;
+ my $sk = connect_to_server $C{config};
+ if ($st->{play}) { send_command $sk, "disable"; }
+ else { send_command $sk, "enable"; }
+ close $sk;
+};
+
+$OP{"play/pause"} = sub {
+ my $st = get_state;
+ my $sk = connect_to_server $C{config};
+ if (!$st->{play}) {
+ send_command $sk, "enable";
+ if ($st->{pause}) { send_command $sk, "resume"; }
+ } else {
+ if ($st->{pause}) { send_command $sk, "resume"; }
+ else { send_command $sk, "pause"; }
+ }
+ close $sk;
+};
+
+$OP{"watch"} = sub {
+ if (defined (my $lkpid = locked_by)) {
+ print STDERR "$0: already watched by pid $lkpid\n";
+ exit 2;
+ }
+ watch_and_notify 1;
+};
+
+$OP{"now-playing"} = sub {
+ my $sk = connect_to_server $C{config};
+ my $info = get_now_playing $sk;
+ close $sk;
+ print format_now_playing %$info;
+ print "\n";
+};
+
+$OP{"notify-now-playing"} = sub {
+ my $sk = connect_to_server $C{config};
+ my $info = get_now_playing $sk;
+ close $sk;
+ notify "$TITLE: Now playing", format_now_playing %$info;
+ defined locked_by or watch_and_notify 0;
+};
+
+###--------------------------------------------------------------------------
+### Main program.
+
+if (@ARGV != 1) { print STDERR "usage: $0 OP\n"; exit 2; }
+my $op = $ARGV[0];
+if (!exists $OP{$op}) { print STDERR "$0: unknown op `$op'\n"; exit 2; }
+$OP{$op}();
+
+###----- That's all, folks --------------------------------------------------
~mdw / profile / commitdiff