#! /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; ##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 $@; } ## 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) // ""); close $fh; return $pid; } 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; } ###-------------------------------------------------------------------------- ### 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; } } return \%st; } 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; } } 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 --------------------------------------------------