chiark - git - mdw - disorder-toys/blob - disorder-notify.in

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