chiark - git - mdw - profile/blob - bin/disorder-notify

   1 #! /usr/bin/perl -w
   2
   3 use autodie qw{:all};
   4 use strict;
   5
   6 use DisOrder;
   7 use File::FcntlLock;
   8 use POSIX qw{:errno_h :fcntl_h};
   9
  10 ###--------------------------------------------------------------------------
  11 ### Configuration.
  12
  13 my %C = (config => "$ENV{HOME}/.disorder/passwd",
  14          lockdir => "$ENV{HOME}/.disorder/",
  15          mixer => "Master,0");
  16
  17 my $TITLE = "DisOrder";
  18 my $VARIANT = "default";
  19 if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/)
  20   { $VARIANT = $1; $TITLE .= " ($1)"; }
  21
  22 ###--------------------------------------------------------------------------
  23 ### Random utilities.
  24
  25 sub 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 }
  39
  40 sub notify ($$) {
  41   my ($head, $body) = @_;
  42
  43   $body =~ s:\&:&amp;:g;
  44   $body =~ s:\<:&lt;:g;
  45   $body =~ s:\>:&gt;:g;
  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
  54 sub try_unlink ($) {
  55   my ($f) = @_;
  56   eval { unlink $f; };
  57   die $@ if $@ and $@->errno != ENOENT;
  58 }
  59
  60 ###--------------------------------------------------------------------------
  61 ### Locking protocol.
  62
  63 my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock";
  64 my $LKFH;
  65
  66 sub 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 $@;
  75   }
  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;
  87 }
  88
  89 sub 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;
 105 }
 106
 107 ###--------------------------------------------------------------------------
 108 ### DisOrder utilities.
 109
 110 sub 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; }
 123   }
 124   return \%st;
 125 }
 126
 127 my $CONF = undef;
 128
 129 sub configured_connection (;$) {
 130   my ($quietp) = @_;
 131   $CONF //= load_config $C{config};
 132   return connect_to_server %$CONF, $quietp // 0;
 133 }
 134
 135 sub get_state () {
 136   my $sk = configured_connection;
 137   send_command0 $sk, "log";
 138   my $st = get_state0 $sk;
 139   close $sk;
 140   return $st;
 141 }
 142
 143 sub decode_track_name ($\%) {
 144   my ($sk, $info) = @_;
 145   return unless exists $info->{track};
 146   my $track = $info->{track};
 147   for my $i ("artist", "album", "title") {
 148     my @f = split_fields send_command $sk, "part", $track, "display", "$i";
 149     $info->{$i} = $f[0];
 150   }
 151 }
 152
 153 sub fmt_duration ($) {
 154   my ($n) = @_;
 155   return sprintf "%d:%02d", int $n/60, $n%60;
 156 }
 157
 158 sub format_now_playing (\%) {
 159   my ($info) = @_;
 160   exists $info->{track} or return "Nothing.";
 161   my $r = "$info->{artist}: ‘$info->{title}’";
 162   $r .= ", from ‘$info->{album}’" if $info->{album};
 163   exists $info->{sofar} && exists $info->{length} and
 164     $r .= sprintf " (%s/%s)",
 165       fmt_duration $info->{sofar}, fmt_duration $info->{length};
 166   $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter};
 167   return $r;
 168 }
 169
 170 sub get_now_playing ($) {
 171   my ($sk) = @_;
 172   my $r = send_command $sk, "playing";
 173   defined $r or return {};
 174   my %info = split_fields $r;
 175   decode_track_name $sk, %info;
 176   exists $info{sofar} and
 177     $info{length} = send_command $sk, "length", $info{track};
 178   return \%info;
 179 }
 180
 181 sub watch_and_notify0 ($) {
 182   my ($now_playing) = @_;
 183
 184   my $sk = configured_connection 1;
 185   my $sk_log = configured_connection 1;
 186
 187   send_command0 $sk_log, "log";
 188   my $st = get_state0 $sk_log;
 189   my $msg = "playing " . ($st->{play} ? "enabled" : "disabled");
 190   $msg .= "; random play " . ($st->{random} ? "enabled" : "disabled");
 191   $msg .= "; " . ($st->{pause} ? "paused" : "playing");
 192   notify "$TITLE state", "Connected: $msg";
 193   if ($st->{play} && $now_playing) {
 194     my $info = get_now_playing $sk;
 195     notify "$TITLE: Now playing", format_now_playing %$info;
 196   }
 197
 198   fcntl $sk_log, F_SETFL, (fcntl $sk_log, F_GETFL, 0) | O_NONBLOCK;
 199   my $buffer = "";
 200   my @lines = ();
 201   my $rdin = ""; vec($rdin, (fileno $sk_log), 1) = 1;
 202   my $loss;
 203
 204   WATCH: for (;;) {
 205     for my $line (@lines) {
 206       my @f = split_fields $line;
 207       if ($f[1] eq "state") {
 208         my $msg = undef;
 209         if ($f[2] eq "disable_random") { $msg = "Random play disabled"; }
 210         elsif ($f[2] eq "enable_random") { $msg = "Random play enabled"; }
 211         elsif ($f[2] eq "disable_play") { $msg = "Playing disabled"; }
 212         elsif ($f[2] eq "enable_play") { $msg = "Playing enabled"; }
 213         elsif ($f[2] eq "pause") { $msg = "Paused"; }
 214         elsif ($f[2] eq "resume") { $msg = "Playing"; }
 215         notify "$TITLE state", $msg if defined $msg;
 216       } elsif ($f[1] eq "playing") {
 217         my %info;
 218         $info{track} = $f[2];
 219         $info{submitter} = $f[3] if @f > 3;
 220         decode_track_name $sk, %info;
 221         notify "$TITLE: Now playing", format_now_playing %info;
 222       } elsif ($f[1] eq "scratched") {
 223         my %info;
 224         $info{track} = $f[2];
 225         decode_track_name $sk, %info;
 226         notify "$TITLE: Scratched by $f[3]", format_now_playing %info;
 227       }
 228     }
 229
 230     if (!$sk_log) { $loss = "EOF from server"; last WATCH; }
 231     my $nfd = select my $rdout = $rdin, undef, undef, 60;
 232     if (!$nfd) {
 233       eval { print $sk_log "."; flush $sk_log; };
 234       if ($@) { $loss = "error from write: " . $@->errno; last WATCH; }
 235       @lines = ();
 236     } else {
 237       READ: for (;;) {
 238         my ($b, $n);
 239         eval { $n = sysread $sk_log, $b, 4096; };
 240         if ($@ && $@->errno == EAGAIN) { last READ; }
 241         elsif ($@) { $loss = "error from read: " . $@->errno; last WATCH; }
 242         elsif (!$n) { close $sk_log; $sk_log = undef; last READ; }
 243         else { $buffer .= $b; }
 244       }
 245
 246       @lines = split /\n/, $buffer, -1;
 247       $buffer = pop @lines;
 248     }
 249   }
 250
 251   notify "$TITLE state", "Lost connection: $loss";
 252
 253   close $sk;
 254   close $sk_log if defined $sk_log;
 255 }
 256
 257 sub watch_and_notify ($) {
 258   my ($now_playing) = @_;
 259
 260   claim_lock or exit 1;
 261
 262   for (;;) {
 263     eval { watch_and_notify0 $now_playing; };
 264     $now_playing = 1;
 265     sleep 5;
 266   }
 267 }
 268
 269 ###--------------------------------------------------------------------------
 270 ### User-facing operations.
 271
 272 my %OP;
 273
 274 $OP{"volume-up"} =
 275   sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%+"; };
 276 $OP{"volume-down"} =
 277   sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%-"; };
 278
 279 $OP{"scratch"} = sub {
 280   my $sk = configured_connection;
 281   send_command $sk, "scratch";
 282   close $sk;
 283 };
 284
 285 $OP{"enable/disable"} = sub {
 286   my $st = get_state;
 287   my $sk =configured_connection;
 288   if ($st->{play}) { send_command $sk, "disable"; }
 289   else { send_command $sk, "enable"; }
 290   close $sk;
 291 };
 292
 293 $OP{"play/pause"} = sub {
 294   my $st = get_state;
 295   my $sk = configured_connection;
 296   if (!$st->{play}) {
 297     send_command $sk, "enable";
 298     if ($st->{pause}) { send_command $sk, "resume"; }
 299   } else {
 300     if ($st->{pause}) { send_command $sk, "resume"; }
 301     else { send_command $sk, "pause"; }
 302   }
 303   close $sk;
 304 };
 305
 306 $OP{"watch"} = sub {
 307   if (defined (my $lkpid = locked_by)) {
 308     print STDERR "$0: already watched by pid $lkpid\n";
 309     exit 2;
 310   }
 311   watch_and_notify 1;
 312 };
 313
 314 $OP{"now-playing"} = sub {
 315   my $sk = configured_connection;
 316   my $info = get_now_playing $sk;
 317   close $sk;
 318   print format_now_playing %$info;
 319   print "\n";
 320 };
 321
 322 $OP{"notify-now-playing"} = sub {
 323   my $sk = configured_connection;
 324   my $info = get_now_playing $sk;
 325   close $sk;
 326   notify "$TITLE: Now playing", format_now_playing %$info;
 327   unless (defined locked_by) {
 328     fork and exit 0;
 329     watch_and_notify 0;
 330   }
 331 };
 332
 333 $OP{"next-config"} = sub {
 334   (my $dir = $C{config}) =~ s:/[^/]*$::;
 335   my (@conf, $curr, $conf, $min);
 336
 337   if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/)
 338     { $curr = $1; }
 339
 340   opendir my $dh, +$dir;
 341   FILE: while (my $f = readdir $dh)
 342     { push @conf, $1 if $f =~ /^passwd\.(.*[^~])$/; }
 343
 344   for (my $i = 0; $i < @conf; $i++) {
 345     $min = $conf[$i] if (!defined $min) || $conf[$i] lt $min;
 346     $conf = $conf[$i]
 347       if ((!defined $curr) || $curr lt $conf[$i]) &&
 348          ((!defined $conf) || $conf[$i] lt $conf);
 349   }
 350   $conf = $min unless defined $conf;
 351
 352   try_unlink "$dir/passwd.new";
 353   symlink "passwd.$conf", "$dir/passwd.new";
 354   rename "$dir/passwd.new", "$dir/passwd";
 355   notify "DisOrder configuration", "Switched to `$conf'";
 356 };
 357
 358 ###--------------------------------------------------------------------------
 359 ### Main program.
 360
 361 if (@ARGV != 1) { print STDERR "usage: $0 OP\n"; exit 2; }
 362 my $op = $ARGV[0];
 363 if (!exists $OP{$op}) { print STDERR "$0: unknown op `$op'\n"; exit 2; }
 364 $OP{$op}();
 365
 366 ###----- That's all, folks --------------------------------------------------